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