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