mf/feta-macros.mf

   1 %
   2 % debugging
   3 %
   4
   5 def print_penpos (suffix $) =
   6         message
   7           "z" & str$ & "l = (" & decimal x.$.l & ", " &decimal y.$.l & ");"
   8           & " z" & str$ & "r = (" & decimal x.$.r & ", " & decimal y.$.r & ");";
   9 enddef;
  10
  11
  12 def test_grid =
  13         if test > 1:
  14                 proofrulethickness 1pt#;
  15
  16                 makegrid
  17                   (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor)
  18                   (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor);
  19
  20                 proofrulethickness .1pt#;
  21
  22                 makegrid
  23                   (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor)
  24                   (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor);
  25         fi;
  26 enddef;
  27
  28
  29 def treq =
  30         tracingequations := tracingonline := 1;
  31 enddef;
  32
  33
  34 def draw_staff (expr first, last, offset) =
  35         if test <> 0:
  36                 pickup pencircle scaled stafflinethickness;
  37
  38                 for i := first step 1 until last:
  39                         draw (-staff_space,
  40                               (i + offset) * staff_space_rounded)
  41                              -- (4 staff_space,
  42                                  (i + offset) * staff_space_rounded);
  43                 endfor;
  44         fi;
  45 enddef;
  46
  47
  48 %
  49 % Draw the outline of the stafflines.  For fine tuning.
  50 %
  51
  52 def draw_staff_outline (expr first, last, offset) =
  53         if test <> 0:
  54                 save p;
  55                 path p;
  56
  57                 pickup pencircle scaled 2;
  58
  59                 for i := first step 1 until last:
  60                         p := (-staff_space,
  61                               (i + offset) * staff_space_rounded)
  62                              -- (4 staff_space,
  63                                  (i + offset) * staff_space_rounded);
  64
  65                         draw p shifted (0, .5 stafflinethickness);
  66                         draw p shifted (0, -.5 stafflinethickness);
  67                 endfor;
  68         fi;
  69 enddef;
  70
  71
  72 %
  73 % Transformations
  74 %
  75
  76 def scaledabout (expr point, scale) =
  77         shifted -point scaled scale shifted point
  78 enddef;
  79
  80
  81 %
  82 % make a local (restored after endgroup) copy of t_var
  83 %
  84
  85 def local_copy (text type, t_var) =
  86         save copy_temp;
  87         type copy_temp;
  88         copy_temp := t_var;
  89         save t_var;
  90         type t_var;
  91         t_var := copy_temp;
  92 enddef;
  93
  94
  95 %
  96 % Urgh! Want to do parametric types
  97 %
  98
  99 def del_picture_stack =
 100         save save_picture_stack, picture_stack_idx;
 101 enddef;
 102
 103
 104 %
 105 % better versions of Taupin/Egler savepic cmds
 106 %
 107
 108 def make_picture_stack =
 109         % override previous stack
 110         del_picture_stack;
 111         picture save_picture_stack[];
 112         numeric picture_stack_idx;
 113         picture_stack_idx := 0;
 114
 115         def push_picture (expr p) =
 116                 save_picture_stack[picture_stack_idx] := p;
 117                 picture_stack_idx := picture_stack_idx + 1;
 118         enddef;
 119
 120         def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
 121         def top_picture = save_picture_stack[picture_stack_idx] enddef;
 122 enddef;
 123
 124
 125 %
 126 % save/restore pens
 127 % why can't I delete individual pens?
 128 %
 129
 130 def make_pen_stack =
 131         del_pen_stack;
 132         pen save_pen_stack[];
 133         numeric pen_stack_idx;
 134         pen_stack_idx := 0;
 135         def push_pen (expr p) =
 136                 save_pen_stack[pen_stack_idx] := p;
 137                 pen_stack_idx := pen_stack_idx + 1;
 138         enddef;
 139         def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
 140         def top_pen = save_pen_stack[pen_stack_idx] enddef;
 141 enddef;
 142
 143
 144 def del_pen_stack=
 145         save save_pen_stack, pen_stack_idx;
 146 enddef;
 147
 148
 149 %
 150 % drawing
 151 %
 152
 153 def soft_penstroke text t =
 154         forsuffixes e = l, r:
 155                 path_.e := t;
 156         endfor;
 157
 158         if cycle path_.l:
 159                 cyclestroke_;
 160         else:
 161                 fill path_.l
 162                 ..tension1.5.. reverse path_.r
 163                 ..tension1.5.. cycle;
 164         fi;
 165 enddef;
 166
 167
 168 %
 169 % Make a round path segment going from P to Q.  2*A is the angle that the
 170 % path should take.
 171 %
 172
 173 def simple_serif (expr p, q, a) =
 174         p{dir (angle (q - p) - a)}
 175         .. q{-dir (angle (p - q) + a)}
 176 enddef;
 177
 178
 179 %
 180 % Draw an axis aligned block making sure that edges are on pixels.
 181 %
 182
 183 def draw_rounded_block (expr bottom_left, top_right, roundness) =
 184 begingroup;
 185         save size;
 186         save x, y;
 187
 188         % Originally, there was `floor' instead of `round', but this is
 189         % not correct because pens use `round' also.
 190         size = round min (roundness,
 191                           xpart (top_right - bottom_left),
 192                           ypart (top_right - bottom_left));
 193
 194         z2 + (size / 2, size / 2) = top_right;
 195         z4 - (size / 2, size / 2) = bottom_left;
 196         y3 = y2;
 197         y4 = y1;
 198         x2 = x1;
 199         x4 = x3;
 200
 201         pickup pencircle scaled size;
 202
 203         fill bot z1{right}
 204              .. rt z1{up}
 205              -- rt z2{up}
 206              .. top z2{left}
 207              -- top z3{left}
 208              .. lft z3{down}
 209              -- lft z4{down}
 210              .. bot z4{right}
 211              -- cycle;
 212 endgroup;
 213 enddef;
 214
 215
 216 def draw_block (expr bottom_left, top_right) =
 217         draw_rounded_block (bottom_left, top_right, blot_diameter);
 218 enddef;
 219
 220
 221 def draw_square_block (expr bottom_left, top_right) =
 222         save x, y;
 223
 224         x1 = xpart bottom_left;
 225         y1 = ypart bottom_left;
 226         x2 = xpart top_right;
 227         y2 = ypart top_right;
 228
 229         fill (x1, y1)
 230              -- (x2, y1)
 231              -- (x2, y2)
 232              -- (x1, y2)
 233              -- cycle;
 234 enddef;
 235
 236
 237 def draw_gridline (expr bottom_left, top_right, thickness) =
 238         draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
 239                             top_right + (thickness / 2, thickness / 2),
 240                             thickness);
 241 enddef;
 242
 243
 244 def draw_brush (expr a, w, b, v) =
 245         save x, y;
 246
 247         z1 = a;
 248         z2 = b;
 249         z3 = z4 = z1;
 250         z5 = z6 = z2;
 251
 252         penpos3 (w, angle (z2 - z1) + 90);
 253         penpos4 (w, angle (z2 - z1));
 254         penpos5 (v, angle (z1 - z2) + 90);
 255         penpos6 (v, angle (z1 - z2));
 256
 257         fill z3r{z3r - z5l}
 258              .. z4l
 259              .. {z5r - z3l}z3l
 260              .. z5r{z5r - z3l}
 261              .. z6l
 262              .. {z3r - z5l}z5l
 263              .. cycle;
 264 enddef;
 265
 266
 267 %
 268 % Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
 269 % Take superness = sqrt(2)/2 to get a circle segment.
 270 %
 271 % See Knuth, p. 267 and p.126.
 272
 273 def super_curvelet (expr from, to, superness, dir) =
 274         if dir = 1:
 275                 (superness [xpart to, xpart from],
 276                  superness [ypart from, ypart to]){to - from}
 277         else:
 278                 (superness [xpart from, xpart to],
 279                  superness [ypart to, ypart from]){to - from}
 280         fi
 281 enddef;
 282
 283
 284 %
 285 % Bulb with smooth inside curve.
 286 %
 287 % alpha = start direction
 288 % beta = which side to turn to
 289 % flare = diameter of the bulb
 290 % line = diameter of line attachment
 291 % direction = is ink on left or right side (1 or -1)
 292 %
 293 % Note that `currentpen' must be set correctly -- only circular pens
 294 % are supported properly.
 295
 296 def flare_path (expr pos, alpha, beta, line, flare, direction) =
 297 begingroup;
 298         save thick;
 299
 300         thick = pen_top + pen_bot;
 301
 302         clearxy;
 303
 304         penpos1' (line - thick, 180 + beta + alpha);
 305         top z1'r = pos;
 306
 307         penpos2' (flare - thick, 180 + beta + alpha);
 308         z2' = z3';
 309
 310         penpos3' (flare - thick, 0 + alpha);
 311         rt x3'l = hround (x1'r
 312                           + (1/2 + 0.43) * flare * xpart dir (alpha + beta));
 313         bot y2'l = vround (y1'r
 314                            + (1 + 0.43) * flare * ypart dir (alpha + beta));
 315
 316         rt x4' = x2'r - line * xpart dir (alpha);
 317         y4' = y2'r - line * ypart dir (alpha);
 318
 319         penlabels (1', 2', 3', 4');
 320
 321         save t, p;
 322         t = 0.833;
 323         path p;
 324
 325         p := z1'r{dir (alpha)}
 326              .. z3'r{dir (180 + alpha - beta)}
 327              .. z2'l{dir (alpha + 180)}
 328              .. z3'l{dir (180 + alpha + beta)}
 329              ..tension t.. z4'{dir (180 + alpha + beta)}
 330              .. z1'l{dir (alpha + 180)};
 331
 332         if direction <> 1:
 333                 p := reverse p;
 334         fi;
 335
 336 p
 337 endgroup
 338 enddef;
 339
 340
 341 def brush (expr a, w, b, v) =
 342 begingroup;
 343         draw_brush (a, w, b, v);
 344         penlabels (3, 4, 5, 6);
 345 endgroup;
 346 enddef;
 347
 348
 349 %
 350 % Draw a (rest) crook, starting at thickness STEM in point A,
 351 % ending a ball W to the left, diameter BALLDIAM.
 352 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
 353 %
 354
 355 def balled_crook (expr a, w, balldiam, stem) =
 356 begingroup;
 357         save x, y;
 358
 359         penpos1 (balldiam / 2, -90);
 360         penpos2 (balldiam / 2, 0);
 361         penpos3 (balldiam / 2, 90);
 362         penpos4 (balldiam / 2, 180);
 363
 364         x4r = xpart a - w;
 365         y3r = ypart a + balldiam / 4;
 366         x1l = x2l = x3l = x4l;
 367         y1l = y2l = y3l = y4l;
 368
 369         penpos5 (stem, 250);
 370         x5 = x4r + 9/8 balldiam;
 371         y5r = y1r;
 372
 373         penpos6 (stem, 260);
 374         x6l = xpart a;
 375         y6l = ypart a;
 376
 377         penstroke z1e
 378                   .. z2e
 379                   .. z3e
 380                   .. z4e
 381                   .. z1e
 382                   .. z5e{right}
 383                   .. z6e;
 384
 385         penlabels (1, 2, 3, 4, 5, 6);
 386 endgroup;
 387 enddef;
 388
 389
 390 def y_mirror_char =
 391         currentpicture := currentpicture yscaled -1;
 392
 393         set_char_box (charbp, charwd, charht, chardp);
 394 enddef;
 395
 396
 397 def xy_mirror_char =
 398         currentpicture := currentpicture scaled -1;
 399
 400         set_char_box (charwd, charbp, charht, chardp);
 401 enddef;
 402
 403
 404 %
 405 % center_factor: typically .5; the larger, the larger the radius of the bulb
 406 % radius factor: how much the bulb curves inward
 407 %
 408
 409 def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)=
 410 begingroup;
 411         save rad, ang;
 412
 413         clearxy;
 414
 415         ang = angle (zr - zl);
 416
 417         % don't get near infinity
 418         % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
 419         z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);
 420
 421         rad = bulb_rad;
 422
 423         z1' = z0' + radius_factor * rad * dir (ang + turndir * 100);
 424         z2' = z0' + rad * dir (ang + turndir * 300);
 425
 426         labels (0', 1', 2');
 427
 428         fill zr{dir (ang + turndir * 90)}
 429              .. z1'
 430              .. z2'
 431              -- cycle;
 432 endgroup
 433 enddef;
 434
 435
 436 pi := 3.14159;
 437
 438
 439 %
 440 % To get symmetry at low resolutions we need to shift some points and
 441 % paths, but not if mf2pt1 is used.
 442 %
 443
 444 if known miterlimit:
 445         vardef hfloor primary x = x enddef;
 446         vardef vfloor primary y = y enddef;
 447         vardef hceiling primary x = x enddef;
 448         vardef vceiling primary y = y enddef;
 449 else:
 450         vardef hfloor primary x = floor x enddef;
 451         vardef vfloor primary y = (floor y.o_)_o_ enddef;
 452         vardef hceiling primary x = ceiling x enddef;
 453         vardef vceiling primary y = (ceiling y.o_)_o_ enddef;
 454 fi;