Markup command indexing: don't use internal function names.
[lilypond.git] / mf / feta-macros.mf
blob944c8cd5b42dc6e0de913585fcd3c20b395612fd
2 % feta-macros.mf -- auxiliary macros for both feta and parmesan fonts
4 % source file of the GNU LilyPond music typesetter
6 % (c) 1997--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
10 % debugging
13 def print_penpos (suffix $) =
14         message
15           "z" & str$ & "l = (" & decimal x.$.l & ", " &decimal y.$.l & ");"
16           & " z" & str$ & "r = (" & decimal x.$.r & ", " & decimal y.$.r & ");";
17 enddef;
20 def test_grid =
21         if test > 1:
22                 proofrulethickness 1pt#;
24                 makegrid
25                   (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor)
26                   (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor);
28                 proofrulethickness .1pt#;
30                 makegrid
31                   (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor)
32                   (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor);
33         fi;
34 enddef;
37 def treq =
38         tracingequations := tracingonline := 1;
39 enddef;
42 def draw_staff (expr first, last, offset) =
43         if test <> 0:
44                 pickup pencircle scaled stafflinethickness;
46                 for i := first step 1 until last:
47                         draw (-staff_space,
48                               (i + offset) * staff_space_rounded)
49                              -- (4 staff_space,
50                                  (i + offset) * staff_space_rounded);
51                 endfor;
52         fi;
53 enddef;
57 % Draw the outline of the stafflines.  For fine tuning.
60 def draw_staff_outline (expr first, last, offset) =
61         if test <> 0:
62                 save p;
63                 path p;
65                 pickup pencircle scaled 2;
67                 for i := first step 1 until last:
68                         p := (-staff_space,
69                               (i + offset) * staff_space_rounded)
70                              -- (4 staff_space,
71                                  (i + offset) * staff_space_rounded);
73                         draw p shifted (0, .5 stafflinethickness);
74                         draw p shifted (0, -.5 stafflinethickness);
75                 endfor;
76         fi;
77 enddef;
81 % Transformations
84 def scaledabout (expr point, scale) =
85         shifted -point scaled scale shifted point
86 enddef;
90 % make a local (restored after endgroup) copy of t_var
93 def local_copy (text type, t_var) =
94         save copy_temp;
95         type copy_temp;
96         copy_temp := t_var;
97         save t_var;
98         type t_var;
99         t_var := copy_temp;
100 enddef;
104 % Urgh! Want to do parametric types
107 def del_picture_stack =
108         save save_picture_stack, picture_stack_idx;
109 enddef;
113 % better versions of Taupin/Egler savepic cmds
116 def make_picture_stack =
117         % override previous stack
118         del_picture_stack;
119         picture save_picture_stack[];
120         numeric picture_stack_idx;
121         picture_stack_idx := 0;
123         def push_picture (expr p) =
124                 save_picture_stack[picture_stack_idx] := p;
125                 picture_stack_idx := picture_stack_idx + 1;
126         enddef;
128         def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
129         def top_picture = save_picture_stack[picture_stack_idx] enddef;
130 enddef;
134 % save/restore pens
135 % why can't I delete individual pens?
138 def make_pen_stack =
139         del_pen_stack;
140         pen save_pen_stack[];
141         numeric pen_stack_idx;
142         pen_stack_idx := 0;
143         def push_pen (expr p) =
144                 save_pen_stack[pen_stack_idx] := p;
145                 pen_stack_idx := pen_stack_idx + 1;
146         enddef;
147         def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
148         def top_pen = save_pen_stack[pen_stack_idx] enddef;
149 enddef;
152 def del_pen_stack =
153         save save_pen_stack, pen_stack_idx;
154 enddef;
158 % drawing
161 def soft_penstroke text t =
162         forsuffixes e = l, r:
163                 path_.e := t;
164         endfor;
166         if cycle path_.l:
167                 cyclestroke_;
168         else:
169                 fill path_.l
170                 ..tension1.5.. reverse path_.r
171                 ..tension1.5.. cycle;
172         fi;
173 enddef;
176 def soft_start_penstroke text t =
177         forsuffixes e = l, r:
178                 path_.e := t;
179         endfor;
181         if cycle path_.l:
182                 cyclestroke_;
183         else:
184                 fill path_.l
185                 -- reverse path_.r
186                 ..tension1.5.. cycle;
187         fi;
188 enddef;
191 def soft_end_penstroke text t =
192         forsuffixes e = l, r:
193                 path_.e := t;
194         endfor;
196         if cycle path_.l:
197                 cyclestroke_;
198         else:
199                 fill path_.l
200                 ..tension1.5.. reverse path_.r
201                 -- cycle;
202         fi;
203 enddef;
207 % Make a round path segment going from P to Q.  2*A is the angle that the
208 % path should take.
211 def simple_serif (expr p, q, a) =
212         p{dir (angle (q - p) - a)}
213         .. q{-dir (angle (p - q) + a)}
214 enddef;
218 % Draw an axis aligned block making sure that edges are on pixels.
221 def draw_rounded_block (expr bottom_left, top_right, roundness) =
222 begingroup;
223         save size;
224         save x, y;
226         % Originally, there was `floor' instead of `round', but this is
227         % not correct because pens use `round' also.
228         size = round min (roundness,
229                           xpart (top_right - bottom_left),
230                           ypart (top_right - bottom_left));
232         z2 + (size / 2, size / 2) = top_right;
233         z4 - (size / 2, size / 2) = bottom_left;
234         y3 = y2;
235         y4 = y1;
236         x2 = x1;
237         x4 = x3;
239         pickup pencircle scaled size;
241         fill bot z1{right}
242              .. rt z1{up}
243              -- rt z2{up}
244              .. top z2{left}
245              -- top z3{left}
246              .. lft z3{down}
247              -- lft z4{down}
248              .. bot z4{right}
249              -- cycle;
250 endgroup;
251 enddef;
254 def draw_block (expr bottom_left, top_right) =
255         draw_rounded_block (bottom_left, top_right, blot_diameter);
256 enddef;
259 def draw_square_block (expr bottom_left, top_right) =
260         save x, y;
262         x1 = xpart bottom_left;
263         y1 = ypart bottom_left;
264         x2 = xpart top_right;
265         y2 = ypart top_right;
267         fill (x1, y1)
268              -- (x2, y1)
269              -- (x2, y2)
270              -- (x1, y2)
271              -- cycle;
272 enddef;
275 def draw_gridline (expr bottom_left, top_right, thickness) =
276         draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
277                             top_right + (thickness / 2, thickness / 2),
278                             thickness);
279 enddef;
282 def draw_brush (expr a, w, b, v) =
283         save x, y;
285         z1 = a;
286         z2 = b;
287         z3 = z4 = z1;
288         z5 = z6 = z2;
290         penpos3 (w, angle (z2 - z1) + 90);
291         penpos4 (w, angle (z2 - z1));
292         penpos5 (v, angle (z1 - z2) + 90);
293         penpos6 (v, angle (z1 - z2));
295         fill z3r{z3r - z5l}
296              .. z4l
297              .. {z5r - z3l}z3l
298              .. z5r{z5r - z3l}
299              .. z6l
300              .. {z3r - z5l}z5l
301              .. cycle;
302 enddef;
306 % Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
307 % Take superness = sqrt(2)/2 to get a circle segment.
309 % See Knuth, p. 267 and p.126.
311 def super_curvelet (expr from, to, superness, dir) =
312         if dir = 1:
313                 (superness [xpart to, xpart from],
314                  superness [ypart from, ypart to]){to - from}
315         else:
316                 (superness [xpart from, xpart to],
317                  superness [ypart to, ypart from]){to - from}
318         fi
319 enddef;
323 % Bulb with smooth inside curve.
325 % alpha = start direction
326 % beta = which side to turn to
327 % flare = diameter of the bulb
328 % line = diameter of line attachment
329 % direction = is ink on left or right side (1 or -1)
331 % Note that `currentpen' must be set correctly -- only circular pens
332 % are supported properly.
334 def flare_path (expr pos, alpha, beta, line, flare, direction) =
335 begingroup;
336         save thick;
338         thick = pen_top + pen_bot;
340         clearxy;
342         penpos1' (line - thick, 180 + beta + alpha);
343         top z1'r = pos;
345         penpos2' (flare - thick, 180 + beta + alpha);
346         z2' = z3';
348         penpos3' (flare - thick, 0 + alpha);
349         rt x3'l = hround (x1'r
350                           + (1/2 + 0.43) * flare * xpart dir (alpha + beta));
351         bot y2'l = vround (y1'r
352                            + (1 + 0.43) * flare * ypart dir (alpha + beta));
354         rt x4' = x2'r - line * xpart dir (alpha);
355         y4' = y2'r - line * ypart dir (alpha);
357         penlabels (1', 2', 3', 4');
359         save t, p;
360         t = 0.833;
361         path p;
363         p := z1'r{dir (alpha)}
364              .. z3'r{dir (180 + alpha - beta)}
365              .. z2'l{dir (alpha + 180)}
366              .. z3'l{dir (180 + alpha + beta)}
367              ..tension t.. z4'{dir (180 + alpha + beta)}
368              .. z1'l{dir (alpha + 180)};
370         if direction <> 1:
371                 p := reverse p;
372         fi;
375 endgroup
376 enddef;
379 def brush (expr a, w, b, v) =
380 begingroup;
381         draw_brush (a, w, b, v);
382         penlabels (3, 4, 5, 6);
383 endgroup;
384 enddef;
388 % Draw a (rest) crook, starting at thickness STEM in point A,
389 % ending a ball W to the left, diameter BALLDIAM.
390 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
393 def balled_crook (expr a, w, balldiam, stem) =
394 begingroup;
395         save x, y;
397         penpos1 (balldiam / 2, -90);
398         penpos2 (balldiam / 2, 0);
399         penpos3 (balldiam / 2, 90);
400         penpos4 (balldiam / 2, 180);
402         x4r = xpart a - w;
403         y3r = ypart a + balldiam / 4;
404         x1l = x2l = x3l = x4l;
405         y1l = y2l = y3l = y4l;
407         penpos5 (stem, 250);
408         x5 = x4r + 9/8 balldiam;
409         y5r = y1r;
411         penpos6 (stem, 260);
412         x6l = xpart a;
413         y6l = ypart a;
415         penstroke z1e
416                   .. z2e
417                   .. z3e
418                   .. z4e
419                   .. z1e
420                   .. z5e{right}
421                   .. z6e;
423         penlabels (1, 2, 3, 4, 5, 6);
424 endgroup;
425 enddef;
428 def y_mirror_char =
429         currentpicture := currentpicture yscaled -1;
431         set_char_box (charbp, charwd, charht, chardp);
432 enddef;
435 def xy_mirror_char =
436         currentpicture := currentpicture scaled -1;
438         set_char_box (charwd, charbp, charht, chardp);
439 enddef;
443 % center_factor: typically .5; the larger, the larger the radius of the bulb
444 % radius factor: how much the bulb curves inward
447 def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)=
448 begingroup;
449         save rad, ang, pat;
450         path pat;
452         clearxy;
454         ang = angle (zr - zl);
456         % don't get near infinity
457         % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
458         z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);
460         rad = bulb_rad;
462         z1' = z0' + radius_factor * rad * dir (ang + turndir * 100);
463         z2' = z0' + rad * dir (ang + turndir * 300);
465         labels (0', 1', 2');
467         pat = zr{dir (ang + turndir * 90)}
468                .. z1'
469                .. z2'
470                .. cycle;
472         % avoid grazing outlines
473         fill subpath (0, 2.5) of pat
474              -- cycle;
475 endgroup
476 enddef;
479 pi := 3.14159;
483 % To get symmetry at low resolutions we need to shift some points and
484 % paths, but not if mf2pt1 is used.
487 if known miterlimit:
488         vardef hfloor primary x = x enddef;
489         vardef vfloor primary y = y enddef;
490         vardef hceiling primary x = x enddef;
491         vardef vceiling primary y = y enddef;
492 else:
493         vardef hfloor primary x = floor x enddef;
494         vardef vfloor primary y = (floor y.o_)_o_ enddef;
495         vardef hceiling primary x = ceiling x enddef;
496         vardef vceiling primary y = (ceiling y.o_)_o_ enddef;