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