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 def soft_start_penstroke text t =
 169         forsuffixes e = l, r:
 170                 path_.e := t;
 171         endfor;
 172
 173         if cycle path_.l:
 174                 cyclestroke_;
 175         else:
 176                 fill path_.l
 177                 -- reverse path_.r
 178                 ..tension1.5.. cycle;
 179         fi;
 180 enddef;
 181
 182
 183 def soft_end_penstroke text t =
 184         forsuffixes e = l, r:
 185                 path_.e := t;
 186         endfor;
 187
 188         if cycle path_.l:
 189                 cyclestroke_;
 190         else:
 191                 fill path_.l
 192                 ..tension1.5.. reverse path_.r
 193                 -- cycle;
 194         fi;
 195 enddef;
 196
 197
 198 %
 199 % Make a round path segment going from P to Q.  2*A is the angle that the
 200 % path should take.
 201 %
 202 def simple_serif (expr p, q, a) =
 203         p{dir (angle (q - p) - a)}
 204         .. q{-dir (angle (p - q) + a)}
 205 enddef;
 206
 207
 208 %
 209 % Draw an axis aligned block making sure that edges are on pixels.
 210 %
 211
 212 def draw_rounded_block (expr bottom_left, top_right, roundness) =
 213 begingroup;
 214         save size;
 215         save x, y;
 216
 217         % Originally, there was `floor' instead of `round', but this is
 218         % not correct because pens use `round' also.
 219         size = round min (roundness,
 220                           xpart (top_right - bottom_left),
 221                           ypart (top_right - bottom_left));
 222
 223         z2 + (size / 2, size / 2) = top_right;
 224         z4 - (size / 2, size / 2) = bottom_left;
 225         y3 = y2;
 226         y4 = y1;
 227         x2 = x1;
 228         x4 = x3;
 229
 230         pickup pencircle scaled size;
 231
 232         fill bot z1{right}
 233              .. rt z1{up}
 234              -- rt z2{up}
 235              .. top z2{left}
 236              -- top z3{left}
 237              .. lft z3{down}
 238              -- lft z4{down}
 239              .. bot z4{right}
 240              -- cycle;
 241 endgroup;
 242 enddef;
 243
 244
 245 def draw_block (expr bottom_left, top_right) =
 246         draw_rounded_block (bottom_left, top_right, blot_diameter);
 247 enddef;
 248
 249
 250 def draw_square_block (expr bottom_left, top_right) =
 251         save x, y;
 252
 253         x1 = xpart bottom_left;
 254         y1 = ypart bottom_left;
 255         x2 = xpart top_right;
 256         y2 = ypart top_right;
 257
 258         fill (x1, y1)
 259              -- (x2, y1)
 260              -- (x2, y2)
 261              -- (x1, y2)
 262              -- cycle;
 263 enddef;
 264
 265
 266 def draw_gridline (expr bottom_left, top_right, thickness) =
 267         draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
 268                             top_right + (thickness / 2, thickness / 2),
 269                             thickness);
 270 enddef;
 271
 272
 273 def draw_brush (expr a, w, b, v) =
 274         save x, y;
 275
 276         z1 = a;
 277         z2 = b;
 278         z3 = z4 = z1;
 279         z5 = z6 = z2;
 280
 281         penpos3 (w, angle (z2 - z1) + 90);
 282         penpos4 (w, angle (z2 - z1));
 283         penpos5 (v, angle (z1 - z2) + 90);
 284         penpos6 (v, angle (z1 - z2));
 285
 286         fill z3r{z3r - z5l}
 287              .. z4l
 288              .. {z5r - z3l}z3l
 289              .. z5r{z5r - z3l}
 290              .. z6l
 291              .. {z3r - z5l}z5l
 292              .. cycle;
 293 enddef;
 294
 295
 296 %
 297 % Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
 298 % Take superness = sqrt(2)/2 to get a circle segment.
 299 %
 300 % See Knuth, p. 267 and p.126.
 301
 302 def super_curvelet (expr from, to, superness, dir) =
 303         if dir = 1:
 304                 (superness [xpart to, xpart from],
 305                  superness [ypart from, ypart to]){to - from}
 306         else:
 307                 (superness [xpart from, xpart to],
 308                  superness [ypart to, ypart from]){to - from}
 309         fi
 310 enddef;
 311
 312
 313 %
 314 % Bulb with smooth inside curve.
 315 %
 316 % alpha = start direction
 317 % beta = which side to turn to
 318 % flare = diameter of the bulb
 319 % line = diameter of line attachment
 320 % direction = is ink on left or right side (1 or -1)
 321 %
 322 % Note that `currentpen' must be set correctly -- only circular pens
 323 % are supported properly.
 324
 325 def flare_path (expr pos, alpha, beta, line, flare, direction) =
 326 begingroup;
 327         save thick;
 328
 329         thick = pen_top + pen_bot;
 330
 331         clearxy;
 332
 333         penpos1' (line - thick, 180 + beta + alpha);
 334         top z1'r = pos;
 335
 336         penpos2' (flare - thick, 180 + beta + alpha);
 337         z2' = z3';
 338
 339         penpos3' (flare - thick, 0 + alpha);
 340         rt x3'l = hround (x1'r
 341                           + (1/2 + 0.43) * flare * xpart dir (alpha + beta));
 342         bot y2'l = vround (y1'r
 343                            + (1 + 0.43) * flare * ypart dir (alpha + beta));
 344
 345         rt x4' = x2'r - line * xpart dir (alpha);
 346         y4' = y2'r - line * ypart dir (alpha);
 347
 348         penlabels (1', 2', 3', 4');
 349
 350         save t, p;
 351         t = 0.833;
 352         path p;
 353
 354         p := z1'r{dir (alpha)}
 355              .. z3'r{dir (180 + alpha - beta)}
 356              .. z2'l{dir (alpha + 180)}
 357              .. z3'l{dir (180 + alpha + beta)}
 358              ..tension t.. z4'{dir (180 + alpha + beta)}
 359              .. z1'l{dir (alpha + 180)};
 360
 361         if direction <> 1:
 362                 p := reverse p;
 363         fi;
 364
 365 p
 366 endgroup
 367 enddef;
 368
 369
 370 def brush (expr a, w, b, v) =
 371 begingroup;
 372         draw_brush (a, w, b, v);
 373         penlabels (3, 4, 5, 6);
 374 endgroup;
 375 enddef;
 376
 377
 378 %
 379 % Draw a (rest) crook, starting at thickness STEM in point A,
 380 % ending a ball W to the left, diameter BALLDIAM.
 381 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
 382 %
 383
 384 def balled_crook (expr a, w, balldiam, stem) =
 385 begingroup;
 386         save x, y;
 387
 388         penpos1 (balldiam / 2, -90);
 389         penpos2 (balldiam / 2, 0);
 390         penpos3 (balldiam / 2, 90);
 391         penpos4 (balldiam / 2, 180);
 392
 393         x4r = xpart a - w;
 394         y3r = ypart a + balldiam / 4;
 395         x1l = x2l = x3l = x4l;
 396         y1l = y2l = y3l = y4l;
 397
 398         penpos5 (stem, 250);
 399         x5 = x4r + 9/8 balldiam;
 400         y5r = y1r;
 401
 402         penpos6 (stem, 260);
 403         x6l = xpart a;
 404         y6l = ypart a;
 405
 406         penstroke z1e
 407                   .. z2e
 408                   .. z3e
 409                   .. z4e
 410                   .. z1e
 411                   .. z5e{right}
 412                   .. z6e;
 413
 414         penlabels (1, 2, 3, 4, 5, 6);
 415 endgroup;
 416 enddef;
 417
 418
 419 def y_mirror_char =
 420         currentpicture := currentpicture yscaled -1;
 421
 422         set_char_box (charbp, charwd, charht, chardp);
 423 enddef;
 424
 425
 426 def xy_mirror_char =
 427         currentpicture := currentpicture scaled -1;
 428
 429         set_char_box (charwd, charbp, charht, chardp);
 430 enddef;
 431
 432
 433 %
 434 % center_factor: typically .5; the larger, the larger the radius of the bulb
 435 % radius factor: how much the bulb curves inward
 436 %
 437
 438 def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)=
 439 begingroup;
 440         save rad, ang, pat;
 441         path pat;
 442
 443         clearxy;
 444
 445         ang = angle (zr - zl);
 446
 447         % don't get near infinity
 448         % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
 449         z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);
 450
 451         rad = bulb_rad;
 452
 453         z1' = z0' + radius_factor * rad * dir (ang + turndir * 100);
 454         z2' = z0' + rad * dir (ang + turndir * 300);
 455
 456         labels (0', 1', 2');
 457
 458         pat = zr{dir (ang + turndir * 90)}
 459                .. z1'
 460                .. z2'
 461                .. cycle;
 462
 463         % avoid grazing outlines
 464         fill subpath (0, 2.5) of pat
 465              -- cycle;
 466 endgroup
 467 enddef;
 468
 469
 470 pi := 3.14159;
 471
 472
 473 %
 474 % To get symmetry at low resolutions we need to shift some points and
 475 % paths, but not if mf2pt1 is used.
 476 %
 477
 478 if known miterlimit:
 479         vardef hfloor primary x = x enddef;
 480         vardef vfloor primary y = y enddef;
 481         vardef hceiling primary x = x enddef;
 482         vardef vceiling primary y = y enddef;
 483 else:
 484         vardef hfloor primary x = floor x enddef;
 485         vardef vfloor primary y = (floor y.o_)_o_ enddef;
 486         vardef hceiling primary x = ceiling x enddef;
 487         vardef vceiling primary y = (ceiling y.o_)_o_ enddef;
 488 fi;