]> git.donarmstrong.com Git - lilypond.git/blob - mf/parmesan-clefs.mf
Merge branch 'master' of git+ssh://jneem@git.sv.gnu.org/srv/git/lilypond into jneeman
[lilypond.git] / mf / parmesan-clefs.mf
1 % -%-Fundamental-%- -*-Metafont-*-
2 % parmesan-clefs.mf -- implement ancient clefs
3
4 % source file of LilyPond's pretty-but-neat music font
5 %
6 % (c) 2001--2006 Juergen Reuter <reuter@ipd.uka.de>
7 %
8
9 fet_begingroup ("clefs");
10
11 %
12 % character aligment:
13 %
14 %   Each clef is associated with a particular pitch: the treble clef
15 %   with the `g', the alto clef with the `c', the bass clef with the
16 %   `f', etc.  The shape of each clef character defines a vertical
17 %   position that is assumed to represent this pitch.  For the treble
18 %   clef, it is the vertical position of the center of the spiral
19 %   ending that represents the `g' pitch.  For the bass clef, it is
20 %   the center between the two fat dots that define the vertical
21 %   position of the `f' pitch.  For the alto clef, it is the vertical
22 %   center of the clef that is aligned with the `c' pitch.  For each
23 %   clef character, this center should be vertically aligned with the
24 %   point (0, 0).  The horizontal alignment of each clef character
25 %   should be such that the vertical line through the point (0, 0)
26 %   touches the left-most edge of the clef.
27 %
28 %   TODO: document exact_center
29 %
30 % set_char_box() conventions:
31 %
32 % * breapth: Ignored (as far as I know).  Should be set to 0.
33 %
34 % * width: Should match the clef's width.
35 %
36 % * depth: Should match the bottom edge of the clef.  Affects vertical
37 %   collision handling.
38 %
39 % * height: Should match the top edge of the clef.  Affects vertical
40 %   collision handling.
41 %
42
43
44 %%%%%%%%
45 %
46 %
47 %
48 % Editio Vaticana
49 %
50 %
51 %
52 def draw_vaticana_do_clef (expr exact_center, reduction) = 
53         save reduced_il;
54
55         reduced_il# = staff_space# * reduction;
56
57         set_char_box (0 - xpart exact_center,
58                       0.5 reduced_il# + xpart exact_center,
59                       0.8 reduced_il# - ypart exact_center,
60                       0.8 reduced_il# + ypart exact_center);
61
62         define_pixels (reduced_il);
63
64         save pat, ellipse, clef, T;
65         path pat, ellipse, clef;
66         transform T;
67
68         T := identity xscaled 0.6 linethickness
69                       yscaled 0.6 reduced_il;
70         pickup pencircle transformed T;
71         ellipse := reverse fullcircle transformed T;
72
73         save xoffs, yoffs;
74
75         xoffs# = xpart exact_center;
76         yoffs# = ypart exact_center;
77
78         define_pixels (xoffs, yoffs);
79
80         rt z11 = (xoffs + 0.50 reduced_il, yoffs - .45 reduced_il);
81         z12 = (xoffs + 0.25 reduced_il, yoffs - .50 reduced_il);
82         lft z13 = (xoffs + 0.00 reduced_il, yoffs - .28 reduced_il);
83         lft z14 = (xoffs, yoffs);
84
85         pat := z11
86                .. z12
87                .. z13
88                -- z14;
89
90         save shift;
91         pair shift;
92
93         % adjust vertically to fit into bounding box
94         shift = find_tangent_shift (((0, -d + 0.3 reduced_il)
95                                      -- (w, -d + 0.3 reduced_il)), pat,
96                                     (0, -d / 2), (0, d / 2));
97         pat := pat shifted shift;
98
99         clef := rt z14{down}
100                 .. top (point 1 of pat)
101                 .. get_subpath (ellipse,
102                                 -direction 0 of pat, direction 0 of pat,
103                                 point 0 of pat)
104                 .. bot (point 1 of pat)
105                 .. get_subpath (ellipse,
106                                 direction 2 of pat, up,
107                                 point 2 of pat);
108
109         fill clef
110              -- reverse clef yscaled -1
111              -- cycle;
112
113         labels (11, 12, 13, 14);
114 enddef;
115
116
117 fet_beginchar ("Ed. Vat. do clef", "vaticana.do");
118         if test = 1:
119                 draw_staff (-1, 3, 0.0);
120         fi;
121         draw_vaticana_do_clef ((0, 0), 1.0);
122 fet_endchar;
123
124
125 fet_beginchar ("Ed. Vat. do clef", "vaticana.do_change");
126         draw_vaticana_do_clef ((0, 0), 1.0); % no reduction
127 fet_endchar;
128
129
130 def draw_vaticana_fa_clef (expr exact_center, reduction) = 
131         save reduced_il, xoffs, yoffs;
132
133         reduced_il# = staff_space# * reduction;
134         xoffs# = xpart exact_center;
135         yoffs# = ypart exact_center;
136
137         define_pixels (reduced_il, xoffs, yoffs);
138
139         % left-handed punctum
140         save ellipse, pat, T;
141         path ellipse, pat;
142         transform T;
143
144         T := identity xscaled 0.6 linethickness
145                       yscaled 0.5 reduced_il;
146         pickup pencircle transformed T;
147         ellipse := reverse fullcircle transformed T;
148
149         lft z21 = (xoffs + 0.00 reduced_il, yoffs + 0.00 reduced_il);
150         z22 = (xoffs + 0.25 reduced_il, yoffs + 0.05 reduced_il);
151         rt z23 = (xoffs + 0.50 reduced_il, yoffs - 0.05 reduced_il);
152
153         pat := z21
154                .. z22
155                .. z23;  
156
157         fill get_subpath (ellipse,
158                           -direction 0 of pat, direction 0 of pat, z21)
159              .. top z22
160              .. get_subpath (ellipse,
161                              direction 2 of pat, -direction 2 of pat, z23)
162              .. bot z22
163              .. cycle;
164
165         % stem
166         pickup pencircle scaled 0.6 linethickness;
167
168         x23 = x24;
169         yoffs = bot y24 + 1.5 reduced_il;
170
171         draw_rounded_block (bot lft z24, top rt z23, 0.6 linethickness);
172
173         labels (21, 22, 23, 24);
174
175         % right-handed puncta as in do clef
176         draw_vaticana_do_clef (exact_center + (0.55 reduced_il#, 0),
177                                reduction);
178
179         set_char_box (0 - xpart exact_center,
180                       1.05 reduced_il# + xpart exact_center,
181                       1.5 reduced_il# - ypart exact_center,
182                       0.8 reduced_il# + ypart exact_center);
183 enddef;
184
185
186 fet_beginchar ("Ed. Vat. fa clef", "vaticana.fa");
187         if test = 1:
188                 draw_staff (-1, 3, 0.0);
189         fi;
190         draw_vaticana_fa_clef ((0, 0), 1.0);
191 fet_endchar;
192
193
194 fet_beginchar ("Ed. Vat. fa clef", "vaticana.fa_change");
195         draw_vaticana_fa_clef ((0, 0), 1.0); % no reduction
196 fet_endchar;
197
198
199 %%%%%%%%
200 %
201 %
202 %
203 % Editio Medicaea
204 %
205 %
206 %
207 def draw_medicaea_do_clef (expr exact_center, reduction) = 
208         save reduced_il, reduced_slt;
209
210         reduced_il# = staff_space# * reduction;
211         reduced_slt# = linethickness# * reduction;
212
213         define_pixels (reduced_il);
214         define_pixels (reduced_slt);
215
216         set_char_box (0 - xpart exact_center,
217                       1.0 reduced_il# + xpart exact_center,
218                       1.5 reduced_il# - ypart exact_center,
219                       1.5 reduced_il# + ypart exact_center);
220
221         save flag_height;
222
223         flag_height# = 0.5 reduced_il#;
224
225         define_pixels (flag_height);
226
227         save xoffs, yoffs;
228
229         xoffs# = xpart exact_center;
230         yoffs# = ypart exact_center;
231
232         define_pixels (xoffs, yoffs);
233
234         % flags
235         save ellipse, T;
236         path ellipse;
237         transform T;
238
239         T := identity xscaled reduced_slt
240                       yscaled flag_height;
241         pickup pencircle transformed T;
242         ellipse := reverse fullcircle transformed T;
243
244         xoffs = lft x1 = rt x2 - reduced_il;
245         y1 = yoffs + 0.5 (reduced_il - flag_height - staff_space);
246         y2 = y1 - reduced_il + flag_height;
247
248         fill top z1
249              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
250              -- bot z1
251              -- cycle;
252
253         xoffs = lft x3 = rt x4 - reduced_il;
254         y3 = yoffs + 0.5 (reduced_il - flag_height + staff_space);
255         y4 = y3 - reduced_il + flag_height;
256
257         fill top z3
258              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
259              -- bot z3
260              -- cycle;
261
262         % stem
263         pickup pencircle scaled reduced_slt;
264
265         lft x5 = lft x6 = xoffs;
266         yoffs = top y6 - 1.5 reduced_il = bot y5 + 1.5 reduced_il;
267
268         draw_rounded_block (bot lft z5, top rt z6, reduced_slt);
269
270         labels (1, 2, 3, 4, 5, 6);
271 enddef;
272
273
274 fet_beginchar ("Ed. Med. do clef", "medicaea.do");
275         if test = 1:
276                 draw_staff (-1, 3, 0.0);
277         fi;
278         draw_medicaea_do_clef ((0, 0), 1.0);
279 fet_endchar;
280
281
282 fet_beginchar ("Ed. Med. do clef", "medicaea.do_change");
283         draw_medicaea_do_clef ((0, 0), .8);
284 fet_endchar;
285
286
287 def draw_medicaea_fa_clef (expr exact_center, reduction) = 
288         % inspired by Regensburger Edition of Medicaea (1885/86), in:
289         % MGG, volume 2, col. 1327 ("Choralreform"), fig. 2.
290
291         save reduced_il, reduced_slt;
292
293         reduced_il# = staff_space# * reduction;
294         reduced_slt# = linethickness# * reduction;
295
296         define_pixels (reduced_il);
297         define_pixels (reduced_slt);
298
299         save xoffs, yoffs;
300
301         xoffs# = xpart exact_center;
302         yoffs# = ypart exact_center;
303
304         define_pixels (xoffs, yoffs);
305
306         % stem
307         pickup pencircle scaled linethickness;
308
309         x11 = x12 = xoffs + 0.4 reduced_il;
310         y11 = yoffs = bot y12 + 1.5 reduced_il;
311
312         draw_rounded_block (bot lft z12, top rt z11, linethickness);
313
314         % left-handed punctum
315         save ellipse, T;
316         path ellipse;
317         transform T;
318
319         T := identity xscaled reduced_slt
320                       yscaled reduced_il;
321         pickup pencircle transformed T;
322         ellipse := reverse fullcircle transformed T;
323
324         lft z13 = (xoffs, yoffs);
325         rt z14 = z11 + (linethickness / 2, 0);
326
327         fill get_subpath (ellipse, left, right, z13)
328              -- get_subpath (ellipse, right, left, z14)
329              -- cycle;
330
331         labels (11, 12, 13, 14);
332
333         % right-handed puncta as in do clef
334         draw_medicaea_do_clef (exact_center + (0.7 reduced_il#, 0),
335                                reduction);
336
337         set_char_box (0 - xpart exact_center,
338                       1.7 reduced_il# + xpart exact_center,
339                       1.5 reduced_il# - ypart exact_center,
340                       1.5 reduced_il# + ypart exact_center);
341 enddef;
342
343
344 fet_beginchar ("Ed. Med. fa clef", "medicaea.fa");
345         if test = 1:
346                 draw_staff (-1, 3, 0.0);
347         fi;
348         draw_medicaea_fa_clef ((0, 0), 1.0);
349 fet_endchar;
350
351
352 fet_beginchar ("Ed. Med. fa clef", "medicaea.fa_change");
353         draw_medicaea_fa_clef ((0, 0), .8);
354 fet_endchar;
355
356
357 %%%%%%%%
358 %
359 %
360 %
361 % Mensural Notation
362 %
363 %
364 %
365
366 %
367 % width:        interval from left end to right end
368 % height:       interval from bottom of lower beam to top of upper beam
369 % exact_center: the coordinates of the vertical center point of the
370 %               left edge.
371 %
372 def draw_brevis (expr exact_center, bwidth, bheight, blinethickness) =
373         save brevis_width, brevis_height, linethickness;
374
375         brevis_width# = bwidth;
376         brevis_height# = bheight;
377         linethickness# = blinethickness;
378
379         save beam_width, beam_height;
380         save serif_size, serif_protrude, hole_height;
381
382         beam_width# = 1.4 linethickness#;
383         hole_height# = 3 linethickness#;
384         2 beam_height# + hole_height# = brevis_height#;
385         serif_size# = (hole_height# - linethickness#) / 2;
386         serif_protrude# = 1.5 serif_size#;
387
388         save xoffs, yoffs;
389
390         xoffs# = xpart exact_center;
391         yoffs# = ypart exact_center;
392
393         define_pixels (xoffs, yoffs);
394         define_pixels (brevis_width, brevis_height, linethickness);
395         define_pixels (beam_width, beam_height, serif_size, serif_protrude);
396
397         z1l = (xoffs, yoffs - linethickness);
398         z2r = z1r + serif_size * (1, -1);
399         z3l = z2l + (-serif_size, -serif_protrude);
400
401         penpos1 (beam_width, 0);
402         penpos2 (beam_height, 90);
403         penpos3 (beam_width, 180);
404
405         save pat_in, pat_out;
406         path pat_in, pat_out;
407
408         pat_out := z3r{down}
409                    .. z3l{up}
410                    .. z2l{right};
411         pat_out := pat_out
412                    -- reverse pat_out xscaled -1
413                                       shifted (2 xoffs + brevis_width, 0);
414         pat_out := pat_out
415                    -- reverse pat_out yscaled -1
416                                       shifted (0, 2 yoffs)
417                    -- cycle;
418
419         pat_in := z1r{down}
420                   .. z2r{right};
421         pat_in := pat_in
422                   -- reverse pat_in xscaled -1
423                                     shifted (2 xoffs + brevis_width, 0);
424         pat_in := pat_in
425                   -- reverse pat_in yscaled -1
426                                     shifted (0, 2 yoffs)
427                   -- cycle;
428
429         fill pat_out;
430         unfill pat_in;
431
432         penlabels (1, 2, 3);
433 enddef;
434
435 %
436 % Draw two brevis notes; the second one shifted down by `shift'.
437 % The other parameters are the same as with `draw_brevis'.
438 %
439 def draw_double_brevis (expr exact_center, bwidth, bheight,
440                              blinethickness, shift) =
441         save brevis_width, brevis_height, linethickness;
442
443         brevis_width# = bwidth;
444         brevis_height# = bheight;
445         linethickness# = blinethickness;
446
447         save beam_width, beam_height;
448         save serif_size, serif_protrude, hole_height;
449
450         beam_width# = 1.4 linethickness#;
451         hole_height# = 3 linethickness#;
452         2 beam_height# + hole_height# = brevis_height#;
453         serif_size# = (hole_height# - linethickness#) / 2;
454         serif_protrude# = 1.5 serif_size#;
455
456         save xoffs, yoffs;
457
458         xoffs# = xpart exact_center;
459         yoffs# = ypart exact_center;
460
461         define_pixels (xoffs, yoffs);
462         define_pixels (brevis_width, brevis_height, linethickness);
463         define_pixels (beam_width, beam_height, serif_size, serif_protrude);
464
465         z1l = (xoffs, yoffs - linethickness);
466         z2r = z1r + serif_size * (1, -1);
467         z3l = z2l + (-serif_size, -serif_protrude);
468
469         penpos1 (beam_width, 0);
470         penpos2 (beam_height, 90);
471         penpos3 (beam_width, 180);
472
473         z4 = z1 shifted (0, -shift);
474         z5 = z2 shifted (0, -shift);
475         z6 = z3 shifted (0, -shift);
476         
477         penpos4 (beam_width, 0);
478         penpos5 (beam_height, 90);
479         penpos6 (beam_width, 180);
480
481         save pat_in, pat_out;
482         path pat_in, pat_out;
483
484         pat_out := z6r{down}
485                    .. z6l{up}
486                    .. z5l{right};
487         pat_out := pat_out
488                    -- reverse pat_out xscaled -1
489                                       shifted (2 xoffs + brevis_width, 0);
490         pat_out := pat_out
491                    -- reverse pat_out yscaled -1
492                                       shifted (0, shift - 2 yoffs)
493                    -- cycle;
494
495         fill pat_out;
496
497         pat_in := z1r{down}
498                   .. z2r{right};
499         pat_in := pat_in
500                   -- reverse pat_in xscaled -1
501                                     shifted (2 xoffs + brevis_width, 0);
502         pat_in := pat_in
503                   -- reverse pat_in yscaled -1
504                                     shifted (0, 2 yoffs)
505                   -- cycle;
506
507         unfill pat_in;
508         unfill pat_in shifted (0, -shift);
509
510         penlabels (1, 2, 3, 4, 5, 6);
511 enddef;
512
513
514 %
515 % Draw three brevis notes; the second one shifted down by `shift',
516 % the third one by `2 shift'.
517 % The other parameters are the same as with `draw_brevis'.
518 %
519 def draw_triple_brevis (expr exact_center, bwidth, bheight,
520                              blinethickness, shift) =
521         save brevis_width, brevis_height, linethickness;
522
523         brevis_width# = bwidth;
524         brevis_height# = bheight;
525         linethickness# = blinethickness;
526
527         save beam_width, beam_height;
528         save serif_size, serif_protrude, hole_height;
529
530         beam_width# = 1.4 linethickness#;
531         hole_height# = 3 linethickness#;
532         2 beam_height# + hole_height# = brevis_height#;
533         serif_size# = (hole_height# - linethickness#) / 2;
534         serif_protrude# = 1.5 serif_size#;
535
536         save xoffs, yoffs;
537
538         xoffs# = xpart exact_center;
539         yoffs# = ypart exact_center;
540
541         define_pixels (xoffs, yoffs);
542         define_pixels (brevis_width, brevis_height, linethickness);
543         define_pixels (beam_width, beam_height, serif_size, serif_protrude);
544
545         z1l = (xoffs, yoffs - linethickness);
546         z2r = z1r + serif_size * (1, -1);
547         z3l = z2l + (-serif_size, -serif_protrude);
548
549         penpos1 (beam_width, 0);
550         penpos2 (beam_height, 90);
551         penpos3 (beam_width, 180);
552
553         z7 = z1 shifted (0, -2 shift);
554         z8 = z2 shifted (0, -2 shift);
555         z9 = z3 shifted (0, -2 shift);
556         
557         penpos7 (beam_width, 0);
558         penpos8 (beam_height, 90);
559         penpos9 (beam_width, 180);
560
561         save pat_in, pat_out;
562         path pat_in, pat_out;
563
564         pat_out := z9r{down}
565                    .. z9l{up}
566                    .. z8l{right};
567         pat_out := pat_out
568                    -- reverse pat_out xscaled -1
569                                       shifted (2 xoffs + brevis_width, 0);
570         pat_out := pat_out
571                    -- reverse pat_out yscaled -1
572                                       shifted (0, -2 yoffs)
573                    -- cycle;
574
575         fill pat_out;
576
577         pat_in := z1r{down}
578                   .. z2r{right};
579         pat_in := pat_in
580                   -- reverse pat_in xscaled -1
581                                     shifted (2 xoffs + brevis_width, 0);
582         pat_in := pat_in
583                   -- reverse pat_in yscaled -1
584                                     shifted (0, 2 yoffs)
585                   -- cycle;
586
587         unfill pat_in;
588         unfill pat_in shifted (0, -shift);
589         unfill pat_in shifted (0, -2 shift);
590
591         penlabels (1, 2, 3, 7, 8, 9);
592 enddef;
593
594
595 def draw_neomensural_c_clef (expr exact_center, reduction) = 
596         save reduced_il, reduced_slt, stem_width;
597
598         reduced_il# = staff_space# * reduction;
599         reduced_slt# = linethickness# * reduction;
600         stem_width# = 1.4 reduced_slt#;
601
602         define_pixels (reduced_il, reduced_slt, stem_width);
603
604         set_char_box (0 - xpart exact_center,
605                       2 reduced_il# + 6 reduced_slt# + xpart exact_center,
606                       2 reduced_il# - ypart exact_center,
607                       2 reduced_il# + ypart exact_center);
608
609         draw_brevis (exact_center + (3 reduced_slt#, 0),
610                      2 reduced_il#, reduced_il#, reduced_slt#);
611
612         save xoffs, yoffs;
613
614         xoffs# = xpart exact_center;
615         yoffs# = ypart exact_center;
616
617         define_pixels (xoffs, yoffs);
618
619         save ellipse, pat, T;
620         path ellipse, pat;
621         transform T;
622
623         T := identity xscaled stem_width
624                       yscaled blot_diameter;
625         pickup pencircle transformed T;
626         ellipse := fullcircle transformed T;
627
628         lft x11 = lft x12 = xoffs;
629         top y12 - bot y11 = 4 reduced_il;
630         top y12 + bot y11 = 2 yoffs;
631         x13 = x3;
632         y13 = y11;
633         rt x14 = rt x15 = w;
634         y14 = y11;
635         y15 = y12;
636
637         pat := get_subpath (ellipse, down, up, z13)
638                -- z3l
639                -- z3r
640                -- cycle;
641
642         fill get_subpath (ellipse, down, up, z11)
643              -- get_subpath (ellipse, up, down, z12)
644              -- cycle;
645         fill get_subpath (ellipse, down, up, z14)
646              -- get_subpath (ellipse, up, down, z15)
647              -- cycle;
648
649         fill pat;
650         fill pat xscaled -1
651                  shifted (w, 0);
652         fill pat yscaled -1
653                  shifted (0, 2 yoffs);
654         fill pat scaled -1
655                  shifted (w, 2 yoffs);
656
657         labels (11, 12, 13, 14, 15);
658 enddef;
659
660
661 fet_beginchar ("neo-mensural c clef", "neomensural.c");
662         if test = 1:
663                 draw_staff (-1, 3, 0.0);
664         fi;
665         draw_neomensural_c_clef ((0, 0), 1.0);
666 fet_endchar;
667
668
669 fet_beginchar ("neo-mensural c clef", "neomensural.c_change");
670         draw_neomensural_c_clef ((0, 0), .8);
671 fet_endchar;
672
673
674 def draw_petrucci_c_clef (expr exact_center, flare_align, reduction) = 
675         % inspired by Josquin Desprez, "Stabat Mater", Libro tertio,
676         % 1519, printed by Petrucci, in: MGG, volume 7, Table 11.
677         % Also by Petrucci's Canti C, Venedig 1503.  In: MGG, volume
678         % 9, p. 1681/1682.
679
680         save reduced_il, reduced_slt;
681
682         reduced_il# = staff_space# * reduction;
683         reduced_slt# = linethickness# * reduction;
684
685         define_pixels (reduced_il);
686
687         draw_double_brevis (exact_center + (0, 0.5 staff_space#),
688                             reduced_il#, reduced_il#, reduced_slt#,
689                             staff_space);
690
691         save half_reduced_il, left_depth, left_height;
692
693         half_reduced_il# = staff_space# * sqrt (reduction);
694         left_height# = half_reduced_il# * min (3.2, 3.2 + 0.2 + flare_align);
695         left_depth# = half_reduced_il# * min (3.2, 3.2 + 0.2 - flare_align);
696
697         define_pixels (half_reduced_il);
698         define_pixels (left_depth, left_height);
699
700         set_char_box (0 - xpart exact_center,
701                       reduced_il# + xpart exact_center,
702                       left_depth# - ypart exact_center,
703                       left_height# + ypart exact_center);
704
705         save xoffs, yoffs;
706
707         xoffs# = xpart exact_center;
708         yoffs# = ypart exact_center;
709
710         define_pixels (xoffs, yoffs);
711
712         save ellipse, T;
713         path ellipse;
714         transform T;
715
716         T := identity xscaled 1.4 linethickness
717                       yscaled blot_diameter;
718         pickup pencircle transformed T;
719         ellipse := fullcircle transformed T;
720
721         lft x11 = lft x13 = xoffs;
722         top y11 = yoffs + left_height;
723         bot y13 = yoffs - left_depth;
724         rt x15 = rt x17 = xoffs + brevis_width;
725         y15 = min (y11 - 0.2 half_reduced_il, yoffs + 2.2 half_reduced_il);
726         y17 = max (y13 + 0.2 half_reduced_il, yoffs - 2.2 half_reduced_il);
727
728         z12 = z14 yscaled -1;
729         z14 = z6;
730         z16 = z18 yscaled -1;
731         rt z18 = lft z14 shifted (brevis_width, 0);
732
733         penpos12 (1.4 linethickness, 0);
734         penpos14 (1.4 linethickness, 0);
735         penpos16 (1.4 linethickness, 0);
736         penpos18 (1.4 linethickness, 0);
737
738         if top y11 > -y6 + 0.7 linethickness:
739                 fill get_subpath (ellipse, up, down, z11)
740                      -- z12l
741                      -- z12r
742                      -- cycle;
743         fi;
744         if bot y13 < y6 - 0.7 linethickness:
745                 fill get_subpath (ellipse, down, up, z13)
746                      -- z14r
747                      -- z14l
748                      -- cycle;
749         fi;
750         if top y15 > -y6 + 0.7 linethickness:
751                 fill get_subpath (ellipse, up, down, z15)
752                      -- z16l
753                      -- z16r
754                      -- cycle;
755         fi;
756         if bot y17 < y6 - 0.7 linethickness:
757                 fill get_subpath (ellipse, down, up, z17)
758                      -- z18r
759                      -- z18l
760                      -- cycle;
761         fi;
762
763         labels (11, 13, 15, 17);
764         penlabels (12, 14, 16, 18);
765 enddef;
766
767
768 fet_beginchar ("petrucci c1 clef", "petrucci.c1");
769         if test = 1:
770                 draw_staff (-1, 3, 0.0);
771         fi;
772         draw_petrucci_c_clef ((0, 0), +2, 1.0);
773 fet_endchar;
774
775
776 fet_beginchar ("petrucci c1 clef", "petrucci.c1_change");
777         draw_petrucci_c_clef ((0, 0), +2, .8);
778 fet_endchar;
779
780
781 fet_beginchar ("petrucci c2 clef", "petrucci.c2");
782         if test = 1:
783                 draw_staff (-1, 3, 0.0);
784         fi;
785         draw_petrucci_c_clef ((0, 0), +1, 1.0);
786 fet_endchar;
787
788
789 fet_beginchar ("petrucci c2 clef", "petrucci.c2_change");
790         draw_petrucci_c_clef ((0, 0), +1, .8);
791 fet_endchar;
792
793
794 fet_beginchar ("petrucci c3 clef", "petrucci.c3");
795         if test = 1:
796                 draw_staff (-1, 3, 0.0);
797         fi;
798         draw_petrucci_c_clef ((0, 0), 0, 1.0);
799 fet_endchar;
800
801
802 fet_beginchar ("petrucci c3 clef", "petrucci.c3_change");
803         draw_petrucci_c_clef ((0, 0), 0, .8);
804 fet_endchar;
805
806
807 fet_beginchar ("petrucci c4 clef", "petrucci.c4");
808         if test = 1:
809                 draw_staff (-1, 3, 0.0);
810         fi;
811         draw_petrucci_c_clef ((0, 0), -1, 1.0);
812 fet_endchar;
813
814
815 fet_beginchar ("petrucci c4 clef", "petrucci.c4_change");
816         draw_petrucci_c_clef ((0, 0), -1, .8);
817 fet_endchar;
818
819
820 fet_beginchar ("petrucci c5 clef", "petrucci.c5");
821         if test = 1:
822                 draw_staff (-1, 3, 0.0);
823         fi;
824         draw_petrucci_c_clef ((0, 0), -2, 1.0);
825 fet_endchar;
826
827
828 fet_beginchar ("petrucci c5 clef", "petrucci.c5_change");
829         draw_petrucci_c_clef ((0, 0), -2, .8);
830 fet_endchar;
831
832
833 def draw_mensural_c_clef (expr exact_center, reduction) =
834         % inspired by Ockeghem, "Missa Prolationum", in: MGG, volume
835         % 9, table 94.
836
837         save reduced_il;
838
839         reduced_il# = staff_space# * reduction;
840
841         define_pixels (reduced_il);
842
843         draw_triple_brevis (exact_center + (0, 0.5 staff_space#),
844                             2 reduced_il#, 0.8 staff_space#,
845                             0.8 linethickness#, staff_space);
846
847         save half_reduced_il;
848
849         half_reduced_il# = staff_space# * sqrt (reduction);
850
851         define_pixels (half_reduced_il);
852
853         set_char_box (0 - xpart exact_center,
854                       2 reduced_il# + xpart exact_center,
855                       2.2 half_reduced_il# + staff_space# -
856                         2 ypart exact_center,
857                       2.2 half_reduced_il# + 2 ypart exact_center);
858
859         save xoffs, yoffs;
860
861         xoffs# = xpart exact_center;
862         yoffs# = ypart exact_center;
863
864         define_pixels (xoffs, yoffs);
865
866         save ellipse, T;
867         path ellipse;
868         transform T;
869
870         T := identity xscaled 1.4 linethickness
871                       yscaled blot_diameter;
872         pickup pencircle transformed T;
873         ellipse := fullcircle transformed T;
874
875         lft x11 = lft x13 = xoffs;
876         top y11 = yoffs + 2.2 half_reduced_il;
877         bot y13 = yoffs - 2.2 half_reduced_il - staff_space;
878         rt x15 = rt x17 = xoffs + brevis_width;
879         y15 = yoffs + 1.4 half_reduced_il;
880         y17 = yoffs - 1.4 half_reduced_il - staff_space;
881
882         z12 = z14 yscaled -1 shifted (0, -staff_space);
883         z14 = z9;
884         z16 = z18 yscaled -1 shifted (0, -staff_space);
885         rt z18 = lft z14 shifted (brevis_width, 0);
886
887         penpos12 (1.4 linethickness, 0);
888         penpos14 (1.4 linethickness, 0);
889         penpos16 (1.4 linethickness, 0);
890         penpos18 (1.4 linethickness, 0);
891
892         fill get_subpath (ellipse, up, down, z11)
893              -- z12l
894              -- z12r
895              -- cycle;
896         fill get_subpath (ellipse, down, up, z13)
897              -- z14r
898              -- z14l
899              -- cycle;
900         fill get_subpath (ellipse, up, down, z15)
901              -- z16l
902              -- z16r
903              -- cycle;
904         fill get_subpath (ellipse, down, up, z17)
905              -- z18r
906              -- z18l
907              -- cycle;
908
909         labels (11, 13, 15, 17);
910         penlabels (12, 14, 16, 18);
911 enddef;
912
913
914 fet_beginchar ("mensural c clef", "mensural.c");
915         if test = 1:
916                 draw_staff (-1, 3, 0.0);
917         fi;
918         draw_mensural_c_clef ((0, 0), 1.0);
919 fet_endchar;
920
921
922 fet_beginchar ("mensural c clef", "mensural.c_change");
923         draw_mensural_c_clef ((0, 0), .8);
924 fet_endchar;
925
926
927 def draw_diamond (expr exact_center, reduction) =
928         save stem_width, reduced_nht, holeheight, beamheight;
929         save rh_height, rh_width;
930
931         stem_width# = 1.4 reduced_slt#;
932         reduced_nht# = noteheight# * reduction;
933         holeheight# = 3 reduced_slt#;
934         beamheight# = 0.4 (reduced_nht# - holeheight#);
935
936         rh_height# = 1.2 staff_space# * reduction;
937         rh_width# / rh_height# = tand (30);
938
939         define_pixels (beamheight, stem_width);
940         define_pixels (rh_height, rh_width);
941
942         save xoffs, yoffs;
943
944         xoffs# = xpart exact_center;
945         yoffs# = ypart exact_center;
946
947         define_pixels (xoffs, yoffs);
948
949         save ellipse, T;
950         path ellipse;
951         transform T;
952
953         T := identity xscaled beamheight
954                       yscaled stem_width
955                       rotated 45;
956         pickup pencircle transformed T;
957         ellipse := reverse fullcircle transformed T;
958
959         x21 := xoffs - rh_width / 2;
960         y21 := yoffs;
961         x22 := xoffs;
962         y22 := yoffs + rh_height / 2;
963         x23 := xoffs + rh_width / 2;
964         y23 := yoffs;
965         x24 := xoffs;
966         y24 := yoffs - rh_height / 2;
967
968         fill get_subpath (ellipse, z21 - z24, z22 - z21, z21)
969              -- get_subpath (ellipse, z22 - z21, z23 - z22, z22)
970              -- get_subpath (ellipse, z23 - z22, z24 - z23, z23)
971              -- get_subpath (ellipse, z24 - z23, z21 - z24, z24)
972              -- cycle;
973
974         save l;
975         path l[];
976
977         l2122 := (directionpoint (z21 - z22) of ellipse) shifted z21
978                  -- (directionpoint (z21 - z22) of ellipse) shifted z22;
979         l2223 := (directionpoint (z22 - z23) of ellipse) shifted z22
980                  -- (directionpoint (z22 - z23) of ellipse) shifted z23;
981         l2324 := (directionpoint (z23 - z24) of ellipse) shifted z23
982                  -- (directionpoint (z23 - z24) of ellipse) shifted z24;
983         l2421 := (directionpoint (z24 - z21) of ellipse) shifted z24
984                  -- (directionpoint (z24 - z21) of ellipse) shifted z21;
985
986         unfill l2122 intersectionpoint l2223
987                -- l2223 intersectionpoint l2324
988                -- l2324 intersectionpoint l2421
989                -- l2421 intersectionpoint l2122
990                -- cycle;
991
992         labels (21, 22, 23, 24);
993 enddef;
994
995
996 def draw_petrucci_f_clef (expr exact_center, reduction) =
997         % inspired by L'homme arme super voces musicales in Misse
998         % Josquin, 1502, Petrucci, in: MGG, volume 7, col. 200; also
999         % inspired by Gaspar van Weerbeke, "Virgo Maria" (1502), in:
1000         % MGG, volume 9, col. 653 ("Motette"), fig. 3.; also by Andr'e
1001         % Campra, "Entr'ee des s'er'enades" (1710), in: MGG, volume 2,
1002         % col. 1649 ("Contredanse"), fig. 2.
1003
1004         save interline, reduced_il, reduced_slt;
1005
1006         interline# = staff_space#;
1007         reduced_il# = staff_space# * reduction;
1008         reduced_slt# = linethickness# * reduction;
1009
1010         draw_brevis (exact_center, reduced_il#, reduced_il#, reduced_slt#);
1011         draw_diamond (exact_center +
1012                         (1.6 interline# * reduction, interline# / 2),
1013                      reduction);
1014         draw_diamond (exact_center +
1015                         (1.6 interline# * reduction, -interline# / 2),
1016                      reduction);
1017
1018         define_pixels (interline, reduced_il, reduced_slt);
1019
1020         save stem_width;
1021
1022         stem_width# = 1.4 reduced_slt#;
1023
1024         define_pixels (stem_width);
1025
1026         save xoffs, yoffs;
1027
1028         xoffs# = xpart exact_center;
1029         yoffs# = ypart exact_center;
1030
1031         define_pixels (xoffs, yoffs);
1032
1033         % brevis stem
1034         save ellipse, T;
1035         path ellipse;
1036         transform T;
1037
1038         T := identity xscaled stem_width
1039                       yscaled blot_diameter;
1040         pickup pencircle transformed T;
1041         ellipse := fullcircle transformed T;
1042
1043         rt z8 = (xoffs + reduced_il, yoffs - 4 reduced_slt);
1044         rt z9 = (xoffs + reduced_il, yoffs - 4 reduced_il);
1045
1046         penpos8 (stem_width, 0);
1047
1048         fill get_subpath (ellipse, down, up, z9)
1049              -- z8r
1050              -- z8l
1051              -- cycle;
1052
1053         % upper diamond's stem
1054         z10 = (xoffs + 1.6 interline * reduction + stem_width / 2,
1055                yoffs + interline * reduction);
1056         top z11 = z10 + (0, 1.5 interline * reduction);
1057
1058         penpos10 (stem_width, 0);
1059
1060         fill get_subpath (ellipse, up, down, z11)
1061              -- z10l
1062              -- z10r
1063              -- cycle;
1064
1065         % lower diamond's stem
1066         z12 = (xoffs + 1.6 interline * reduction - stem_width / 2,
1067                yoffs - interline * reduction);
1068         bot z13 = z12 + (0, -3.5 interline * reduction);
1069
1070         penpos12 (stem_width, 0);
1071
1072         fill get_subpath (ellipse, down, up, z13)
1073              -- z12r
1074              -- z12l
1075              -- cycle;
1076
1077         save reduced_il, rh_height, rh_width;
1078
1079         reduced_il# = staff_space# * reduction;
1080         rh_height# = 1.2 reduced_il#;
1081         rh_width# / rh_height# = tand (30);
1082
1083         set_char_box (0 - xpart exact_center,
1084                       1.6 interline# * reduction + 0.5 rh_width# +
1085                         xpart exact_center,
1086                       4.5 interline# * reduction - ypart exact_center,
1087                       2.5 interline# * reduction + ypart exact_center);
1088
1089         labels (9, 11, 13);
1090         penlabels (8, 10, 12);
1091 enddef;
1092
1093
1094 fet_beginchar ("petrucci f clef", "petrucci.f");
1095         if test = 1:
1096                 draw_staff (-1, 3, 0.0);
1097         fi;
1098         draw_petrucci_f_clef ((0, 0), 1.0);
1099 fet_endchar;
1100
1101
1102 fet_beginchar ("petrucci f clef", "petrucci.f_change");
1103         draw_petrucci_f_clef ((0, 0), .8);
1104 fet_endchar;
1105
1106
1107 def draw_mensural_f_clef (expr exact_center, reduction) =
1108         % inspired by Philippe le Duc, "Dite Signori" (1590), in: MGG,
1109         % volume 3, col. 848 ("Duc"); also by John Dowland, "The First
1110         % Booke of Songes" (1597), in: MGG, volume 3, col. 721
1111         % ("Dowland"), fig. 3.
1112
1113         save width, reduced_slt, stem_width, dot_diameter;
1114
1115         width# = 1.2 staff_space# * reduction;
1116         reduced_slt# = linethickness# * reduction;
1117         stem_width# = 1.4 reduced_slt#;
1118         dot_diameter# = 0.1 reduction * staff_space#;
1119
1120         define_pixels (width, stem_width, staff_space, dot_diameter);
1121
1122         save xoffs, yoffs;
1123
1124         xoffs# = xpart exact_center;
1125         yoffs# = ypart exact_center;
1126
1127         define_pixels (xoffs, yoffs);
1128
1129         save ellipse, T;
1130         path ellipse;
1131         transform T;
1132
1133         T := identity xscaled 0.2 width
1134                       yscaled stem_width
1135                       rotated 45;
1136         pickup pencircle transformed T;
1137         ellipse := fullcircle transformed T;
1138
1139         % half circle
1140         lft z10 = (0, 0);
1141
1142         save pat;
1143         path pat;
1144
1145         pat := halfcircle scaled width
1146                           rotated -90
1147                           shifted (z10 - (xoffs, yoffs));
1148
1149         z5 = point 0 of pat;
1150         z6 = point 1 of pat;
1151         z7 = point 2 of pat;
1152         z8 = point 3 of pat;
1153         z9 = point 4 of pat;
1154
1155         save dirs;
1156         pair dirs[];
1157
1158         dirs5 := direction 0 of pat;
1159         dirs6 := direction 1 of pat;
1160         dirs7 := direction 2 of pat;
1161         dirs8 := direction 3 of pat;
1162         dirs9 := direction 4 of pat;
1163
1164         % we approximate `draw pat'
1165         fill get_subpath (ellipse, -dirs5, dirs5, z5)
1166              .. get_subpoint (ellipse, dirs6, z6)
1167              .. get_subpoint (ellipse, dirs7, z7)
1168              .. get_subpoint (ellipse, dirs8, z8)
1169              .. get_subpath (ellipse, dirs9, -dirs9, z9)
1170              .. get_subpoint (ellipse, -dirs8, z8)
1171              .. get_subpoint (ellipse, -dirs7, z7)
1172              .. get_subpoint (ellipse, -dirs6, z6)
1173              .. cycle;
1174
1175         % upper dot
1176         rt x2 = xoffs + width;
1177         top y1 = yoffs + 0.5 width;
1178         z2 - z1 = (dot_diameter, -dot_diameter);
1179
1180         fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
1181              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
1182              -- cycle;
1183
1184         % lower dot
1185         x3 = x1;
1186         top y1 - bot y4 = width;
1187         z4 - z3 = (dot_diameter, -dot_diameter);
1188
1189         fill get_subpath (ellipse, z3 - z4, z4 - z3, z3)
1190              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
1191              -- cycle;
1192
1193         set_char_box (0 - xpart exact_center,
1194                       width# + xpart exact_center,
1195                       0.5 width# - ypart exact_center,
1196                       0.5 width# + ypart exact_center);
1197
1198         labels (1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
1199 enddef;
1200
1201
1202 fet_beginchar ("mensural f clef", "mensural.f");
1203         if test = 1:
1204                 draw_staff (-1, 3, 0.0);
1205         fi;
1206         draw_mensural_f_clef ((0, 0), 1.0);
1207 fet_endchar;
1208
1209
1210 fet_beginchar ("mensural f clef", "mensural.f_change");
1211         draw_mensural_f_clef ((0, 0), .8);
1212 fet_endchar;
1213
1214
1215 def draw_petrucci_g_clef (expr exact_center, reduction) =
1216         % inspired by Josquin Desprez, "Stabat Mater", Libro tertio,
1217         % 1519, printed by Petrucci, in: MGG, volume 7, Table 11.
1218
1219         save reduced_il, reduced_slt;
1220
1221         reduced_il# = staff_space# * reduction;
1222         reduced_slt# = linethickness# * reduction;
1223         define_pixels (reduced_il, reduced_slt);
1224
1225         set_char_box (0 - xpart exact_center,
1226                       1.25 reduced_il# + xpart exact_center,
1227                       0.65 reduced_il# - ypart exact_center,
1228                       3.80 reduced_il# + ypart exact_center);
1229
1230         save xoffs, yoffs;
1231
1232         xoffs# = xpart exact_center;
1233         yoffs# = ypart exact_center;
1234
1235         define_pixels (xoffs, yoffs);
1236
1237         save ellipse, paths, sub_path, outlines, sub_outlines, T;
1238         path ellipse, paths[], sub_path, outlines[], sub_outlines[];
1239         transform T;
1240
1241         T := identity xscaled 0.5 reduced_slt
1242                       yscaled 0.22 reduced_il
1243                       rotated -35;
1244         pickup pencircle transformed T;
1245         ellipse := fullcircle transformed T;
1246
1247         lft z1 = (xoffs + 0.80 reduced_il, yoffs + 0.00 reduced_il);
1248         lft z2 = (xoffs + 1.00 reduced_il, yoffs + 1.20 reduced_il);
1249         lft z3 = (xoffs + 0.70 reduced_il, yoffs + 2.00 reduced_il);
1250         lft z4 = (xoffs + 0.30 reduced_il, yoffs + 3.00 reduced_il);
1251         lft z5 = (xoffs + 0.80 reduced_il, yoffs + 3.70 reduced_il);
1252         lft z6 = (xoffs + 1.00 reduced_il, yoffs + 3.00 reduced_il);
1253         lft z7 = (xoffs + 0.60 reduced_il, yoffs + 2.00 reduced_il);
1254         lft z8 = (xoffs + 0.30 reduced_il, yoffs + 1.70 reduced_il);
1255         lft z9 = (xoffs + 0.00 reduced_il, yoffs + 0.75 reduced_il);
1256         lft z10 = (xoffs + 0.20 reduced_il, yoffs + 0.60 reduced_il);
1257
1258         paths1 := z1{-1, 2}
1259                   .. z2
1260                   .. z3
1261                   .. z4
1262                   .. z5
1263                   .. z6
1264                   .. z7
1265                   .. z8
1266                   .. z9
1267                   .. z10;
1268
1269         save dirs, s;
1270         pair dirs[];
1271
1272         s := 1/4;
1273
1274         % we approximate `draw paths1'
1275         for i = 1 step s until (length paths1 + 1):
1276                 dirs[i] := direction (i - 1) of paths1;
1277         endfor;
1278
1279         outlines1 := get_subpath (ellipse, -dirs1, dirs1, z1)
1280                      for i = (1 + s) step s until (length paths1 + 1 - s):
1281                              .. get_subpoint (ellipse, dirs[i],
1282                                               point (i - 1) of paths1)
1283                      endfor
1284                      .. get_subpath (ellipse, dirs10, -dirs10, z10)
1285                      for i = (length paths1 + 1 - s) step -s until (1 + s):
1286                              .. get_subpoint (ellipse, -dirs[i],
1287                                               point (i - 1) of paths1)
1288                      endfor
1289                      .. cycle;
1290
1291         save len;
1292
1293         len := length outlines1;
1294
1295         sub_outlines1 := subpath (0,
1296                                   floor (1/4 len)) of outlines1;
1297         sub_outlines2 := subpath (floor (1/4 len),
1298                                   floor (2/4 len)) of outlines1;
1299         sub_outlines3 := subpath (floor (2/4 len),
1300                                   floor (3/4 len)) of outlines1;
1301         sub_outlines4 := subpath (floor (3/4 len),
1302                                   len) of outlines1;
1303
1304         save times;
1305         numeric times[];
1306
1307         (times12, times21) = sub_outlines1 intersectiontimes sub_outlines2;
1308         (times13, times31) = sub_outlines1 intersectiontimes sub_outlines3;
1309         (times42, times24) = sub_outlines4 intersectiontimes sub_outlines2;
1310         (times43, times34) = sub_outlines4 intersectiontimes sub_outlines3;
1311
1312         T := identity xscaled 0.75 reduced_slt
1313                       yscaled 0.33 reduced_il
1314                       rotated -35;
1315         pickup pencircle transformed T;
1316         ellipse := fullcircle transformed T;
1317
1318         lft z21 = (xoffs + 1.05 reduced_il, yoffs + 0.45 reduced_il);
1319         lft z22 = (xoffs + 0.55 reduced_il, yoffs + 0.45 reduced_il);
1320         lft z23 = (xoffs + 0.55 reduced_il, yoffs - 0.45 reduced_il);
1321         lft z24 = (xoffs + 1.05 reduced_il, yoffs - 0.45 reduced_il);
1322         lft z25 = (xoffs + 1.10 reduced_il, yoffs + 0.00 reduced_il);
1323         lft z26 = (xoffs + 0.80 reduced_il, yoffs + 0.00 reduced_il);
1324
1325         paths2 := z21
1326                   .. z22
1327                   .. z23
1328                   .. z24
1329                   .. {up}z25
1330                   -- z26;
1331
1332         sub_path := subpath (0, 1) of paths2;
1333
1334         times1 = xpart (sub_outlines1 intersectiontimes sub_path);
1335         times4 = xpart (sub_outlines4 intersectiontimes sub_path);
1336
1337         % we have to find the envelope intersections (if any)
1338         save t;
1339         numeric t[];
1340
1341         t1 = find_envelope_cusp (reverse ellipse,
1342                                  subpath (1, 2) of paths2,
1343                                  1/256) + 1;
1344         if t1 < 1:
1345                 t1 := 1;
1346                 t2 := 1;
1347         else:
1348                 t2 = find_envelope_cusp (ellipse,
1349                                          subpath (3, 4) of reverse paths2,
1350                                          1/256) + 3;
1351                 t2 := length paths2 - t2;
1352         fi;
1353
1354         t3 = find_envelope_cusp (reverse ellipse,
1355                                  subpath (2, 4 - epsilon) of paths2,
1356                                  1/256) + 2;
1357         if t3 < 2:
1358                 t3 := 3;
1359                 t4 := 3;
1360         else:
1361                 t4 = find_envelope_cusp (ellipse,
1362                                          subpath (1 + epsilon, 3)
1363                                            of reverse paths2,
1364                                          1/256) + 1;
1365                 t4 := length paths2 - t4;
1366         fi;
1367
1368         fill subpath (times1 + s / 4, times13) of sub_outlines1
1369              -- subpath (times31, infinity) of sub_outlines3
1370              & subpath (0, times42) of sub_outlines4
1371              -- subpath (times24, infinity) of sub_outlines2
1372              & subpath (0, times34) of sub_outlines3
1373              -- subpath (times43, times4 - s / 4) of sub_outlines4
1374              -- cycle;
1375         unfill subpath (times12, infinity) of sub_outlines1
1376                & subpath (0, times21) of sub_outlines2
1377                -- cycle;
1378         fill subpath (times4 + s / 4, infinity) of sub_outlines4
1379              & subpath (0, times1 - s / 4) of sub_outlines1
1380              -- cycle;
1381
1382
1383         % we approximate `draw paths2'
1384         for i = 1 step s until (length paths2 - s):
1385                 dirs[i + 20] := direction (i - 1) of paths2;
1386         endfor;
1387
1388         sub_outlines21 := get_subpath (ellipse, -dirs21, dirs21, z21)
1389                           for i = (1 + s) step s until (length paths2 - s):
1390                                   .. get_subpoint (ellipse, dirs[i + 20],
1391                                                    point (i - 1) of paths2)
1392                           endfor
1393                           .. get_subpath (ellipse, up, z26 - z25, z25);
1394         sub_outlines22 := get_subpath (ellipse, z26 - z25, z25 - z26, z26)
1395                           -- get_subpoint (ellipse, z25 - z26, z25);
1396         sub_outlines23 := get_subpoint (ellipse, down, z25)
1397                           for i = (length paths2 - s) step -s until (t4 + 1):
1398                                   .. get_subpoint (ellipse, -dirs[i + 20],
1399                                                    point (i - 1) of paths2)
1400                           endfor
1401                           .. get_subpoint (ellipse, -direction t4 of paths2,
1402                                            point t4 of paths2);
1403         sub_outlines24 := get_subpoint (ellipse, -direction t3 of paths2,
1404                                         point t3 of paths2)
1405                           for i = (floor (t3 / s) * s + 1) step -s until (t2 + 1):
1406                                   .. get_subpoint (ellipse, -dirs[i + 20],
1407                                                    point (i - 1) of paths2)
1408                           endfor
1409                           .. get_subpoint (ellipse, -direction t2 of paths2,
1410                                            point t2 of paths2);
1411         sub_outlines25 := get_subpoint (ellipse, -direction t1 of paths2,
1412                                         point t1 of paths2)
1413                           for i = (floor (t1 / s) * s + 1) step -s until (1 + s):
1414                                   .. get_subpoint (ellipse, -dirs[i + 20],
1415                                                    point (i - 1) of paths2)
1416                           endfor;
1417
1418         (times2223, times2322) = sub_outlines22 intersectiontimes sub_outlines23;
1419         (times2324, times2423) = sub_outlines23 intersectiontimes sub_outlines24;
1420         (times2425, times2524) = sub_outlines24 intersectiontimes sub_outlines25;
1421
1422         fill sub_outlines21
1423              -- subpath (0, times2223) of sub_outlines22
1424              -- subpath (times2322, times2324) of sub_outlines23
1425              -- subpath (times2423, times2425) of sub_outlines24
1426              -- subpath (times2524, infinity) of sub_outlines25
1427              .. cycle;
1428
1429         labels (1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
1430         labels (21, 22, 23, 24, 25, 26);
1431 enddef;
1432
1433
1434 fet_beginchar ("petrucci g clef", "petrucci.g");
1435         if test = 1:
1436                 draw_staff (-1, 3, 0.0);
1437         fi;
1438         draw_petrucci_g_clef ((0, 0), 1.0);
1439 fet_endchar;
1440
1441
1442 fet_beginchar ("petrucci g clef", "petrucci.g_change");
1443         draw_petrucci_g_clef ((0, 0), .8);
1444 fet_endchar;
1445
1446
1447 def draw_mensural_g_clef (expr exact_center, reduction) =
1448   % TODO: Rewrite me.  The former mensural g clef looked ugly, and the
1449   % code was removed when it broke for small font sizes after some
1450   % global changes in the font.  Currently, the character is mapped to
1451   % a copy of the petrucci g clef (which, after all, *is* a mensural g
1452   % clef, but not the one that we have in mind here). -- jr
1453   %
1454   % Possible sources of inspiration for this clef include: Francisco
1455   % Guerrero, "Lib. 1.  Missarum" (1566), in: MGG, volume 3, col. 858
1456   % ("Ducis"); Stefano Fabri, "Quam speciosa veteranis" (1611), in:
1457   % MGG, volume 3, col. 1698 ("Fabri"); Philippus Dulichius,
1458   % "Fasciculus novus ..."  (1598), in: MGG, volume 3, col. 919
1459   % ("Dulichius"), fig. 1; Noe Faignient, "Ic sal de Heer myn God
1460   % gebenedye" (1568), in: MGG, volume 3, col. 1735 ("Faignient").
1461 enddef;
1462
1463
1464 %
1465 % FIXME: This clef is preliminarily mapped to the petrucci g clef
1466 % until the code for the mensural g clef will be rewritten.
1467 %
1468 fet_beginchar ("mensural g clef", "mensural.g");
1469         if test = 1:
1470                 draw_staff (-1, 3, 0.0);
1471         fi;
1472         draw_petrucci_g_clef ((0, 0), 1.0);
1473 fet_endchar;
1474
1475
1476 fet_beginchar ("mensural g clef", "mensural.g_change");
1477         draw_petrucci_g_clef ((0, 0), .8);
1478 fet_endchar;
1479
1480
1481
1482 %%%%%%%%
1483 %
1484 %
1485 %
1486 % Hufnagel
1487 %
1488 %
1489 %
1490 def draw_hufnagel_do_clef (expr exact_center, reduction) =
1491         % inspired by Graduale of Friedrich Zollner (1442), in: MGG,
1492         % volume 9, col. 1413 ("Neustift"), fig. 1.
1493
1494         save reduced_il;
1495
1496         reduced_il# = staff_space# * reduction;
1497
1498         define_pixels (reduced_il);
1499
1500         set_char_box (0 - xpart exact_center,
1501                       1.10 reduced_il# + xpart exact_center,
1502                       0.70 reduced_il# - ypart exact_center,
1503                       0.75 reduced_il# + ypart exact_center);
1504
1505         save xoffs, yoffs;
1506
1507         xoffs# = xpart exact_center;
1508         yoffs# = ypart exact_center;
1509
1510         define_pixels (xoffs, yoffs);
1511
1512         save ellipse, pat, T;
1513         path ellipse, pat;
1514         transform T;
1515
1516         T := identity xscaled 0.6 reduced_il
1517                       yscaled 0.1 reduced_il
1518                       rotated 40;
1519         pickup pencircle transformed T;
1520         ellipse := fullcircle transformed T;
1521
1522         z1 = (xoffs + 0.90 reduced_il, yoffs + .45 reduced_il);
1523         z2 = (xoffs + 0.80 reduced_il, yoffs + .45 reduced_il);
1524         z3 = (xoffs + 0.50 reduced_il, yoffs + .60 reduced_il);
1525         z4 = (xoffs + 0.20 reduced_il, yoffs + .45 reduced_il);
1526         z5 = (xoffs + 0.20 reduced_il, yoffs - .45 reduced_il);
1527         z6 = (xoffs + 0.40 reduced_il, yoffs - .55 reduced_il);
1528
1529         pat := z1
1530                .. z2
1531                .. z3
1532                -- z4
1533                -- z5
1534                -- z6;
1535
1536         fill get_subpath (ellipse,
1537                           -direction 0 of pat, direction 0 of pat, z1)
1538              .. get_subpoint (ellipse, direction 1 of pat, z2)
1539              .. get_subpath (ellipse,
1540                              direction (2 - epsilon) of pat, z4 - z3, z3)
1541              -- get_subpath (ellipse,
1542                              z4 - z3, z5 - z4, z4)
1543              -- get_subpath (ellipse,
1544                              z5 - z4, z6 - z5, z5)
1545              -- get_subpath (ellipse,
1546                              z6 - z5, z5 - z6, z6)
1547              -- get_subpoint (ellipse, z5 - z6, z5)
1548              -- get_subpoint (ellipse, z4 - z5, z5)
1549              -- get_subpoint (ellipse, z4 - z5, z4)
1550              -- get_subpoint (ellipse, -direction (2 - epsilon) of pat, z3)
1551              .. get_subpath (ellipse,
1552                              -direction 1 of pat, -direction 1 of pat, z2)
1553              .. cycle;
1554
1555         labels (1, 2, 3, 4, 5, 6);
1556 enddef;
1557
1558
1559 fet_beginchar ("Hufnagel do clef", "hufnagel.do");
1560         if test = 1:
1561                 draw_staff (-1, 3, 0.0);
1562         fi;
1563         draw_hufnagel_do_clef ((0, 0), 1.0);
1564 fet_endchar;
1565
1566
1567 fet_beginchar ("Hufnagel do clef", "hufnagel.do_change");
1568         draw_hufnagel_do_clef ((0, 0), .8);
1569 fet_endchar;
1570
1571
1572 def draw_hufnagel_fa_clef (expr exact_center, reduction) =
1573         % inspired by Bamberger Manuscript (15th century), in:
1574         % MGG, volume 2, table 59.
1575
1576         save reduced_il;
1577
1578         reduced_il# = staff_space# * reduction;
1579
1580         define_pixels (reduced_il);
1581
1582         set_char_box (0 - xpart exact_center,
1583                       1.20 reduced_il# + xpart exact_center,
1584                       1.15 reduced_il# - ypart exact_center,
1585                       1.00 reduced_il# + ypart exact_center);
1586
1587         save xoffs, yoffs;
1588
1589         xoffs# = xpart exact_center;
1590         yoffs# = ypart exact_center;
1591
1592         define_pixels (xoffs, yoffs);
1593
1594         save ellipse, pat, T;
1595         path ellipse, pat;
1596         transform T;
1597
1598         T := identity xscaled 0.6 reduced_il
1599                       yscaled 0.1 reduced_il
1600                       rotated 40;
1601         pickup pencircle transformed T;
1602         ellipse := fullcircle transformed T;
1603
1604         z11 = (xoffs + 0.90 reduced_il, yoffs + 0.70 reduced_il);
1605         z12 = (xoffs + 0.80 reduced_il, yoffs + 0.70 reduced_il);
1606         z13 = (xoffs + 0.50 reduced_il, yoffs + 0.85 reduced_il);
1607         z14 = (xoffs + 0.20 reduced_il, yoffs + 0.70 reduced_il);
1608         z15 = (xoffs + 0.20 reduced_il, yoffs - 1.10 reduced_il);
1609
1610         pat := z11
1611                .. z12
1612                .. z13
1613                -- z14
1614                -- z15;
1615
1616         fill get_subpath (ellipse,
1617                           -direction 0 of pat, direction 0 of pat, z11)
1618              .. get_subpoint (ellipse, direction 1 of pat, z12)
1619              .. get_subpath (ellipse,
1620                              direction (2 - epsilon) of pat, z14 - z13, z13)
1621              -- get_subpath (ellipse,
1622                              z14 - z13, z15 - z14, z14)
1623              -- get_subpath (ellipse,
1624                              z15 - z14, z14 - z15, z15)
1625              -- get_subpoint (ellipse, z14 - z15, z14)
1626              -- get_subpoint (ellipse, -direction (2 - epsilon) of pat, z13)
1627              .. get_subpath (ellipse,
1628                              -direction 1 of pat, -direction 1 of pat, z12)
1629              .. cycle;
1630
1631         z16 = (xoffs + 0.90 reduced_il, yoffs - 0.05 reduced_il);
1632         z17 = (xoffs + 0.80 reduced_il, yoffs - 0.05 reduced_il);
1633         z18 = (xoffs + 0.50 reduced_il, yoffs + 0.10 reduced_il);
1634         z19 = (xoffs + 0.20 reduced_il, yoffs - 0.05 reduced_il);
1635
1636         pat := z16
1637                .. z17
1638                .. z18
1639                -- z19;
1640
1641         fill get_subpath (ellipse,
1642                           -direction 0 of pat, direction 0 of pat, z16)
1643              .. get_subpoint (ellipse, direction 1 of pat, z17)
1644              .. get_subpath (ellipse,
1645                              direction (2 - epsilon) of pat, z19 - z18, z18)
1646              -- get_subpoint (ellipse, z19 - z18, z19)
1647              -- get_subpoint (ellipse, -direction (2 - epsilon) of pat, z18)
1648              .. get_subpoint (ellipse, -direction 1 of pat, z17)
1649              .. cycle;
1650
1651         labels (11, 12, 13, 14, 15, 16, 17, 18, 19);
1652 enddef;
1653
1654
1655 fet_beginchar ("Hufnagel fa clef", "hufnagel.fa");
1656         if test = 1:
1657                 draw_staff (-1, 3, 0.0);
1658         fi;
1659         draw_hufnagel_fa_clef ((0, 0), 1.0);
1660 fet_endchar;
1661
1662
1663 fet_beginchar ("Hufnagel fa clef", "hufnagel.fa_change");
1664         draw_hufnagel_fa_clef ((0, 0), .8);
1665 fet_endchar;
1666
1667
1668 def draw_hufnagel_do_fa_clef (expr exact_center, reduction) =
1669         draw_hufnagel_do_clef (exact_center, reduction);
1670         draw_hufnagel_fa_clef (exact_center + (0, -2 staff_space#), reduction);
1671
1672         set_char_box (0 - xpart exact_center,
1673                       1.20 reduced_il# + xpart exact_center,
1674                       1.15 reduced_il# + 2 staff_space# - ypart exact_center,
1675                       0.75 reduced_il# + ypart exact_center);
1676 enddef;
1677
1678
1679 fet_beginchar ("Hufnagel do/fa clef", "hufnagel.do.fa");
1680         if test = 1:
1681                 draw_staff (-1, 3, 0.0);
1682         fi;
1683         draw_hufnagel_do_fa_clef ((0, 0), 1.0);
1684 fet_endchar;
1685
1686
1687 fet_beginchar ("Hufnagel do/fa clef", "hufnagel.do.fa_change");
1688         draw_hufnagel_do_fa_clef ((0, 0), .8);
1689 fet_endchar;
1690
1691
1692 fet_endgroup ("clefs");