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