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