]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-schrift.mf
845f1c72eb3e3bd733e60d82c22f2f0d34251041
[lilypond.git] / mf / feta-schrift.mf
1 % -*- Fundamental -*-  (emacs-20 mf mode mucks
2 % feta-schrift.mf --  implement scripts
3 %
4 % source file of the Feta (defintively not an abbreviation for Font-En-Tja)
5 % music font
6 %
7 % (c) 1997--2005 Han-Wen Nienhuys <hanwen@xs4all.nl>
8 %       Jan Nieuwenhuizen <janneke@gnu.org>
9 %
10
11
12 fet_begingroup ("scripts");
13
14 def draw_fermata =
15         save alpha, radius, crook_thinness, crook_fatness, dot_size;
16         save pat;
17         path pat;
18
19         % [Wanske] and some Baerenreiter editions
20         % suggest about 80 degrees instead of a half-circle
21         alpha := 10;
22
23         radius# = 1.25 staff_space#;
24         crook_thinness# = 1.5 linethickness#;
25         crook_fatness# = 0.25 staff_space# + 1.5 linethickness#;
26
27         radius# + crook_fatness# / 2 = h#;
28         radius# + crook_thinness# / 2 = w#;
29
30         set_char_box (w#, w#, crook_thinness# / 2, h#);
31
32         define_pixels (radius, crook_thinness, crook_fatness);
33
34         dot_size# = 8/6 crook_fatness#;
35         define_whole_blacker_pixels (dot_size);
36
37         penpos1 (crook_thinness, 0);
38         penpos2 (crook_fatness, -90);
39         z1 = (-radius, 0);
40         z2 = (0, radius);
41
42         pat := z2l{left}
43                .. z1l{dir (-alpha - 90)}
44                .. {dir (90 - alpha)}z1r
45                .. {right}z2r;
46         pat := pat
47                -- reverse pat xscaled -1 shifted (-feta_eps, 0)
48                -- cycle;
49         fill pat;
50
51         pickup pencircle scaled dot_size;
52         x4 = 0;
53         bot y4 = vround (-crook_thinness / 2);
54         drawdot z4;
55 enddef;
56
57
58 fet_beginchar ("fermata up", "ufermata");
59         draw_fermata;
60         penlabels (1, 2, 4);
61 fet_endchar;
62
63
64 fet_beginchar ("fermata down", "dfermata");
65         draw_fermata;
66         y_mirror_char;
67 fet_endchar;
68
69
70 def draw_short_fermata =
71         save fat_factor, thinness, dot_size;
72         save left_dist, right_dist, se, ne;
73         pair left_dist, right_dist, se, ne;
74
75         set_char_box (staff_space#, staff_space#, 0, 2.2 staff_space#);
76
77         dot_size# = 0.266 staff_space# + 2.666 linethickness#;
78         define_whole_blacker_pixels (dot_size);
79
80         fat_factor = .11;
81         thinness = 1.5 linethickness;
82
83         pickup pencircle scaled thinness;
84
85         rt x2 = w;
86         lft x5 = -b;
87         bot y5 = 0;
88         top y3 = h;
89         y1 = y2 = y5;
90
91         x3 = 0;
92         z1 - z4 = whatever * (charwd, -charht);
93         z4 = fat_factor [z3, z5];
94
95         ne = unitvector (z3 - z5);
96         se = unitvector (z2 - z3);
97
98         left_dist = (ne rotated 90) * 0.5 thinness;
99         right_dist = (se rotated 90) * 0.5 thinness;
100
101         fill bot z5{right}
102              .. (z5 - left_dist){ne}
103              -- (((z5 - left_dist) -- (z3 - left_dist)) intersectionpoint
104                   ((z1 - right_dist) -- (z4 - right_dist)))
105              -- (z1 - right_dist){se}
106              .. bot z1{right}
107              -- bot z2{right}
108              .. (z2 + right_dist){-se}
109              -- (z3 + right_dist){-se}
110              .. top z3
111              .. (z3 + left_dist){-ne}
112              -- (z5 + left_dist){-ne}
113              .. cycle;
114
115         pickup pencircle scaled dot_size;
116
117         x1 - 2 x6 = x2;
118         bot y6 = -d;
119
120         drawdot z6;
121 enddef;
122
123 fet_beginchar ("short fermata up", "ushortfermata");
124         draw_short_fermata;
125         labels (1, 2, 3, 4, 5, 6);
126 fet_endchar;
127
128
129 fet_beginchar ("short fermata down", "dshortfermata");
130         draw_short_fermata;
131         xy_mirror_char;
132 fet_endchar;
133
134
135 def draw_long_fermata =
136         save stemthick, beamheight, dot_size, wd;
137         save pat;
138         path pat;
139
140         wd# = 2.5 staff_space#;
141         stemthick = hround (1.5 linethickness);
142         beamheight = 0.3 staff_space + linethickness;
143         dot_size# = 0.266 staff_space# + 2.666 * linethickness#;
144         define_pixels (wd);
145         define_whole_blacker_pixels (dot_size);
146
147         set_char_box (wd# / 2, wd# / 2, 0, 3/2 staff_space#);
148
149         pickup pencircle scaled blot_diameter;
150
151         top y1 = h;
152         lft x1 = -b;
153
154         pat := top z1{left}
155                .. {down}lft z1;
156
157         pickup pencircle scaled stemthick;
158
159         x2 = -b + stemthick;
160         y2 = h - beamheight;
161         lft x3 = -b;
162         bot y3 = -d;
163
164         pat := pat
165                -- lft z3
166                .. bot z3
167                .. rt z3
168                -- z2;
169         pat := pat
170                -- reverse pat xscaled -1 shifted (-feta_eps, 0)
171                -- cycle;
172
173         fill pat;
174
175         pickup pencircle scaled dot_size;
176
177         x4 = 0;
178         bot y4 = -d;
179
180         drawdot z4;
181 enddef;
182
183
184 fet_beginchar ("long fermata up", "ulongfermata");
185         draw_long_fermata;
186         labels (1, 2, 3, 4);
187 fet_endchar;
188
189
190 fet_beginchar ("long fermata down", "dlongfermata");
191         draw_long_fermata;
192         y_mirror_char;
193 fet_endchar;
194
195
196 def draw_very_long_fermata =
197         save ibeamheight, obeamheight;
198         save ihwd, ohwd, iht, oht;      % inner/outer half_width/height
199         save stemthick, dot_size;
200         save opat, ipat;
201         path opat, ipat;
202
203         ihwd# = 1.0 staff_space#;
204         ohwd# = 1.5 staff_space#;
205         iht# = 0.9 staff_space#;
206         oht# = 1.6 staff_space#;
207         define_pixels (ihwd, ohwd, iht, oht)
208
209         stemthick = hround (1.5 linethickness);
210         ibeamheight# = 0.3 staff_space#;
211         obeamheight# = 0.5 staff_space#;
212         define_pixels (ibeamheight, obeamheight);
213
214         dot_size# = (iht# - ibeamheight#) * 8/10;
215         define_whole_blacker_pixels (dot_size);
216
217         set_char_box (ohwd#, ohwd#, 0, oht#);
218
219         pickup pencircle scaled blot_diameter;
220
221         top y1 = oht;
222         lft x1 = -ohwd;
223         top y11 = iht;
224         lft x11 = -ihwd;
225
226         opat := top z1{left}
227                 .. {down}lft z1;
228         ipat := top z11{left}
229                 .. {down}lft z11;
230
231         pickup pencircle scaled stemthick;
232
233         x2 = -ohwd + stemthick;
234         y2 = oht - obeamheight;
235         lft x3 = -ohwd;
236         bot y3 = 0;
237         x12 = -ihwd + stemthick;
238         y12 = iht - ibeamheight;
239         lft x13 = -ihwd;
240         bot y13 = 0;
241
242         opat := opat
243                 -- lft z3
244                 .. bot z3
245                 .. rt z3
246                 -- z2;
247         opat := opat
248                 -- reverse opat xscaled -1 shifted (-feta_eps, 0)
249                 -- cycle;
250         ipat := ipat
251                 -- lft z13
252                 .. bot z13
253                 .. rt z13
254                 -- z12;
255         ipat := ipat
256                 -- reverse ipat xscaled -1 shifted (-feta_eps, 0)
257                 -- cycle;
258
259         fill opat;
260         fill ipat;
261
262         pickup pencircle scaled dot_size;
263
264         x4 = 0;
265         bot y4 = -d;
266
267         drawdot z4;
268 enddef;
269
270
271 fet_beginchar ("very long fermata up", "uverylongfermata");
272         draw_very_long_fermata;
273         labels (1, 2, 3, 11, 12, 13, 4);
274 fet_endchar;
275
276
277 fet_beginchar ("very long fermata down", "dverylongfermata");
278         draw_very_long_fermata;
279         y_mirror_char;
280 fet_endchar;
281
282
283 %
284 % Thumbs are used in cello music.
285 % TODO : thumbs should look like the finger-font and should be placed in
286 % the same way in the score.
287 %
288
289 fet_beginchar ("Thumb", "thumb");
290         save thin, height, width, thick, depth;
291         height# = 5/4 width#;
292         height# = staff_space#;
293         depth# = 1.6 (height# / 2);
294
295         set_char_box (width# / 2, width# / 2, depth#, height# / 2);
296
297         define_pixels (height, width);
298
299         thin = .6 linethickness + 0.06 staff_space;
300         2 thick + 0.5 (height - 2 thin) = width;
301
302         penpos1 (thick, 0);
303         penpos2 (thin, 90);
304         penpos3 (thick, 180);
305         penpos4 (thin, 270);
306         z1r = (w, 0);
307         z2r = (0, h);
308         z3r = (-w, 0);
309         z4r = (0, -h);
310
311         penlabels (1, 2, 3, 4);
312
313         penstroke z1e{up}
314                   .. z2e{left}
315                   .. z3e{down}
316                   .. z4e{right}
317                   .. cycle;
318
319         save brush_thick;
320         y5 = -d + brush_thick / 2;
321         brush_thick = 0.9 thick;
322         x5 = 0;
323
324         labels (5);
325
326         draw_brush (z4r, 1.4 thin, z5, brush_thick);
327 fet_endchar;
328
329
330 %
331 % `\accent' is TeX reserved.
332 %
333
334 def draw_accent (expr bottom_left, top_right, thickness, diminish) =
335         save thinning_start;
336         thinning_start = 0.4;
337         pickup pencircle scaled thickness;
338
339         lft x1 = xpart bottom_left;
340         top y1 = ypart top_right;
341         lft x6 = xpart bottom_left;
342         bot y6 = ypart bottom_left;
343
344         rt z4 = (xpart top_right, (ypart top_right + ypart bottom_left) / 2);
345         x5 = x3 = thinning_start [xpart top_right, xpart bottom_left]
346                   - linethickness + 0.1 staff_space;
347         z3 = whatever [z1, z4];
348         z5 = whatever [z6, z4];
349
350         penpos1 (thickness, angle (z3 - z1) + 90);
351         penpos3 (thickness, angle (z3 - z1) + 90);
352         penpos4 (thickness, 90);
353         penpos5 (thickness, angle (z6 - z5) + 90);
354         penpos6 (thickness, angle (z6 - z5) + 90);
355
356         x4 - x7 = diminish * thickness;
357         y7 = y4;
358
359         fill z1l
360              -- z3l
361              -- z7
362              -- z5l
363              -- z6l
364              .. lft z6{down}
365              .. bot z6
366              .. z6r
367              -- z4l
368              ..tension 0.8.. rt z4
369              ..tension 0.8.. z4r
370              -- z1r
371              .. top z1
372              .. lft z1{down}
373              .. cycle;
374 enddef;
375
376
377 fet_beginchar ("> accent", "sforzato");
378         set_char_box (.9 staff_space#, .9 staff_space#,
379                       .5 staff_space#, .5 staff_space#);
380
381         draw_accent ((-w, -d), (w, h),
382                      0.05 staff_space + linethickness, 0.7);
383         penlabels (1, 3, 4, 5, 6);
384         labels (7);
385 fet_endchar;
386
387
388 fet_beginchar ("espr", "espr");
389         set_char_box (1.9 staff_space#, 1.9 staff_space#,
390                       .5 staff_space#, .5 staff_space#);
391
392         draw_accent ((w - 1.78 staff_space, -d), (w, h),
393                      0.05 staff_space + linethickness, 0.6);
394         addto currentpicture also currentpicture xscaled -1;
395 fet_endchar;
396
397
398 fet_beginchar ("staccato dot", "staccato");
399         save radius;
400         radius# = 0.20 * staff_space#;
401         define_whole_pixels (radius);
402
403         pickup pencircle scaled 2 radius;
404         drawdot (0, 0);
405
406         set_char_box (radius#, radius#, radius#, radius#);
407 fet_endchar;
408
409
410 def draw_staccatissimo =
411         save radius, height;
412         height# = .8 staff_space#;
413         radius# = linethickness# + .1 staff_space#;
414         define_whole_blacker_pixels (radius);
415         define_pixels (height);
416
417         draw_brush ((0, 0), linethickness, (0, height), 2 radius);
418
419         set_char_box (radius#, radius#,
420                       blot_diameter# / 2, height# + radius#);
421 enddef;
422
423
424 fet_beginchar ("staccatissimo/martellato up", "ustaccatissimo");
425         draw_staccatissimo;
426 fet_endchar;
427
428
429 fet_beginchar ("staccatissimo/martellato down", "dstaccatissimo");
430         draw_staccatissimo;
431         y_mirror_char;
432 fet_endchar;
433
434
435 fet_beginchar ("portato/single tenuto", "tenuto");
436         save thick;
437         thick# = 1.6 linethickness#;
438         define_whole_blacker_pixels (thick);
439
440         set_char_box (.6 staff_space#, .6 staff_space#,
441                       thick# / 2, thick# / 2);
442
443         draw_rounded_block ((-b, -thick / 2), (w, thick / 2), thick);
444 fet_endchar;
445
446
447 def draw_portato =
448         save thick, dot_size;
449         thick# = 1.4 linethickness#;
450         dot_size# = 2.4 linethickness# + 0.08 staff_space#;
451         define_whole_blacker_pixels (thick, dot_size);
452
453         set_char_box (.6 staff_space#, .6 staff_space#,
454                       thick# / 2, .5 staff_space# + .5 dot_size#);
455
456         draw_rounded_block ((-b, -thick / 2), (w, thick / 2), thick);
457
458         pickup pencircle scaled dot_size;
459         drawdot (0, h);
460 enddef;
461
462
463 fet_beginchar ("portato/tenuto with staccato", "uportato");
464         draw_portato;
465 fet_endchar;
466
467
468 fet_beginchar ("portato/tenuto with staccato", "dportato");
469         draw_portato;
470         y_mirror_char
471 fet_endchar;
472
473
474 def draw_marcato =
475         save fat_factor, thinness;
476         save left_dist, right_dist, ne, se;
477         pair left_dist, right_dist, ne, se;
478
479         set_char_box (staff_space# / 2, staff_space# / 2,
480                       0, 1.1 staff_space#);
481
482         fat_factor = .3;
483         thinness = linethickness;
484
485         pickup pencircle scaled thinness;
486
487         rt x2 = w;
488         lft x5 = -b;
489         bot y5 = 0;
490         top y3 = h;
491         y1 = y2 = y5;
492
493         x3 =0;
494         z1 - z4 = whatever * (charwd, -charht);
495         z4 = fat_factor [z3, z5];
496
497         ne = unitvector (z3 - z5);
498         se = unitvector (z2 - z3);
499
500         left_dist = (ne rotated 90) * 0.5 thinness;
501         right_dist = (se rotated 90) * 0.5 thinness;
502
503         fill bot z5{right}
504              .. (z5 - left_dist){ne}
505              -- (((z5 - left_dist) -- (z3 - left_dist)) intersectionpoint
506                   ((z1 - right_dist) -- (z4 - right_dist)))
507              -- (z1 - right_dist){se}
508              .. bot z1{right}
509              -- bot z2{right}
510              .. (z2 + right_dist){-se}
511              -- (z3 + right_dist){-se}
512              .. top z3
513              .. (z3 + left_dist){-ne}
514              -- (z5 + left_dist){-ne}
515              .. cycle;
516 enddef;
517
518
519 fet_beginchar ("marcato up", "umarcato");
520         draw_marcato;
521         labels (1, 2, 3, 4, 5);
522 fet_endchar;
523
524
525 %
526 % The down marcato char (not very much used).
527 % Contrary to what some MF/TeX `gurus' believe
528 % it is *point*-symmetric with the "up" version
529 %
530
531 fet_beginchar ("marcato down", "dmarcato");
532         draw_marcato;
533         xy_mirror_char;
534 fet_endchar;
535
536
537 %
538 % used in french horn music todo
539 %
540 % TODO: too light at 20pt
541 %
542
543 fet_beginchar ("open (unstopped)", "open");
544         save thin, height, width, thick;
545
546         height# = 5/4 width#;
547         height# = staff_space#;
548         thin = .6 linethickness + 0.06 staff_space;
549
550         set_char_box (width# / 2, width# / 2, height# / 2, height# / 2);
551
552         define_pixels (width, height);
553
554         2 thick + 0.6 (height - 2 thin) = width;
555
556         penpos1 (thick, 0);
557         penpos2 (thin, 90);
558         penpos3 (thick, 180);
559         penpos4 (thin, 270);
560         z1r = (w, 0);
561         z2r = (0, h);
562         z3r = (-w, 0);
563         z4r = (0, -h);
564
565         penlabels (1, 2, 3, 4);
566
567         penstroke z1e{up}
568                   .. z2e{left}
569                   .. z3e{down}
570                   .. z4e{right}
571                   .. cycle;
572 fet_endchar;
573
574
575 fet_beginchar ("plus (stopped)", "stopped");
576         save hthick, vthick, size, outer_hsize, outer_vsize;
577
578         hthick# = vthick# = 2 linethickness#;
579         size# = 1.1 staff_space#;
580         define_whole_blacker_pixels (vthick);
581         define_whole_vertical_blacker_pixels (hthick);
582
583         set_char_box (size# / 2, size# / 2, size# / 2, size# / 2);
584
585         outer_hsize = hround ((b + w - vthick) / 2);
586         outer_vsize = vround ((h + d - hthick) / 2);
587         w := b := (2 outer_hsize + vthick) / 2;
588         h := d := (2 outer_vsize + hthick) / 2;
589
590         draw_rounded_block ((-b, -d + outer_vsize),
591                             (w, -d + outer_vsize + hthick), hthick);
592         draw_rounded_block ((-b + outer_hsize, -d),
593                             (-b + outer_hsize + vthick, h), vthick);
594 fet_endchar;
595
596
597 fet_beginchar ("Upbow", "upbow");
598         save ht, wd, thick;
599
600         thick = 1.4 linethickness;
601         wd# = 1.3 staff_space#;
602         ht# = 1.6 wd#;
603
604         set_char_box (wd# / 2, wd# / 2, 0, ht#);
605
606         draw_accent ((-h, -w), (0, w), thick, 0.9);
607         currentpicture := currentpicture rotated -90;
608 fet_endchar;
609
610
611 fet_beginchar ("Downbow", "downbow");
612         save stemthick, beamheight, wd;
613         save pat;
614         path pat;
615
616         wd# = 1.5 staff_space#;
617         define_pixels (wd);
618
619         stemthick = hround (1.2 linethickness);
620
621         set_char_box (wd# / 2, wd# / 2, 0, 4/3 staff_space#);
622
623         beamheight = 4/10 h;
624
625         pickup pencircle scaled blot_diameter;
626
627         top y1 = h;
628         lft x1 = -b;
629
630         pat := top z1{left}
631                .. {down}lft z1;
632
633         pickup pencircle scaled stemthick;
634
635         x2 = -b + stemthick;
636         y2 = h - beamheight;
637         lft x3 = -b;
638         bot y3 = -d;
639
640         pat := pat
641                -- lft z3
642                .. bot z3
643                .. rt z3
644                -- z2;
645         pat := pat
646                -- reverse pat xscaled -1 shifted (-feta_eps, 0)
647                -- cycle;
648
649         fill pat;
650
651         labels (1, 2, 3);
652 fet_endchar;
653
654 %
655 % Inspired by a computer-set version of Auf dem Strom by Baerenreiter.
656 %
657
658 def draw_turn =
659         save thin, thick, ball_diam, darkness;
660         save wd, ht, thick_nibangle, ball_nib_thick;
661         save turndir;
662         pair turndir;
663
664         wd# = 35/16 staff_space#;
665         ht# = 18/17 staff_space#;
666         darkness = 0.3 linethickness + 0.09 staff_space;
667
668         set_char_box (wd# / 2, wd# / 2, ht# / 2, ht# / 2);
669
670         thick_nibangle = 60;
671         thick = 3 darkness;
672         thin = darkness;
673         ball_nib_thick = 2.7 darkness;
674         ball_diam = ball_nib_thick + (h - ball_nib_thick) / 10;
675
676         x3l = w;
677         y3 = 0;
678         y4l = h;
679         x4 = x2;
680         x2l = w / 2;
681         y2l = -d;
682         z1 = (0,0);
683
684         penpos1 (1.1 thick, thick_nibangle);
685         penpos2 (thick, thick_nibangle);
686         penpos3 (thin, 180);
687         penpos4 (ball_nib_thick, -90);
688
689         path swoosh, ploop;
690         swoosh := z1l{curl 0}
691                   .. z2l
692                   .. z3l{up}
693                   .. {left}z4l
694                   -- z4r
695                   .. z3r{down}
696                   .. z2r{left};
697         fill swoosh
698              .. swoosh scaled -1 shifted (-feta_eps, -feta_eps)
699              .. cycle;
700
701         x5r = x4;
702         y5r = y4l - ball_diam / 2;
703         z6r = z5r;
704
705         penpos5 (1.6 ball_diam / 2, 10);
706         penpos6 (ball_diam / 2, 150);
707
708         ploop := z4l{left}
709                  .. z5l
710                  .. z6l
711                  -- cycle;
712         fill ploop;
713         fill ploop scaled -1 shifted (-feta_eps, -feta_eps);
714 enddef;
715
716
717 fet_beginchar ("Reverse turn", "reverseturn");
718         draw_turn;
719         currentpicture := currentpicture yscaled -1;
720 fet_endchar;
721
722
723 fet_beginchar ("Turn", "turn");
724         draw_turn;
725         penlabels (1, 2, 3, 4, 5, 6, 7);
726 fet_endchar;
727
728
729 %
730 % Inspired by a (by now) PD edition of Durand & C'ie edition of
731 % Saint-Saens' Celloconcerto no. 1
732 %
733 % FIXME take out hardcoded vars.
734 % FIXME the two loops on the `t' should be smoother (and the left one bigger).
735 % FIXME generic macros for serifs: top of the t and bottom of r
736 %
737
738 fet_beginchar ("Trill (`tr')", "trill");
739         save start_nib_angle, ascender_extra, ex, hair_thick, fatness;
740         save slant, t_fatness, r_fatness, kerning, t_overshoot;
741         save uitschieter, bulb_size, krul_ang;
742         save u, v;
743
744         ascender_extra# = 1/2 ex#;
745         ascender# = ascender_extra# + ex#;
746         ex# = 1.4 staff_space#;
747         kerning# = 0.6 ex#;
748         start_nib_angle = 20;
749         bulb_size = 0.8;
750         define_pixels (ex, ascender_extra, ascender, kerning);
751
752         t_overshoot = 0.03 ex;
753         fatness = 12/40 ex;
754         t_fatness = 0.78 fatness;
755         t_width =  1.9 t_fatness;
756         r_fatness = 0.78 fatness;
757         uitschieter = 0.48 ex;
758         hair_thick = linethickness;
759         r_flare = .5 hair_thick + 0.25 r_fatness;
760         r_width =  2 r_fatness + 0.25 kerning;
761         slant = .2;
762
763         local_copy (transform)(currenttransform);
764         currenttransform := currenttransform slanted slant
765                                              shifted (-staff_space, 0);
766
767         set_char_box (.85 staff_space#, .85 staff_space#, 0, ascender#);
768
769         y1 = ascender;
770
771         % try to position in such a way that the center is the visual
772         % center
773
774         x1l = 0.2 staff_space;
775         x1r - x1l = t_fatness;
776         penpos1 (start_nib_wid, start_nib_angle);
777
778         z2 = (x1, 7/18 ex);
779         penpos2 (start_nib_wid, start_nib_angle);
780
781         z3l = (x2l + 0.5 t_width, - t_overshoot);
782
783         z4l = (x2l + t_width, 0.23 ex);
784         penpos4 (whatever, 180);        % 200
785         x4l - x4r = hair_thick;
786
787         x3r = 0.5 [x4r, x2r];
788 %       1.7 [x3l, x3r] = x4r;
789         y3r - y3l = 0.6 t_fatness;
790
791         save krul_p;
792         path krul_p;
793
794         krul_ang = 32;
795
796         pickup pencircle scaled hair_thick;
797
798         z5 = (x2l + t_fatness / 2, 2/3 ex);
799         lft x6 = x2l - uitschieter;
800         y6 = y5;                                % - 1/20 ex;
801         z7 = z5 + whatever * dir krul_ang;
802         up_angle = krul_ang;                    % = angle (z7-z5)
803         x7 = 5/10 kerning + x5;
804
805         krul_p := z4{up}
806                   ..tension 0.98.. z5
807                   .. z6
808                   .. z5{z7 - z5}
809                   -- z7;
810
811         z4' = point 0.85 of krul_p;
812         penpos4' (hair_thick, angle (direction 0.85 of krul_p) + 90);
813
814         % the body of the `t' and the bottom loop
815         fill z1r{dir (angle (z1l - z1r) + 30)}
816              .. z1l{-dir (angle (z1r - z1l) - 45)}
817              -- z2l{down}
818              ..tension (1 + .5 slant).. z3l{right}
819              .. z4l{up}
820              .. z4'l{direction 0.85 of krul_p}
821              -- z4'r{-direction 0.85 of krul_p}
822              .. z4r{down}
823              .. z3r{left}
824              ..tension (1.5 + .7 slant).. z2r{up}
825              -- cycle;
826
827         z5' = point 1.1 of krul_p;
828         penpos5' (hair_thick, angle (direction 1.1 of krul_p) + 90);
829         z5'' = point 1.5 of krul_p;
830         penpos5'' (hair_thick, angle (direction 1.5 of krul_p) + 90);
831         z5''' = point 1.8 of krul_p;
832         penpos5''' (hair_thick, angle (direction 1.8 of krul_p) + 90);
833         z6 = point 2 of krul_p;
834         penpos6 (hair_thick, angle (direction 2 of krul_p) + 90);
835         z6' = point 2.3 of krul_p;
836         penpos6' (hair_thick, angle (direction 2.3 of krul_p) + 90);
837         z6'' = point 2.6 of krul_p;
838         penpos6'' (hair_thick, angle (direction 2.6 of krul_p) + 90);
839         z6''' = point 2.9 of krul_p;
840         penpos6''' (hair_thick, angle (direction 2.9 of krul_p) + 90);
841         penpos7 (hair_thick, up_angle + 90);
842         z7' = point 3.2 of krul_p;
843         penpos7' (hair_thick, angle (direction 3.2 of krul_p) + 90);
844
845         % the left loop
846         penstroke z5'e{direction 1.1 of krul_p}
847                   .. z5''e{direction 1.5 of krul_p}
848                   .. z5'''e{direction 1.8 of krul_p}
849                   .. z6e{direction 2 of krul_p}
850                   .. z6'e{direction 2.3 of krul_p}
851                   .. z6''e{direction 2.6 of krul_p}
852                   .. {direction 2.9 of krul_p}z6'''e;
853
854         y9 = 3/4 ex;
855         x9 = x1 + kerning;
856         penpos9 (r_fatness, 0);
857
858         x10 = x9;
859         y10 = -0.3 linethickness;
860         penpos10 (r_fatness, 0);
861
862         penpos11 (hair_thick, -4);
863         z11r = z9r;
864
865         z13l = (x9l + r_width, y11 - linethickness);
866         penpos13 (r_flare, 180);
867
868         z15 = z13r - (bulb_size * r_fatness, 0);
869         z14 = 0.5 [z13l, z15] - (0, bulb_size * r_fatness);
870
871         save before, after;
872         path before, after;
873         before := z13l{up}
874                   .. {down}z11l;
875         after := z9r{up}
876                  .. z7r{z7' - z7}
877                  -- z7'r;
878         (u, v) = before intersectiontimes after;
879
880         save before_bulb, after_bulb;
881         path before_bulb, after_bulb;
882         before_bulb := z9r{up}
883                        ..tension 0.94.. z13r{down};
884         after_bulb := z13l{up}
885                       ..tension 1.06.. z15{down};
886         (u_bulb, v_bulb) = before_bulb intersectiontimes after_bulb;
887
888         % the connection between `t' and `r', the body of the `r',
889         % and the bulb
890         fill z7'l
891              -- z7l{z7 - z7'}
892              .. z9l{down}
893              -- simple_serif (z10l, z10r, -30)
894              -- z9r{up}
895              .. subpath (0, u_bulb) of before_bulb
896              .. subpath (v_bulb, infinity) of after_bulb
897              .. z14
898              .. z13l{up}
899              .. subpath (0, u) of before
900              .. subpath (v, infinity) of after
901              -- cycle;
902
903         penlabels (range 1 thru 15);
904         penlabels (4', 5', 5'', 5''', 6', 6'', 6''', 7');
905 fet_endchar;
906
907
908 def draw_heel =
909         save radius, thickness;
910         save pat;
911         path pat;
912
913         radius# := .5 staff_space#;
914
915         set_char_box (radius#, radius#, radius#, 2/3 staff_space#);
916
917         thickness := hround (1.5 linethickness);
918
919         pickup pencircle scaled thickness;
920
921         rt x1 = b;
922         top y1 = h;
923
924         x2 =x1;
925         y2 = 0;
926
927         x3 = 0;
928         bot y3 = -d;
929
930         pat := top z3{right}
931                .. lft z2{up}
932                -- lft z1
933                .. top z1
934                .. rt z1
935                -- rt z2{down}
936                .. bot z3{left};
937         pat := pat
938                -- reverse pat xscaled -1 shifted (-feta_eps, 0)
939                -- cycle;
940         fill pat;
941 enddef;
942
943
944 fet_beginchar ("left heel", "upedalheel");
945         draw_heel;
946         labels (1, 2, 3);
947 fet_endchar;
948
949
950 fet_beginchar ("right heel", "dpedalheel");
951         draw_heel;
952         y_mirror_char;
953 fet_endchar;
954
955
956 def draw_toe =
957         save ht, wd, thickness;
958
959         thickness := 1.5 linethickness;
960         ht# := 1.5 staff_space#;
961         wd# := 1/3 ht#;
962         define_pixels (ht, wd);
963
964         set_char_box (wd#, wd#, 0, ht#);
965         draw_accent ((-h, -w), (0, w), thickness, 0.9);
966         currentpicture := currentpicture rotated -90;
967 enddef;
968
969
970 fet_beginchar ("left toe", "upedaltoe");
971         draw_toe;
972 fet_endchar;
973
974
975 fet_beginchar ("right toe", "dpedaltoe");
976         draw_toe;
977         y_mirror_char;
978 fet_endchar;
979
980
981 fet_beginchar ("Flageolet", "flageolet");
982         save height, width, thickness, superness;
983
984         height# = 4/15 staffsize#;
985         width# = height#;
986         thickness# = blot_diameter#;
987         define_pixels (height, width);
988         define_whole_blacker_pixels (thickness);
989
990         set_char_box (width# / 2, width# / 2, height# / 2, height# / 2);
991
992         penpos1 (thickness, 90);
993         penpos2 (thickness, 180);
994         penpos3 (thickness, 270);
995         penpos4 (thickness, 0);
996
997         x1 = 0;
998         y1r = h;
999         x4r = w;
1000         x2r = -x4r;
1001         y2 = 0;
1002         y4 = y2;
1003         x3 = x1;
1004         y3r = -y1r;
1005
1006         penlabels (1, 2, 3, 4);
1007
1008         % mf doesn't handle pixel dropouts in outline objects, so we use
1009         % `draw' if not called by mpost
1010         if known miterlimit:
1011                 penstroke z1e
1012                           .. z2e
1013                           .. z3e
1014                           .. z4e
1015                           .. cycle;
1016         else:
1017                 pickup pencircle scaled thickness;
1018                 draw z1
1019                      .. z2
1020                      .. z3
1021                      .. z4
1022                      .. cycle;
1023         fi;
1024 fet_endchar;
1025
1026
1027 %
1028 % TODO:  ARGRGHGH code dup.
1029 %
1030
1031 fet_beginchar ("Segno", "segno");
1032         save thin, thick, ball_diam, darkness, pointheight;
1033         save wd, ht, thick_nibangle, ball_nib_thick;
1034         save turndir;
1035         pair turndir;
1036
1037         ht# = 3 staff_space#;
1038         wd# = 2 staff_space#;
1039         darkness = .08 staff_space + 0.4 linethickness;
1040
1041         set_char_box (wd# / 2, wd# / 2, ht# / 2, ht# / 2);
1042
1043         thick_nibangle = 30;
1044         thick = 3 darkness;
1045         thin = darkness;
1046         ball_nib_thick = 2.7 darkness;
1047         ball_diam = ball_nib_thick + (w - ball_nib_thick) / 10;
1048         pointheight = 2 linethickness;
1049
1050         y3l = h;
1051         2 x3 = x2 + x4;
1052         x4 = 0;
1053         y4 = y2;
1054         y2l = .6 h;
1055         x2l = -b;
1056         z1 = (0, 0);
1057
1058         penpos1 (thick, 2 thick_nibangle);
1059         penpos2 (thick, thick_nibangle);
1060         penpos3 (thin, -90);
1061         penpos4 (ball_nib_thick, 180 - thick_nibangle);
1062
1063         save swoosh, ploop;
1064         path swoosh, ploop;
1065
1066         swoosh := z1l{curl 0}
1067                   .. z2l
1068                   .. z3l{right}
1069                   .. {down}z4l
1070                   -- z4r
1071                   .. z3r{left}
1072                   .. z2r{down};
1073         fill swoosh
1074              .. (swoosh scaled -1)
1075              .. cycle;
1076
1077         y5r = y4;
1078         x5r = x4l - ball_diam / 2;
1079         z6r = z5r;
1080
1081         penpos5 (1.6 ball_diam / 2, 100);
1082         penpos6 (ball_diam / 2, 240);
1083
1084         ploop := z4l{down}
1085                  .. z5l
1086                  .. z6l
1087                  -- cycle;
1088         fill ploop;
1089         fill ploop scaled -1;
1090
1091         penpos7 (2 thin, 0);
1092         z7l = (-b, -d);
1093         penpos8 (2 thin, 0);
1094         z8r = (w, h);
1095
1096         penstroke z7e
1097                   -- z8e;
1098
1099         pickup pencircle scaled 2 thin;
1100         drawdot (-x2r, pointheight);
1101         drawdot (x2r, -pointheight);
1102
1103         penlabels (range 1 thru 8);
1104 fet_endchar;
1105
1106
1107 fet_beginchar ("Coda", "coda");
1108         save stickout, thin, thick, codawidth, codaheight;
1109
1110         stickout# = 0.35 staff_space#;
1111         codawidth# = 2/3 staff_space#;
1112         codaheight# = staff_space#;
1113         define_pixels (codawidth, codaheight);
1114
1115         set_char_box (codawidth# + stickout#, codawidth# + stickout#,
1116                       codaheight# + stickout#, codaheight# + stickout#);
1117
1118         thin = 1.2 linethickness;
1119         0.1 (codaheight - 2 thin) = (codawidth - 2 thick);
1120
1121         penpos1 (thick, 0);
1122         penpos2 (thin, -90);
1123         penpos3 (thick, -180);
1124         penpos4 (thin, -270);
1125
1126         x1l = -codawidth;
1127         y2l = codaheight;
1128         y1 = 0;
1129         x2 = 0;
1130         z3 = -z1;
1131         z4 = -z2;
1132
1133         penlabels (1, 2, 3, 4);
1134
1135         penstroke z1e{up}
1136                   .. z2e{right}
1137                   .. z3e{down}
1138                   .. z4e{left}
1139                   .. cycle;
1140
1141         draw_gridline ((0, -h), (0, h), thin);
1142         draw_gridline ((-w, 0), (w, 0), thin);
1143 fet_endchar;
1144
1145
1146 fet_beginchar ("Varied Coda", "varcoda");
1147         save thin, thick, codawidth, codaheight;
1148         thin# = 1.2 linethickness#;
1149         thick# = 1.0 linethickness# + 0.25 staff_space#;
1150         codawidth# = 2/3 staff_space#;
1151         codaheight# = staff_space#;
1152         define_pixels (thin, thick, codawidth, codaheight);
1153
1154         set_char_box (codawidth# + thick#, codawidth# + thick#,
1155                       codaheight# + thick#, codaheight# + thick#);
1156
1157         x1 = -codawidth + .5 thick;
1158         y1 = y2 - thin;
1159         x2 = codawidth - .5 thick;
1160         y2 = codaheight;
1161         draw_block (z1, z2);
1162
1163         x3 = -codawidth;
1164         y3 = -codaheight;
1165         x4 = x3 + thick;
1166         y4 = y2;
1167         draw_block (z3, z4);
1168
1169         labels (1, 2, 3, 4);
1170
1171         addto currentpicture also currentpicture scaled -1;
1172
1173         draw_gridline ((0, -h), (0, h), thin);
1174         draw_gridline ((-w, 0), (w, 0), thin);
1175 fet_endchar;
1176
1177
1178 def draw_comma =
1179         save alpha, thick, thin, ht;
1180
1181         alpha := 35;
1182         thin# = 1.2 linethickness#;
1183         thick# = 3 linethickness#;
1184         ht# = .6 staff_space#;
1185         define_pixels (thin, thick, ht);
1186
1187         set_char_box (0, .5 staff_space#, ht#, ht#);
1188
1189         penpos1 (thick, alpha);
1190         penpos2 (thick, alpha + 90);
1191         penpos3 (thin, 180 - alpha);
1192         penpos4 (thin, 90 - alpha);
1193
1194         x3r = 0;
1195         x1l = x3l;
1196         y2r = -y4l = h;
1197         z1 = z2;
1198         z3 = z4;
1199
1200         fill z1l{dir (alpha + 90)}
1201              .. z2r{dir alpha}
1202              .. z1r{dir (alpha - 90)}
1203              .. z3l{dir (270 - alpha)}
1204              .. z4l{dir (180 - alpha)}
1205              .. z3r{dir (90-alpha)}
1206              .. cycle;
1207 enddef;
1208
1209
1210 fet_beginchar ("Right Comma", "rcomma");
1211         draw_comma;
1212         penlabels (1, 2, 3, 4);
1213 fet_endchar;
1214
1215
1216 fet_beginchar ("Left Comma", "lcomma");
1217         draw_comma;
1218         xy_mirror_char;
1219 fet_endchar;
1220
1221
1222 def draw_varcomma =
1223         save thick, thin, ht, wd, alpha;
1224
1225         alpha := 35;
1226         thin# = 1.2 linethickness#;
1227         thick# = 3 linethickness#;
1228         ht# = .6 staff_space#;
1229         wd# = .25 staff_space#;
1230         define_pixels (thin, thick, ht, alpha);
1231
1232         set_char_box (wd#, wd#, ht#, ht#);
1233
1234         z1 = (-b, -d);
1235         z2 = (w, h);
1236
1237         draw_brush (z1, thin, z2, thick);
1238 enddef;
1239
1240
1241 fet_beginchar ("Right Varied Comma", "rvarcomma");
1242         draw_varcomma;
1243         labels (1, 2);
1244 fet_endchar;
1245
1246
1247 fet_beginchar ("Left Varied Comma", "lvarcomma");
1248         draw_varcomma;
1249         xy_mirror_char;
1250 fet_endchar;
1251
1252
1253 thick# := 1/24 designsize;
1254 define_blacker_pixels (thick);
1255
1256 rthin := 0.075 * staff_space + 0.5 linethickness;
1257 rthick := 2 thick + rthin;
1258
1259
1260 def draw_arpeggio =
1261         save alpha;
1262         save ne, nw, se, sw;
1263         save x, y;
1264         pair ne, nw, se, sw;
1265
1266         alpha := -40;
1267
1268         nw = dir (alpha + 180);
1269         ne = dir (alpha + 90);
1270         se = dir alpha;
1271         sw = dir (alpha - 90);
1272
1273         penpos1 (rthin, alpha + 90);
1274         penpos2 (5/4 rthick, alpha);
1275         penpos3 (3/4 rthick, alpha);
1276         penpos4 (5/4 rthick, alpha);
1277         penpos5 (rthin, alpha + 90);
1278
1279         z1 = (width / 2, height) - overshoot * se;
1280         z2 = 2 [z4, (width / 2, height / 2)];
1281         z3 = 1/2 [z2, z4];
1282         x4 = 2/8 staff_space;
1283         y4 = rthin;
1284
1285         z5 = 2 [z1, (width / 2, height / 2)];
1286         z6 = z2l + 1/2 rthin * sw;
1287         z7 = z4l + 1/2 rthin * sw + 1/2 rthin * se;
1288         z8 = 2 [z6, (width / 2, height / 2)];
1289         z9 = 2 [z7, (width / 2, height / 2)];
1290
1291         fill z1l{se}
1292              -- z6
1293              .. z3l
1294              .. z7{se}
1295              -- z5l
1296              .. z5r{nw}
1297              -- z8
1298              .. z3r
1299              .. z9{nw}
1300              -- z1r
1301              .. cycle;
1302 enddef;
1303
1304
1305 fet_beginchar ("Arpeggio", "arpeggio");
1306         save height, overshoot, width;
1307         height# = staff_space#;
1308         width# = 0.8 height#;
1309         overshoot# = 0.25 staff_space#;
1310         define_pixels (height, overshoot, width);
1311
1312         set_char_box (0, width#, 0, height#);
1313         draw_arpeggio;
1314         penlabels (range 1 thru 9);
1315
1316         draw_staff (-2, 2, 0.0);
1317 fet_endchar;
1318
1319
1320 %
1321 % Extendable Trill symbol.
1322 % Not yet used
1323 % Rename me to Trill, rename Trill to Tr?
1324 %
1325
1326 fet_beginchar ("Trill_element", "trill_element");
1327         save height, overshoot;
1328         height# = staff_space#;
1329         width# = 0.8 height#;
1330         overshoot# = 0.25 staff_space#;
1331         define_pixels (height, overshoot, width);
1332
1333         set_char_box (0, height#, 0, width#);
1334         draw_arpeggio;
1335
1336         currentpicture := currentpicture shifted -(width / 2, height / 2);
1337         currentpicture := currentpicture rotated 90;
1338         currentpicture := currentpicture shifted (height / 2, width / 2);
1339 fet_endchar;
1340
1341
1342 %
1343 % Arpeggio arrow by Chris Jackson <chris@fluffhouse.org.uk>
1344 %
1345
1346 def draw_arpeggio_arrow =
1347         save thinness, height, width, overshoot;
1348         save nw, ne, se, sw;
1349         save alpha;
1350         save before_left, before_right, after_left, after_right;
1351         save u_left, v_left, u_right, v_right;
1352         pair nw, ne, se, sw;
1353         path before_left, before_right, after_left, after_right;
1354
1355         height# = staff_space#;
1356         width# = 0.8 height#;
1357         overshoot# = 0.25 staff_space#;
1358         define_pixels (height, overshoot, width);
1359
1360         set_char_box (0, width#, 0, height#);
1361
1362         alpha := -40;
1363         nw = dir (alpha + 180);
1364         ne = dir (alpha + 90);
1365         se = dir alpha;
1366         sw = dir (alpha - 90);
1367
1368         penpos1 (rthin, alpha + 90);
1369         penpos2 (5/4 rthick, alpha);
1370         penpos3 (5/4 rthick, 0);
1371
1372         z1 = (width / 2, height) - overshoot * se; % numbering is consistent
1373                                                    % with the arpeggio symbol
1374         z2 = 2 [z4, (width / 2, height / 2)];
1375         z3 = (0.5 width, 0.5 height);
1376         z4 = (0.25 staff_space, rthin);
1377         z6 = z2l + 1/2 rthin * sw;
1378         z9 = (width / 2, height) + overshoot * se;
1379
1380         pickup pencircle scaled vround (0.5 rthin);
1381
1382         bot z10 = (0.5 w, 0);
1383         lft z11 = (-0.3 w, 0.8 h);
1384         rt z12 = (1.3 w, 0.8 h);
1385
1386         before_left := z1l
1387                        -- z6{z6 - z1l}
1388                        .. {down}z3l;
1389         after_left := (z3 + (0, -0.25 rthin / cosd (angle (nw))))
1390                       -- (z11 + 0.25 rthin * ne);
1391         (u_left, v_left) = before_left intersectiontimes after_left;
1392
1393         before_right := (z12 + 0.25 rthin * nw)
1394                         -- (z3 + (0, -0.25 rthin / cosd (angle (nw))));
1395         after_right := z3r{up}
1396                        .. z9{z1r - z9}
1397                        -- z1r;
1398         (u_right, v_right) = before_right intersectiontimes after_right;
1399
1400         fill subpath (0, u_left) of before_left
1401              .. subpath (v_left, infinity) of after_left
1402              .. top z11
1403              .. lft z11
1404              .. {dir -50}(z11 + 0.25 rthin * sw)
1405              .. (z10 + 0.25 rthin * sw){dir -70}
1406              .. bot z10
1407              .. {dir 70}(z10 + 0.25 rthin * se)
1408              .. (z12 + 0.25 rthin * se){dir 50}
1409              .. rt z12
1410              .. top z12
1411              .. subpath (0, u_right) of before_right
1412              .. subpath (v_right, infinity) of after_right
1413              .. cycle;
1414
1415         % mf doesn't handle pixel dropouts in outline objects, so we use
1416         % `draw' if not called by mpost
1417         if not known miterlimit:
1418                 pickup pencircle scaled 0.7 rthin;
1419                 draw z1
1420                      -- (z9 + 0.5 rthin * dir (alpha - 90));
1421         fi;
1422 enddef;
1423
1424
1425 fet_beginchar ("Arpeggio arrow down", "arpeggio.arrow.M1");
1426         draw_arpeggio_arrow;
1427         penlabels (range 1 thru 12);
1428 fet_endchar;
1429
1430
1431 fet_beginchar ("Arpeggio arrow up", "arpeggio.arrow.1");
1432         draw_arpeggio_arrow;
1433         currentpicture := currentpicture scaled -1
1434                                          shifted (w - feta_eps, h - feta_eps);
1435 fet_endchar;
1436
1437
1438 % Hmm
1439 input feta-slag;
1440
1441
1442 % railroad tracks.
1443 %
1444 % I actually have no clue how they should look, so we use a slightly curvy
1445 % and tapered shape.
1446 %
1447
1448 fet_beginchar ("Caesura", "caesura");
1449         save slant, space_between, clearance;
1450         save alpha, pat;
1451         save botthick, topthick;
1452         save krom;
1453         path pat;
1454
1455         botthick = 1.5 linethickness;
1456         topthick = 2.5 linethickness;
1457
1458         pickup pencircle scaled botthick;
1459
1460         slant = 3.5;
1461         space_between# = 0.6 staff_space#;
1462         clearance# = 0.2 staff_space#;
1463         height# = 1.2 staff_space#;
1464
1465         set_char_box (0, 2.0 staff_space#,
1466                       staff_space# - clearance#, height#);
1467         define_pixels (clearance, height);
1468         define_whole_pixels (space_between);
1469
1470         bot y1 = -d;
1471         top y2 = h;
1472
1473         lft x1 = 0;
1474         x2 = (y2 - y1) / slant;
1475
1476         krom = 10;
1477
1478         alpha = angle (z2 - z1);
1479         penpos1 (botthick, alpha - krom);
1480         penpos3 (botthick, alpha - krom + 90);
1481
1482         penpos2 (topthick, alpha + krom);
1483         penpos4 (topthick, alpha + krom + 90);
1484
1485         z3 = z1;
1486         z4 = z2;
1487
1488         penlabels (1, 2, 3, 4);
1489
1490         pat := z3r{(z1r - z1l)}
1491                .. z4r{z2r-z2l}
1492                .. z2r{z4l-z4r}
1493                .. z4l{z2l-z2r}
1494                .. z3l{z1l-z1r}
1495                .. z1l{z3r-z3l}
1496                .. cycle;
1497         fill pat;
1498         fill pat shifted (space_between, 0);
1499 fet_endchar;
1500
1501
1502 fet_endgroup ("scripts");