mf/feta-macros.mf

   1 %
   2 % debugging
   3 %
   4 def test_grid =
   5 if test>1:
   6         proofrulethickness 1pt#;
   7         makegrid(0pt,0pt for i:=-5pt step 1pt until 5pt: ,i endfor)
   8                 (0pt,0pt for i:=-5pt step 1pt until 5pt: ,i endfor);
   9         proofrulethickness .1pt#;
  10         makegrid(0pt,0pt for i:=-4.8pt step .2pt until 4.8pt: ,i endfor)
  11                 (0pt,0pt for i:=-4.8pt step .2pt until 4.8pt: ,i endfor);
  12 fi
  13         enddef;
  14
  15 def treq =
  16         tracingequations := tracingonline := 1;
  17 enddef;
  18
  19
  20 def draw_staff(expr first, last, offset)=
  21 if test <> 0:
  22         pickup pencircle scaled stafflinethickness;
  23         for i:= first step 1 until last:
  24                 draw (- staff_space, (i + offset) * staff_space) .. (4 staff_space,( i+ offset)* staff_space);
  25         endfor
  26 fi;
  27
  28 enddef;
  29
  30
  31 %
  32 % Transforms
  33 %
  34
  35 def scaledabout(expr point, scale) =
  36         shifted -point scaled scale shifted point
  37 enddef;
  38
  39
  40 %
  41 % make a local (restored after endgroup) copy of t_var
  42 %
  43 def local_copy(text type, t_var)=
  44         save copy_temp;
  45         type copy_temp;
  46         copy_temp := t_var;
  47         save t_var;
  48         type t_var;
  49         t_var := copy_temp;
  50 enddef;
  51
  52
  53 %
  54 % Urgh! Want to do parametric types
  55 %
  56
  57 def del_picture_stack=
  58         save save_picture_stack, picture_stack_idx;
  59 enddef;
  60
  61 % better versions of Taupin/Egler savepic cmds
  62 %
  63 %
  64 def make_picture_stack =
  65         % override previous stack.
  66         del_picture_stack;
  67         picture save_picture_stack[];
  68         numeric picture_stack_idx;
  69         picture_stack_idx := 0;
  70         def push_picture(expr p) =
  71                 save_picture_stack[picture_stack_idx] := p ;
  72                 picture_stack_idx := picture_stack_idx + 1;
  73         enddef;
  74         def pop_picture =  save_picture_stack[decr picture_stack_idx] enddef;
  75         def top_picture = save_picture_stack[picture_stack_idx] enddef;
  76 enddef;
  77
  78
  79 % save/restore pens
  80 % why can't I delete individual pens?
  81 def make_pen_stack =
  82         del_pen_stack;
  83         pen save_pen_stack[];
  84         numeric pen_stack_idx;
  85         pen_stack_idx := 0;
  86         def push_pen(expr p) =
  87                 save_pen_stack[pen_stack_idx] := p ;
  88                 pen_stack_idx := pen_stack_idx +1;
  89         enddef;
  90         def pop_pen =  save_pen_stack[decr pen_stack_idx] enddef;
  91         def top_pen = save_pen_stack[pen_stack_idx] enddef;
  92 enddef;
  93 def del_pen_stack=
  94         save save_pen_stack, pen_stack_idx;
  95 enddef;
  96
  97 %
  98 % drawing
  99 %
 100
 101 def soft_penstroke text t =
 102         forsuffixes e = l,r: path_.e:=t; endfor
 103         if cycle path_.l:
 104           cyclestroke_
 105         else:
 106           fill path_.l .. tension1.5 .. reverse path_.r .. tension1.5 .. cycle
 107         fi
 108 enddef;
 109
 110
 111 %
 112 % make a round path segment going from P to Q. 2*A is the angle that the
 113 % path should take.
 114 %
 115
 116 def simple_serif(expr p,q, a)=
 117         p{dir(angle(q-p) -a)} .. q{ - dir(angle(p -q) + a)}
 118 enddef;
 119 %
 120
 121 % a: x diameter
 122 % b: y diameter
 123 % err_x: drift of y axis at top
 124 % err_y: drift of x axis at right
 125 def distorted_ellipse(expr a,b,err_y,err_x,super) =
 126         superellipse((a,err_x),(-err_y,b),(-a,-err_x),(err_y,-b),super);
 127         enddef;
 128
 129
 130
 131 %
 132 % draw an axis aligned block making sure that edges are on pixels.
 133 %
 134
 135 def draw_rounded_block (expr bottom_left, top_right, roundness) =
 136        save round;
 137        round = floor min(roundness,xpart (top_right-bottom_left),
 138                                    ypart (top_right-bottom_left));
 139
 140
 141        pickup pencircle scaled round;
 142
 143         begingroup;
 144         save x,y;
 145        z2+(round/2,round/2) = top_right;
 146        z4-(round/2,round/2) = bottom_left;
 147         y3 = y2;
 148         y4 = y1;
 149         x2 = x1;
 150         x4 = x3;
 151        fill bot z1 .. rt z1 --- rt z2 .. top z2 ---
 152             top z3 .. lft z3 --- lft z4 .. bot z4 --- cycle;
 153         endgroup;
 154         enddef;
 155
 156
 157
 158  def draw_block (expr bottom_left, top_right) =
 159        draw_rounded_block (bottom_left, top_right, blot_diameter);
 160        enddef;
 161
 162  def draw_gridline (expr bottom_left,top_right,thickness) =
 163        draw_rounded_block (bottom_left-(thickness/2,thickness/2),
 164                            top_right+(thickness/2,thickness/2),
 165                            thickness);
 166        enddef;
 167
 168
 169 def draw_brush(expr a,w,b,v) =
 170         save x,y;
 171         z1=a; z2=b;
 172         penpos3(w,angle(z2-z1)+90);
 173         penpos4(w,angle(z2-z1));
 174         penpos5(v,angle(z1-z2)+90);
 175         penpos6(v,angle(z1-z2));
 176         z3 = z4 = z1;
 177         z5 = z6 = z2;
 178
 179         fill z3r{z3r-z5l}..z4l..{z5r-z3l}z3l..z5r{z5r-z3l}..z6l..{z3r-z5l}z5l..cycle;
 180 enddef;
 181
 182
 183
 184 %
 185 % make a superellipsoid segment going from FROM to TO, with SUPERNESS.
 186 % Take superness = sqrt(2)/2 to get a circle segment
 187 %
 188 % see Knuth, p. 267 and p.126
 189 def super_curvelet(expr from, to, superness, dir) =
 190         if dir = 1:
 191          (superness [xpart to, xpart from], superness [ypart from,ypart to]){to - from}
 192         else:
 193          (superness [xpart from, xpart to], superness [ypart  to,ypart from]){to - from}
 194         fi
 195 enddef;
 196
 197
 198 %
 199 % Bulb with smooth inside curve.
 200 %
 201 % alpha = start direction.
 202 % beta = which side to turn to.
 203 % flare = diameter of the bulb
 204 % line = diameter of line attachment
 205 % direction = is ink on left or right side (1 or -1)
 206 %
 207 def flare_path(expr pos,alpha,beta,line,flare, direction) =
 208         begingroup;
 209         clearxy;
 210         penpos1(line,180+beta+alpha);
 211         z1r=pos;
 212         penpos2(flare,180+beta+alpha);
 213         z2=z3;
 214         penpos3(flare,0+alpha);
 215         z3l=z1r+(1/2+0.43)*flare*dir(alpha+beta) ;
 216         save taille;
 217         taille = 0.0;
 218         z4=z2r-  line * dir(alpha);
 219         penlabels(1,2,3,4);
 220         pickup pencircle;
 221         save t; t=0.833;
 222         save p;
 223         path p;
 224         p:=z1r{dir(alpha)}..z3r{dir(180+alpha-beta)}..z2l{dir(alpha+180)}
 225                 ..z3l{dir(180+alpha+beta)}..tension t
 226                 ..z4{dir(180+alpha+beta)}..z1l{dir(alpha+180)};
 227
 228         if direction = 1:
 229                 p
 230         else:
 231                 reverse p
 232         fi
 233         endgroup
 234         enddef;
 235
 236
 237
 238 def brush(expr a,w,b,v) =
 239         begingroup;
 240         draw_brush(a,w,b,v);
 241         penlabels(3,4,5,6);
 242         endgroup;
 243 enddef;
 244
 245 %
 246 % Draw a (rest) crook, starting at thickness STEM in point A,
 247 % ending a ball W to the left, diameter BALLDIAM
 248 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A
 249 %
 250 def balled_crook(expr a, w, balldiam, stem) =
 251 begingroup;
 252         save x,y;
 253         penpos1(balldiam/2,-90);
 254         penpos2(balldiam/2,0);
 255         penpos3(balldiam/2,90);
 256         penpos4(balldiam/2,180);
 257         x4r=xpart a-w; y3r=ypart a+balldiam/4;
 258         x1l=x2l=x3l=x4l;
 259         y1l=y2l=y3l=y4l;
 260         penpos5(stem,250);
 261         x5=x4r+9/8balldiam; y5r=y1r;
 262         penpos6(stem,260);
 263         x6l=xpart a; y6l=ypart a;
 264         penstroke z1e..z2e..z3e..z4e..z1e..z5e{right}..z6e;
 265         penlabels(1,2,3,4,5,6);
 266 endgroup;
 267 enddef;
 268
 269
 270 def y_mirror_char =
 271         currentpicture := currentpicture yscaled -1;
 272         set_char_box(charbp, charwd, charht, chardp);
 273 enddef;
 274
 275
 276 def xy_mirror_char =
 277         currentpicture := currentpicture scaled -1;
 278         set_char_box(charwd, charbp, charht, chardp);
 279 enddef;
 280
 281
 282 %
 283 % center_factor: typically .5, the larger, the larger the radius of the bulb
 284 % radius factor: how much the bulb curves inward
 285 %
 286 def draw_bulb(expr turndir, zl, zr, bulb_rad, radius_factor)=
 287         begingroup;
 288         clearxy;
 289         save rad, ang;
 290
 291         ang = angle(zr-zl);
 292
 293         % don't get near infinity
 294         %z0 = zr + bulb_rad * (zl-zr)/length(zr -zl);
 295         z0 = zr + bulb_rad /length(zr -zl) * (zl-zr);
 296
 297         rad =  bulb_rad;
 298
 299         z1 = z0 + radius_factor* rad * dir(ang + turndir* 100);
 300         z2 = z0 + rad * dir(ang  + turndir*300);
 301         labels(0,1,2);
 302         fill zr{dir (ang + turndir* 90)} .. z1 .. z2 -- cycle;
 303
 304         endgroup
 305 enddef;