]> git.donarmstrong.com Git - lilypond.git/blob - mf/parmesan-noteheads.mf
Add '-dcrop' option to ps and svg backends
[lilypond.git] / mf / parmesan-noteheads.mf
1 % Feta (not the Font-En-Tja) music font --  ancient note heads
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 % Neo-mensural heads originally by
7 % Christian Mondrup and Mats Bengtsson
8 %
9 % The LilyPond font is free software: you can redistribute it and/or modify
10 % it under the terms of the GNU General Public License as published by
11 % the Free Software Foundation, either version 3 of the License, or
12 % (at your option) any later version, or under the SIL Open Font License.
13 %
14 % LilyPond is distributed in the hope that it will be useful,
15 % but WITHOUT ANY WARRANTY; without even the implied warranty of
16 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 % GNU General Public License for more details.
18 %
19 % You should have received a copy of the GNU General Public License
20 % along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
21
22 save black_notehead_width;
23 numeric black_notehead_width;
24
25 fet_begingroup ("noteheads");
26
27 %
28 % character aligment:
29 %
30 %   The head is assumed to be vertically centered around (0, 0).
31 %   The left-most edge of the head should touch the vertical line
32 %   that goes though the point (0, 0).
33 %
34 % set_char_box() conventions:
35 %
36 % * breapth: Ignored (as far as I know).  Should be set to 0.
37 %
38 % * width: Should match the head's width.
39 %
40 % * depth: Should match the bottom edge of the head.  Affects vertical
41 %   collision handling.
42 %
43 % * height: Should match the top edge of the head.  Affects vertical
44 %   collision handling.
45 %
46 % TODO: should depth/height include appendages/stems?
47
48 save overdone_heads, noteheight;
49
50 overdone_heads = 0;
51 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
52 define_pixels (noteheight);
53
54
55 %%%%%%%%
56 %
57 %
58 %
59 % NEO-MENSURAL NOTATION
60 %
61 %
62 %
63
64 def draw_neomensural_brevis (expr brevwid, holeheight, open, full) =
65         save beamheight, head_width, head_height;
66         save stem_width, serif_size, serif_protrude;
67
68         head_width# := brevwid;
69         head_height# := noteheight#;
70         stem_width := 1.3 linethickness;
71
72         define_pixels (head_width, head_height);
73
74         set_char_box (0, head_width#,
75                       head_height# / 2, head_height# / 2);
76
77         2 beamheight + holeheight = head_height;
78         serif_size := blot_diameter;
79         serif_protrude := .15 head_height;
80
81         z1l = (0, 0);
82         z2l = (0, - (holeheight - 2 serif_size) / 2);
83         z3r = z2r + serif_size * (1, -1);
84         y4r = y3r;
85         x4r = head_width / 2;
86         z5l = z3l + (-serif_size, -serif_protrude);
87
88         penpos1 (stem_width, 0);
89         penpos2 (stem_width, 0);
90         penpos3 (beamheight, 90);
91         penpos4 (beamheight, 90);
92         penpos5 (stem_width, 180);
93
94         save pat_out;
95         path pat_out;
96
97         pat_out := z4l
98                    -- z3l{left}
99                    .. z5l{down}
100                    .. z5r{up}
101                    -- z1l;
102         pat_out := pat_out
103                    -- reverse pat_out yscaled -1;
104         pat_out := pat_out
105                    -- reverse pat_out shifted (-x4r, 0)
106                                       xscaled -1
107                                       shifted (x4l, 0)
108                    -- cycle;
109         fill pat_out;
110
111         if open:
112                 save pat_in;
113                 path pat_in;
114
115                 pat_in := z4r
116                           -- z3r{left}
117                           .. z2r{up}
118                           -- z1r;
119                 pat_in := pat_in
120                           -- reverse pat_in yscaled -1;
121                 if full:
122                         pat_in := pat_in
123                                   -- reverse pat_in shifted (-x4r, 0)
124                                                     xscaled -1
125                                                     shifted (x4l, 0);
126                 fi;
127                 pat_in := pat_in
128                           -- cycle;
129                 unfill pat_in;
130         fi;
131
132         penlabels (1, 2, 3, 4, 5);
133 enddef;
134
135
136 %
137 % Some sources (eg. Musix/OpusTeX) think that the appendage should be on
138 % the left, some say right.  Right wins democratically.
139 %
140 def draw_neomensural_longa (expr wid, holeheight, direction) =
141         draw_neomensural_brevis (wid, holeheight, true, true);
142
143         save theta, dir;
144         dir := -direction;
145
146         x7 = head_width - stem_width / 2;
147         y7 = dir * y5;
148         z6 - z7 = (stem_width / 2, -dir * staff_space);
149         theta = dir * angle (z6 - z7) + 90;
150
151         penpos7 (stem_width, 0);
152         penpos6 (1.2 stem_width, theta);
153
154         z7' = find_tangent (z6l, pat_out,
155                             (x7l + 0.5 stem_width, y7l),
156                             (x7l - 0.5 stem_width, y7l));
157
158         fill z7r
159              .. z6r{z6 - z7}
160              .. {z7 - z6}z6l
161              -- z7'
162              -- cycle;
163
164         penlabels (6, 7);
165         labels (7');
166 enddef;
167
168
169 def draw_neomensural_black_head (expr width, height, concaveness) =
170         save head_width, head_height, stem_width;
171         save ne, nw, ne_dist, nw_dist;
172         pair ne, nw, ne_dist, nw_dist;
173
174         head_width# := width;
175         head_height# := height;
176         stem_width# := 1.3 linethickness#;
177
178         set_char_box (0, head_width#,
179                       head_height# / 2, head_height# / 2);
180
181         charwx := head_width# / 2;
182         charwy := head_height# / 2 - 2 stem_width#;
183
184         y3 = y1 = 0;
185         x2 = x4 = 1/2 [x1, x3];
186
187         pickup pencircle scaled blot_diameter;
188
189         top y2 = h;
190         bot y4 = -d;
191         lft x1 = 0;
192         rt x3 = w;
193
194         ne := unitvector (z2 - z1);
195         nw_dist := (ne rotated 90) * blot_diameter / 2;
196         nw := unitvector (z2 - z3);
197         ne_dist := (nw rotated -90) * blot_diameter / 2;
198
199         fill lft z1
200              .. (z1 + nw_dist){ ne rotated -concaveness }
201              .. { ne rotated concaveness }(z2 + nw_dist)
202              .. top z2
203              .. (z2 + ne_dist){ nw rotated (180 - concaveness) }
204              .. { nw rotated (180 + concaveness) }(z3 + ne_dist)
205              .. rt z3
206              .. (z3 - nw_dist){ ne rotated (180 - concaveness) }
207              .. { ne rotated (180 + concaveness) }(z4 - nw_dist)
208              .. bot z4
209              .. (z4 - ne_dist){ nw  rotated -concaveness }
210              .. { nw  rotated concaveness }(z1 - ne_dist)
211              .. cycle;
212
213         labels (1, 2, 3, 4);
214 enddef;
215
216
217 def draw_neomensural_open_head (expr width, height, concaveness)=
218         draw_neomensural_black_head (width, height, concaveness);
219
220         save headNW, headSW, stem_width;
221
222         headNW = length (z2 - z1) + blot_diameter;
223         headSW = length (z4 - z1) + blot_diameter;
224         stem_width = 1.3 linethickness;
225
226         save hole_widthNW, hole_widthSW;
227
228         hole_widthNW = .25 headNW;
229         hole_widthSW + 2 stem_width = headSW;
230
231         (rt z7 + lft z5) / 2 = (w / 2, 0);
232         (bot z8 + top z6) / 2 = (w / 2, 0);
233         z6 - z5 = (hole_widthNW - blot_diameter) * unitvector (z2 - z1);
234         z7 - z6 = (hole_widthSW - blot_diameter) * unitvector (z4 - z1);
235
236         unfill lft z5
237                .. (z5 + nw_dist)
238                -- (z6 + nw_dist)
239                .. top z6
240                .. (z6 + ne_dist)
241                -- (z7 + ne_dist)
242                .. rt z7
243                .. (z7 - nw_dist)
244                -- (z8 - nw_dist)
245                .. bot z8
246                .. (z8 - ne_dist)
247                -- (z5 - ne_dist)
248                .. cycle;
249
250         labels (5, 6, 7, 8);
251 enddef;
252
253
254 %
255 % Neo-mensural maxima/longa/brevis
256 %
257 % En wij presenteren U: de opvolgster van Emily
258 %
259 % (ze is wel breed)
260 %
261
262 save nm_maxima_width, nm_longa_width, nm_brevis_width;
263 save nm_holeheight, nm_red_holeheight;
264
265 nm_maxima_width := 2.6 staff_space#;
266 nm_longa_width := 2 staff_space#;
267 nm_brevis_width := nm_longa_width;
268 nm_holeheight := 4 linethickness;
269 nm_red_holeheight := 2.5 linethickness;
270
271 fet_beginchar ("Neo-mensural maxima notehead (up)", "uM3neomensural");
272         draw_neomensural_longa (nm_maxima_width, nm_holeheight, 1);
273 fet_endchar;
274
275 fet_beginchar ("Neo-mensural maxima notehead (down)", "dM3neomensural");
276         draw_neomensural_longa (nm_maxima_width, nm_holeheight, -1);
277 fet_endchar;
278
279 fet_beginchar ("Neo-mensural longa notehead (up)", "uM2neomensural");
280         draw_neomensural_longa (nm_longa_width, nm_holeheight, 1);
281 fet_endchar;
282
283 fet_beginchar ("Neo-mensural longa notehead (down)", "dM2neomensural");
284         draw_neomensural_longa (nm_longa_width, nm_holeheight, -1);
285 fet_endchar;
286
287 fet_beginchar ("Neo-mensural brevis notehead", "sM1neomensural");
288         draw_neomensural_brevis (nm_brevis_width, nm_holeheight, true, true);
289 fet_endchar;
290
291 fet_beginchar ("Neo-mensural maxima notehead (up, reduced hole)", "urM3neomensural");
292         draw_neomensural_longa (nm_maxima_width, nm_red_holeheight, 1);
293 fet_endchar;
294
295 fet_beginchar ("Neo-mensural maxima notehead (down, reduced hole)", "drM3neomensural");
296         draw_neomensural_longa (nm_maxima_width, nm_red_holeheight, -1);
297 fet_endchar;
298
299 fet_beginchar ("Neo-mensural longa notehead (up, reduced hole)", "urM2neomensural");
300         draw_neomensural_longa (nm_longa_width, nm_red_holeheight, 1);
301 fet_endchar;
302
303 fet_beginchar ("Neo-mensural longa notehead (down, reduced hole)", "drM2neomensural");
304         draw_neomensural_longa (nm_longa_width, nm_red_holeheight, -1);
305 fet_endchar;
306
307 fet_beginchar ("Neo-mensural brevis notehead (reduced hole)", "srM1neomensural");
308         draw_neomensural_brevis (nm_brevis_width, nm_red_holeheight, true, true);
309 fet_endchar;
310
311
312 %
313 % Neo-mensural semibrevis/minima/semiminima
314 %
315
316 save nm_height, nm_width;
317 nm_height := noteheight#;
318 nm_width := staff_space#;
319 fet_beginchar ("Neo-mensural semibrevis head", "s0neomensural");
320         draw_neomensural_open_head (nm_width, nm_height, 0);
321 fet_endchar;
322
323 fet_beginchar ("Neo-mensural minima head", "s1neomensural");
324         draw_neomensural_open_head (nm_width, nm_height, 0);
325 fet_endchar;
326
327 fet_beginchar ("Neo-mensural semiminima head", "s2neomensural");
328         draw_neomensural_black_head (nm_width, nm_height, 0);
329 fet_endchar;
330
331 %%%%%%%%
332 %
333 %
334 %
335 % HARMONIC NOTATION
336 %
337 %
338 %
339
340 %
341 % WL says the thin lines should be thinner.
342 %
343
344 fet_beginchar ("Harmonic notehead (Neo-mensural open)", "s0harmonic");
345         draw_neomensural_open_head (1.3 staff_space#, 1.3 noteheight#, 5);
346         charwx := head_width#;
347         charwy := 0;
348 fet_endchar;
349
350 fet_beginchar ("Harmonic notehead (Neo-mensural black)", "s2harmonic");
351         draw_neomensural_black_head (1.3 staff_space#, 1.3 noteheight#, 5);
352         charwx := head_width#;
353         charwy := 0;
354 fet_endchar;
355
356
357 %%%%%%%%
358 %
359 %
360 %
361 % MENSURAL/PETRUCCI NOTATIONS
362 %
363 %
364 %
365
366 def draw_mensural_brevis (expr wid, holeheight, open, full) =
367         % TODO.  For the moment, fall back to draw_neomensural_brevis.
368         draw_neomensural_brevis (wid, holeheight, open, full);
369 enddef;
370
371
372 def draw_mensural_longa (expr wid, holeheight, open, full, direction, ligature) =
373         draw_mensural_brevis (wid, holeheight, open, full);
374
375         save dir;
376         dir := -direction;
377
378         x6 = x7 = head_width - stem_width / 2;
379         y6 = dir * y5;
380         y7 = dir * y5 -1.75 dir * staff_space;
381
382         z17 = (x7, y7 - dir * stem_width / 2);
383
384         penpos6 (stem_width, 0);
385         if ligature:
386                 penpos7 (stem_width, 0);
387         else:
388                 penpos7 (1.5 stem_width, 0);
389         fi;
390
391         fill z7l
392              -- z6l
393              -- z6r
394              -- z7r
395              .. z17
396              .. cycle;
397
398         penlabels (6, 7);
399         labels (17);
400 enddef;
401
402
403 def draw_diamond_head (expr head_h, pen_w, pen_h, angle, open) =
404         save head_width, head_height;
405         save ellipse, ellipse_r;
406         path ellipse, ellipse_r, diamond_shape;
407
408         head_height# = head_h;
409         head_width# / head_height# = tand (angle);
410
411         set_char_box (0, head_width#,
412                       head_height# / 2, head_height# / 2);
413
414         charwx := head_width# / 2;
415         charwy := head_height# / 2 - 2 linethickness#;
416
417         define_pixels (head_width, head_height);
418
419         ellipse := reverse fullcircle
420                      xscaled (max (blot_diameter, pen_w * head_width))
421                      yscaled (max (blot_diameter, pen_h * head_width))
422                      rotated -angle;
423
424         z1 = find_tangent_shift (((0, h) -- (0, -h)), ellipse,
425                                  (0, 0), (w / 2, 0));
426         z2 = find_tangent_shift (((0, h) -- (w, h)), ellipse,
427                                  (w / 2, h), (w / 2, 0));
428         z3 = find_tangent_shift (((w, h) -- (w, -h)), ellipse,
429                                  (w, 0), (w / 2, 0));
430         z4 = find_tangent_shift (((0, -h) -- (w, -h)), ellipse,
431                                  (w / 2, -h), (w / 2, 0));
432
433         diamond_shape := get_subpath (ellipse, z1 - z4, z2 - z1, z1)
434                          -- get_subpath (ellipse, z2 - z1, z3 - z2, z2)
435                          -- get_subpath (ellipse, z3 - z2, z4 - z3, z3)
436                          -- get_subpath (ellipse, z4 - z3, z1 - z4, z4)
437                          -- cycle;
438         fill diamond_shape;
439
440         if open:
441                 save l;
442                 path l[];
443
444                 l12 := (directionpoint (z1 - z2) of ellipse) shifted z1
445                         -- (directionpoint (z1 - z2) of ellipse) shifted z2;
446                 l23 := (directionpoint (z2 - z3) of ellipse) shifted z2
447                         -- (directionpoint (z2 - z3) of ellipse) shifted z3;
448                 l34 := (directionpoint (z3 - z4) of ellipse) shifted z3
449                         -- (directionpoint (z3 - z4) of ellipse) shifted z4;
450                 l41 := (directionpoint (z4 - z1) of ellipse) shifted z4
451                         -- (directionpoint (z4 - z1) of ellipse) shifted z1;
452
453                 unfill l12 intersectionpoint l23
454                        -- l23 intersectionpoint l34
455                        -- l34 intersectionpoint l41
456                        -- l41 intersectionpoint l12
457                        -- cycle;
458         fi;
459
460         labels (1, 2, 3, 4);
461 enddef;
462
463
464 %
465 % Mensural/Petrucci maxima/longa/brevis
466 %
467
468 save m_maxima_width, m_longa_width, m_brevis_width,
469                  m_holeheight, m_red_holeheight;
470 m_maxima_width := 2.0 staff_space#;
471 m_longa_width := staff_space#;
472 m_brevis_width := m_longa_width;
473 m_holeheight := nm_holeheight;
474 m_red_holeheight := nm_red_holeheight;
475
476
477 fet_beginchar ("Mensural maxima notehead (up)", "uM3mensural");
478         draw_mensural_longa (m_maxima_width, m_holeheight,
479                              true, true, 1, false);
480 fet_endchar;
481
482
483 fet_beginchar ("Mensural maxima notehead (down)", "dM3mensural");
484         draw_mensural_longa (m_maxima_width, m_holeheight,
485                              true, true, -1, false);
486 fet_endchar;
487
488
489 fet_beginchar ("Mensural maxima notehead (ligature)", "sM3ligmensural");
490         draw_mensural_brevis (m_maxima_width, m_holeheight, true, true);
491 fet_endchar;
492
493
494 fet_beginchar ("Mensural longa notehead (up)", "uM2mensural");
495         draw_mensural_longa (m_longa_width, m_holeheight,
496                              true, true, 1, false);
497 fet_endchar;
498
499
500 fet_beginchar ("Mensural longa notehead (down)", "dM2mensural");
501         draw_mensural_longa (m_longa_width, m_holeheight,
502                              true, true, -1, false);
503 fet_endchar;
504
505 fet_beginchar ("Mensural longa notehead (ligature)", "sM2ligmensural");
506         draw_mensural_longa (m_longa_width, m_holeheight,
507                              true, true, -1, true);
508 fet_endchar;
509
510
511 fet_beginchar ("Mensural brevis notehead", "sM1mensural");
512         draw_mensural_brevis (m_brevis_width, m_holeheight, true, true);
513 fet_endchar;
514
515
516 fet_beginchar ("Mensural maxima notehead (up, reduced hole)",
517                "urM3mensural");
518         draw_mensural_longa (m_maxima_width, m_red_holeheight,
519                              true, true, 1, false);
520 fet_endchar;
521
522
523 fet_beginchar ("Mensural maxima notehead (down, reduced hole)",
524                "drM3mensural");
525         draw_mensural_longa (m_maxima_width, m_red_holeheight,
526                              true, true, -1, false);
527 fet_endchar;
528
529
530 fet_beginchar ("Mensural maxima notehead (ligature, reduced hole)",
531                "srM3ligmensural");
532         draw_mensural_brevis (m_maxima_width, m_red_holeheight, true, true);
533 fet_endchar;
534
535
536 fet_beginchar ("Mensural longa notehead (up, reduced hole)",
537                "urM2mensural");
538         draw_mensural_longa (m_longa_width, m_red_holeheight,
539                              true, true, 1, false);
540 fet_endchar;
541
542
543 fet_beginchar ("Mensural longa notehead (down, reduced hole)",
544                "drM2mensural");
545         draw_mensural_longa (m_longa_width, m_red_holeheight,
546                              true, true, -1, false);
547 fet_endchar;
548
549
550 fet_beginchar ("Mensural longa notehead (ligature, reduced hole)",
551                "srM2ligmensural");
552         draw_mensural_longa (m_longa_width, m_red_holeheight,
553                              true, true, -1, true);
554 fet_endchar;
555
556
557 fet_beginchar ("Mensural brevis notehead (reduced hole)", "srM1mensural");
558         draw_mensural_brevis (m_brevis_width, m_red_holeheight, true, true);
559 fet_endchar;
560
561
562 %
563 % Semi-colored mensural/Petrucci maxima/longa/brevis
564 %
565
566 fet_beginchar ("Semi-colored mensural maxima notehead (up)",
567                "uM3semimensural");
568         draw_mensural_longa (m_maxima_width, m_holeheight,
569                              true, false, 1, false);
570 fet_endchar;
571
572
573 fet_beginchar ("Semi-colored mensural maxima notehead (down)",
574                "dM3semimensural");
575         draw_mensural_longa (m_maxima_width, m_holeheight,
576                              true, false, -1, false);
577 fet_endchar;
578
579
580 fet_beginchar ("Semi-colored mensural maxima notehead (ligature)",
581                "sM3semiligmensural");
582         draw_mensural_brevis (m_maxima_width, m_holeheight, true, false);
583 fet_endchar;
584
585
586 fet_beginchar ("Semi-colored mensural longa notehead (up)",
587                "uM2semimensural");
588         draw_mensural_longa (m_longa_width, m_holeheight,
589                              true, false, 1, false);
590 fet_endchar;
591
592
593 fet_beginchar ("Semi-colored mensural longa notehead (down)",
594                "dM2semimensural");
595         draw_mensural_longa (m_longa_width, m_holeheight,
596                              true, false, -1, false);
597 fet_endchar;
598
599
600 fet_beginchar ("Semi-colored mensural longa notehead (ligature)",
601                "sM2semiligmensural");
602         draw_mensural_longa (m_longa_width, m_holeheight,
603                              true, false, -1, true);
604 fet_endchar;
605
606
607 fet_beginchar ("Semi-colored mensural brevis notehead", "sM1semimensural");
608         draw_mensural_brevis (m_brevis_width, m_holeheight, true, false);
609 fet_endchar;
610
611
612 fet_beginchar ("Semi-colored mensural maxima notehead (up, reduced hole)",
613                "urM3semimensural");
614         draw_mensural_longa (m_maxima_width, m_red_holeheight,
615                              true, false, 1, false);
616 fet_endchar;
617
618
619 fet_beginchar ("Semi-colored mensural maxima notehead (down, reduced hole)",
620                "drM3semimensural");
621         draw_mensural_longa (m_maxima_width, m_red_holeheight,
622                              true, false, -1, false);
623 fet_endchar;
624
625
626 fet_beginchar ("Semi-colored mensural maxima notehead (ligature, reduced hole)",
627                "srM3semiligmensural");
628         draw_mensural_brevis (m_maxima_width, m_red_holeheight, true, false);
629 fet_endchar;
630
631
632 fet_beginchar ("Semi-colored mensural longa notehead (up, reduced hole)",
633                "urM2semimensural");
634         draw_mensural_longa (m_longa_width, m_red_holeheight,
635                              true, false, 1, false);
636 fet_endchar;
637
638
639 fet_beginchar ("Semi-colored mensural longa notehead (down, reduced hole)",
640                "drM2semimensural");
641         draw_mensural_longa (m_longa_width, m_red_holeheight,
642                              true, false, -1, false);
643 fet_endchar;
644
645
646 fet_beginchar ("Semi-colored mensural longa notehead (ligature, reduced hole)",
647                "srM2semiligmensural");
648         draw_mensural_longa (m_longa_width, m_red_holeheight,
649                              true, false, -1, true);
650 fet_endchar;
651
652
653 fet_beginchar ("Semi-colored mensural brevis notehead (reduced hole)",
654                "srM1semimensural");
655         draw_mensural_brevis (m_brevis_width, m_red_holeheight, true, false);
656 fet_endchar;
657
658
659 %
660 % Black mensural/Petrucci maxima/longa/brevis
661 %
662
663 fet_beginchar ("Black mensural maxima notehead (up)", "uM3blackmensural");
664         draw_mensural_longa (m_maxima_width, 0, false, false, 1, false);
665 fet_endchar;
666
667
668 fet_beginchar ("Black mensural maxima notehead (down)", "dM3blackmensural");
669         draw_mensural_longa (m_maxima_width, 0, false, false, -1, false);
670 fet_endchar;
671
672
673 fet_beginchar ("Black mensural maxima notehead (ligature)",
674                "sM3blackligmensural");
675         draw_mensural_brevis (m_maxima_width, 0, false, false);
676 fet_endchar;
677
678
679 fet_beginchar ("Black mensural longa notehead (up)", "uM2blackmensural");
680         draw_mensural_longa (m_longa_width, 0, false, false, 1, false);
681 fet_endchar;
682
683
684 fet_beginchar ("Black mensural longa notehead (down)", "dM2blackmensural");
685         draw_mensural_longa (m_longa_width, 0, false, false, -1, false);
686 fet_endchar;
687
688
689 fet_beginchar ("Black mensural longa notehead (ligature)",
690                "sM2blackligmensural");
691         draw_mensural_longa (m_longa_width, 0, false, false, -1, true);
692 fet_endchar;
693
694
695 fet_beginchar ("Black mensural brevis notehead", "sM1blackmensural");
696         draw_mensural_brevis (m_brevis_width, 0, false, false);
697 fet_endchar;
698
699
700 %
701 % Mensural semibrevis/minima/semiminima
702 %
703
704 fet_beginchar ("Mensural semibrevis head", "s0mensural");
705         draw_diamond_head (staff_space#, 0.15, 0.30, 30, true);
706 fet_endchar;
707
708
709 fet_beginchar ("Mensural minima head", "s1mensural");
710         draw_diamond_head (staff_space#, 0.15, 0.30, 30, true);
711 fet_endchar;
712
713
714 fet_beginchar ("Mensural semiminima head", "s2mensural");
715         draw_diamond_head (staff_space#, 0.15, 0.30, 30, false);
716 fet_endchar;
717
718
719 %
720 % Black mensural semibrevis/minima/semiminima
721 %
722
723 fet_beginchar ("Black mensural semibrevis head", "s0blackmensural");
724         draw_diamond_head (staff_space#, 0.15, 0.30, 30, false);
725 fet_endchar;
726
727
728 %
729 % Petrucci semibrevis/minima/semiminima
730 %
731 % These values can be measured in several sources.
732 % I used "Modulis ex sacris literis delecti, Liber primus"
733 % Josquin Desprez, BNF
734
735 save petrucci_width, petrucci_height;
736 petrucci_height := 1.4 noteheight#;
737 petrucci_width := .72 petrucci_height;
738
739 fet_beginchar ("Petrucci semibrevis head", "s0petrucci");
740         draw_neomensural_open_head (petrucci_width, petrucci_height, 0);
741 fet_endchar;
742
743 fet_beginchar ("Petrucci minima head", "s1petrucci");
744         draw_neomensural_open_head (petrucci_width, petrucci_height, 0);
745 fet_endchar;
746
747 fet_beginchar ("Petrucci semiminima head", "s2petrucci");
748         draw_neomensural_black_head (petrucci_width, petrucci_height, 0);
749 fet_endchar;
750
751
752 %
753 % Black Petrucci semibrevis/minima/semiminima
754 %
755
756 fet_beginchar ("Petrucci colored semibrevis head", "s0blackpetrucci");
757         draw_neomensural_black_head (petrucci_width, petrucci_height, 0);
758 fet_endchar;
759
760 fet_beginchar ("Petrucci colored minima head", "s1blackpetrucci");
761         draw_neomensural_black_head (petrucci_width, petrucci_height, 0);
762 fet_endchar;
763
764 fet_beginchar ("Petrucci colored semiminima head", "s2blackpetrucci");
765         draw_neomensural_black_head (petrucci_width, petrucci_height, 0);
766 fet_endchar;
767
768
769 %%%%%%%%
770 %
771 %
772 %
773 % EDITIO VATICANA (including solesmes extensions)
774 %
775 %
776 %
777
778 def vat_punctum_char (expr verbose_name, internal_name,
779                            linea, cavum, straight, auctum,
780                            d_up, up_shift, down_shift, mag) =
781         fet_beginchar (verbose_name, "s" & internal_name);
782                 save a_b, b_h, a_w;
783
784                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
785                 b_h := 0.85;
786                 a_w := 1.09;
787
788                 save a, beta, ht, wd;
789
790                 ht# = noteheight# * mag;
791                 2 beta = ht# * b_h;
792                 a = beta * a_b;
793                 wd# = 2 a / a_w;
794                 black_notehead_width# := wd#;
795
796                 % direction
797                 save d_, d_sign;
798                 pair d_;
799
800                 if d_up:
801                         d_ := up;
802                         d_sign := 1;
803                 else:
804                         d_ := down;
805                         d_sign := -1;
806                 fi;
807
808                 % convexity and eccentricity
809                 save u_convexity, u_eccentricity;
810
811                 if straight:
812                         u_convexity# := -0.01 ht#;
813                         u_eccentricity# := 0.0 ht#; % dummy
814                 elseif auctum:
815                         u_convexity# := -0.03 ht#;
816                         u_eccentricity# := +0.25 ht#;
817                 else:
818                         u_convexity# := -0.05 ht#;
819                         u_eccentricity# := 0.0 ht#; % dummy
820                 fi;
821
822                 save convexity, eccentricity;
823
824                 convexity# := d_sign * u_convexity#;
825                 eccentricity# := d_sign * u_eccentricity#;
826
827                 % y shift offset
828                 save yoffs;
829
830                 if up_shift:
831                         yoffs# := 0.08 ht#;
832                 elseif down_shift:
833                         yoffs# := -0.11 ht#;
834                 else:
835                         yoffs# := 0.00 ht#;
836                 fi;
837
838                 define_pixels (convexity, eccentricity, yoffs, ht, wd);
839
840                 pickup pencircle scaled linethickness;
841
842                 save height, yoffs_bt, p, circle, circle_r;
843                 path p, circle, circle_r;
844
845                 height# = 0.47 ht#;
846                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
847
848                 define_pixels (height, yoffs_bt);
849
850                 circle := fullcircle scaled linethickness;
851
852                 x1 = x6;
853                 x2 = x5;
854                 x3 = x4;
855                 y1 + height = y6;
856                 y2 + height = y5;
857                 y3 + height = y4;
858
859                 save box_top, box_bt;
860
861                 if auctum:
862                         z1 = (0.00 wd + linethickness / 2, yoffs_bt);
863                         z2 = (0.21 wd, yoffs_bt + convexity);
864                         z3 = (0.42 wd - linethickness/ 2,
865                               yoffs_bt + eccentricity);
866                         box_top# = height# + yoffs_bt# +
867                                      max (0, convexity#, eccentricity#);
868                         box_bt# = yoffs_bt# +
869                                      min (0, convexity#, eccentricity#);
870                         p = z1
871                             .. {right}z2
872                             .. {d_}z3
873                             -- z4{-d_}
874                             .. z5{left}
875                             .. z6
876                             -- cycle;
877                 else:
878                         z1 = (0.00 wd + linethickness / 2, yoffs_bt);
879                         z2 = (0.21 wd, yoffs_bt + convexity);
880                         z3 = (0.42 wd - linethickness / 2, yoffs_bt);
881                         box_top# = height# + yoffs_bt# + max (0, convexity#);
882                         box_bt# = yoffs_bt# + min (0, convexity#);
883                         p = z1
884                             .. z2
885                             .. z3
886                             -- z4
887                             .. z5
888                             .. z6
889                             -- cycle;
890                 fi;
891
892                 labels (1, 2, 3, 4, 5, 6);
893
894                 save dirs;
895                 pair dirs[];
896
897                 dirs12 := direction (0 + epsilon) of p;
898                 dirs2 := direction 1 of p;
899                 dirs32 := direction (2 - epsilon) of p;
900                 dirs45 := direction (3 + epsilon) of p;
901                 dirs5 := direction 4 of p;
902                 dirs65 := direction (5 - epsilon) of p;
903
904                 fill get_subpath (circle, down, dirs12, z1)
905                      .. (bot z2){dirs2}
906                      .. get_subpath (circle, dirs32, up, z3)
907                      -- get_subpath (circle, up, dirs45, z4)
908                      .. (top z5){dirs5}
909                      .. get_subpath (circle, dirs65, down, z6)
910                      -- cycle;
911
912                 if cavum:
913                         save pat, t;
914                         path pat[];
915                         numeric t[];
916
917                         pat123 := ((directionpoint -dirs12 of circle)
918                                     shifted z1){dirs12}
919                                   .. (top z2){dirs2}
920                                   .. {dirs32}((directionpoint -dirs32 of circle)
921                                        shifted z3);
922                         pat34 := lft z3
923                                  -- lft z4;
924                         pat456 := ((directionpoint -dirs45 of circle)
925                                     shifted z4){dirs45}
926                                   .. (bot z5){dirs5}
927                                   .. {dirs65}((directionpoint -dirs65 of circle)
928                                        shifted z6);
929                         pat61 := rt z6
930                                  -- rt z1;
931
932                         t61 := ypart (pat61 intersectiontimes pat123);
933                         t12 := xpart (pat123 intersectiontimes pat34);
934                         t34 := ypart (pat34 intersectiontimes pat456);
935                         t45 := xpart (pat456 intersectiontimes pat61);
936
937                         unfill subpath (t61, t12) of pat123
938                                -- subpath (t34, t45) of pat456
939                                -- cycle;
940                 fi;
941
942                 set_char_box (0.00 wd#, 0.42 wd#,
943                               max (0, -box_bt#) + linethickness# / 2,
944                               max (0, box_top#) + linethickness# / 2);
945
946                 if linea:
947                         save linea_width, linea_height;
948
949                         linea_width# = 0.6 linethickness#;
950                         linea_height# = 0.7 ht#;
951
952                         define_pixels (linea_width, linea_height);
953
954                         pickup pencircle scaled 0.6 linethickness;
955
956                         draw_rounded_block ((-0.10 wd - linea_width / 2,
957                                              -linea_height / 2),
958                                             (-0.10 wd + linea_width / 2,
959                                              +linea_height / 2),
960                                             0.6 linethickness);
961                         draw_rounded_block ((+0.52 wd - linea_width / 2,
962                                              -linea_height / 2),
963                                             (+0.52 wd + linea_width / 2,
964                                              +linea_height / 2),
965                                             0.6 linethickness);
966
967                         set_char_box (0, 0.62 wd# + linea_width#,
968                                       linea_height# / 2,
969                                       linea_height# / 2);
970
971                         currentpicture := currentpicture
972                                 shifted (0.10 wd + linea_width / 2, 0);
973                 fi;
974         fet_endchar;
975 enddef;
976
977
978 def plica_char (expr verbose_name, internal_name,
979                      d_up, mag) =
980         fet_beginchar (verbose_name, "s" & internal_name);
981                 save a_b, b_h, a_w;
982
983                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
984                 b_h := 0.85;
985                 a_w := 1.09;
986
987                 save a, beta, ht, wd;
988
989                 ht# = noteheight# * mag;
990                 2 beta = ht# * b_h;
991                 a = beta * a_b;
992                 wd# = 2 a / a_w;
993                 black_notehead_width# := wd#;
994
995                 % direction
996                 save d_, d_sign;
997                 pair d_;
998
999                 if d_up:
1000                         d_ := up;
1001                         d_sign := 1;
1002                 else:
1003                         d_ := down;
1004                         d_sign := -1;
1005                 fi;
1006
1007                 % convexity and eccentricity
1008                 save convexity, eccentricity;
1009
1010                 convexity# := d_sign * -0.10 ht#;
1011                 eccentricity# := d_sign * -0.12 ht#;
1012
1013                 % y shift offset
1014                 save yoffs;
1015
1016                 yoffs# := -0.11 ht#;
1017
1018                 define_pixels (convexity, eccentricity, yoffs, ht, wd);
1019
1020                 pickup pencircle scaled linethickness;
1021
1022                 save height, yoffs_bt, p, circle, circle_r;
1023                 path p, circle, circle_r;
1024
1025                 height# = 0.47 ht#;
1026                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
1027
1028                 define_pixels (height, yoffs_bt);
1029
1030                 circle := fullcircle scaled linethickness;
1031
1032                 x1 = x6;
1033                 x2 = x5;
1034                 x3 = x4;
1035                 y1 + height = y6;
1036                 y2 + height = y5;
1037                 y3 + height = y4;
1038
1039                 save box_top, box_bt;
1040
1041                 z1 = (0.00 wd + linethickness / 2, yoffs_bt);
1042                 z2 = (0.21 wd, yoffs_bt + convexity);
1043                 z3 = (0.42 wd - linethickness/ 2, yoffs_bt + eccentricity);
1044                 box_top# = height# + yoffs_bt# +
1045                              max (0, convexity#, eccentricity#);
1046                 box_bt# = yoffs_bt# +
1047                              min (0, convexity#, eccentricity#);
1048                 p = z1
1049                     .. z2{right}
1050                     .. z3
1051                     -- z4
1052                     .. z5{left}
1053                     .. z6
1054                     -- cycle;
1055
1056                 labels (1, 2, 3, 4, 5, 6);
1057
1058                 save dirs;
1059                 pair dirs[];
1060
1061                 dirs12 := direction (0 + epsilon) of p;
1062                 dirs2 := direction 1 of p;
1063                 dirs32 := direction (2 - epsilon) of p;
1064                 dirs45 := direction (3 + epsilon) of p;
1065                 dirs5 := direction 4 of p;
1066                 dirs65 := direction (5 - epsilon) of p;
1067
1068                 fill get_subpath (circle, down, dirs12, z1)
1069                      .. (bot z2){dirs2}
1070                      .. get_subpath (circle, dirs32, up, z3)
1071                      -- get_subpath (circle, up, dirs45, z4)
1072                      .. (top z5){dirs5}
1073                      .. get_subpath (circle, dirs65, down, z6)
1074                      -- cycle;
1075
1076                 pickup pencircle scaled 0.6 linethickness;
1077
1078                 save stem_bt;
1079
1080                 set_char_box (0.00 wd#, 0.42 wd#,
1081                               max (0, -box_bt#) + linethickness# / 2,
1082                               max (0, box_top#) + linethickness# / 2);
1083
1084         fet_endchar;
1085 enddef;
1086
1087
1088 def epiphonus_char (expr verbose_name, internal_name,
1089                          left_stem, d_up, down_shift, mag) =
1090         fet_beginchar (verbose_name, "s" & internal_name);
1091                 save a_b, b_h, a_w;
1092
1093                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
1094                 b_h := 0.85;
1095                 a_w := 1.09;
1096
1097                 save a, beta, ht, wd;
1098
1099                 ht# = noteheight# * mag;
1100                 2 beta = ht# * b_h;
1101                 a = beta * a_b;
1102                 wd# = 2 a / a_w;
1103                 black_notehead_width# := wd#;
1104
1105                 % direction
1106                 save d_, d_sign;
1107                 pair d_;
1108
1109                 if d_up:
1110                         d_ := up;
1111                         d_sign := 1;
1112                 else:
1113                         d_ := down;
1114                         d_sign := -1;
1115                 fi;
1116
1117                 % convexity and eccentricity
1118                 save convexity;
1119
1120                 convexity# := d_sign * -0.05ht#;
1121
1122                 % y shift offset
1123                 save yoffs;
1124
1125                 if down_shift:
1126                         yoffs# := -0.11 ht#;
1127                 else:
1128                         yoffs# := 0.00 ht#;
1129                 fi;
1130
1131                 define_pixels (convexity, yoffs, ht, wd);
1132
1133                 pickup pencircle scaled linethickness;
1134
1135                 save height, yoffs_bt, p, circle, circle_r;
1136                 path p, circle, circle_r;
1137
1138                 height# = 0.47 ht#;
1139                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
1140
1141                 define_pixels (height, yoffs_bt);
1142
1143                 circle := fullcircle scaled linethickness;
1144
1145                 x1 = x6;
1146                 x2 = x5;
1147                 x3 = x4;
1148                 y1 + height = y6;
1149                 y2 + height = y5;
1150                 y3 + height = y4;
1151
1152                 save box_top, box_bt;
1153
1154                 z1 = (0.00 wd + linethickness / 2, yoffs_bt - 2.5 convexity);
1155                 z2 = (0.06 wd, yoffs_bt + 1.4 convexity);
1156                 z3 = (0.42 wd - linethickness / 2, yoffs_bt - 1.0 convexity);
1157                 box_top# = height# + yoffs_bt# +
1158                              max (-1.0 convexity#, 1.4 convexity#, 0);
1159                 box_bt# = yoffs_bt# +
1160                              min (-1.0 convexity#, 1.4 convexity#, 0);
1161                 p = z1{-d_}
1162                     .. {curl 1}z2{right}
1163                     .. z3
1164                     -- z4
1165                     .. {left}z5{curl 1}
1166                     .. {d_}z6
1167                     -- cycle;
1168
1169                 labels (1, 2, 3, 4, 5, 6);
1170
1171                 save dirs;
1172                 pair dirs[];
1173
1174                 dirs12 := direction (0 + epsilon) of p;
1175                 dirs21 := direction (1 - epsilon) of p;
1176                 dirs23 := direction (1 + epsilon) of p;
1177                 dirs32 := direction (2 - epsilon) of p;
1178                 dirs45 := direction (3 + epsilon) of p;
1179                 dirs54 := direction (4 - epsilon) of p;
1180                 dirs56 := direction (4 + epsilon) of p;
1181                 dirs65 := direction (5 - epsilon) of p;
1182
1183                 fill get_subpath (circle, down, dirs12, z1)
1184                      .. get_subpath (circle, dirs21, dirs23, z2)
1185                      .. get_subpath (circle, dirs32, up, z3)
1186                      -- get_subpath (circle, up, dirs45, z4)
1187                      .. get_subpath (circle, dirs54, dirs56, z5)
1188                      .. get_subpath (circle, dirs65, down, z6)
1189                      -- cycle;
1190
1191                 save stem_bt;
1192
1193                 if left_stem:
1194                         pickup pencircle scaled 0.6 linethickness;
1195
1196                         lft x11 = x1 - linethickness / 2;
1197                         bot y11 = yoffs - 1.1 ht - linethickness / 2;
1198                         x12 = x11;
1199                         y12 = y1;
1200
1201                         draw_rounded_block (bot lft z11, top rt z12,
1202                                             0.6 linethickness);
1203                         stem_bt# = yoffs# - 1.1 ht#;
1204
1205                         labels (11, 12);
1206                 else:
1207                         stem_bt# = 0;
1208                 fi;
1209
1210                 set_char_box (0.00 wd#, 0.42 wd#,
1211                               max (0, -box_bt#, -stem_bt#) + linethickness# / 2,
1212                               max (0, box_top#) + linethickness# / 2);
1213         fet_endchar;
1214 enddef;
1215
1216
1217 def inclinatum_char (expr verbose_name, internal_name,
1218                           small, stropha, auctum) =
1219         fet_beginchar (verbose_name, "s" & internal_name);
1220                 save ht, alpha;
1221
1222                 alpha := 35;
1223
1224                 if small:
1225                         ht# = 0.50 noteheight#;
1226                 else:
1227                         ht# = 0.80 noteheight#;
1228                 fi;
1229
1230                 draw_diamond_head (ht#, 0, 0, alpha, false);
1231
1232                 save off_angle;
1233
1234                 off_angle := alpha + 15;
1235
1236                 save stropha_ellipse, auctum_hook, circle;
1237                 path stropha_ellipse, auctum_hook, circle;
1238
1239                 circle := reverse fullcircle scaled linethickness;
1240
1241                 stropha_ellipse := fullcircle xscaled 0.25 head_height
1242                                               yscaled 0.55 head_height
1243                                               rotated alpha;
1244
1245                 z11 = z12
1246                       + linethickness / 2 * dir (180 - off_angle)
1247                       - directionpoint dir (90 - off_angle)
1248                           of stropha_ellipse;
1249                 z12 = directionpoint -dir (90 - off_angle) of diamond_shape +
1250                         linethickness / 2 * dir (180 - off_angle);
1251                 z13 = (0, -0.5 head_height + linethickness);
1252
1253                 auctum_hook := z12{-dir (90 - off_angle)}
1254                                .. {dir (90 + alpha)}z13;
1255
1256                 labels (12);
1257
1258                 if (stropha and not auctum):
1259                         clearit;
1260
1261                         save t_in, t_out;
1262
1263                         t_in := xpart ((stropha_ellipse shifted z11)
1264                                        intersectiontimes
1265                                        get_subpath (diamond_shape,
1266                                                     left, up,
1267                                                     (0, 0)));
1268                         t_out := xpart ((stropha_ellipse shifted z11)
1269                                         intersectiontimes
1270                                         get_subpath (diamond_shape,
1271                                                      up, right,
1272                                                      (0, 0)));
1273
1274                         % the addition or subtraction of `1' is necessary
1275                         % so that we get the right starting point
1276                         fill get_subpath_i (diamond_shape,
1277                                             dir (angle (z2 - z1) - 1),
1278                                             dir (angle (z1 - z4) + 1),
1279                                             (0, 0))
1280                              -- get_subpath (stropha_ellipse,
1281                                              direction t_in of stropha_ellipse,
1282                                              direction t_out of stropha_ellipse,
1283                                              z11)
1284                              -- cycle;
1285
1286                         labels (11);
1287                 fi;
1288
1289                 if (auctum and not stropha):
1290                         clearit;
1291
1292                         fill get_subpath (diamond_shape,
1293                                           left,
1294                                           -dir (90 - off_angle),
1295                                           (0, 0))
1296                              .. get_subpath (circle,
1297                                              dir (90 + alpha),
1298                                              -dir (90 + alpha),
1299                                              z13)
1300                              .. get_subpath (circle,
1301                                              dir (90 - off_angle),
1302                                              right,
1303                                              z12)
1304                              -- cycle;
1305
1306                         labels (13);
1307                 fi;
1308
1309                 if (auctum and stropha):
1310                         clearit;
1311
1312                         save t;
1313
1314                         t := xpart ((stropha_ellipse shifted z11)
1315                                     intersectiontimes
1316                                     get_subpath (diamond_shape, up, right,
1317                                                  (0, 0)));
1318
1319                         % the addition or subtraction of `1' is necessary
1320                         % so that we get the right starting point
1321                         fill get_subpath_i (diamond_shape,
1322                                             dir (angle (z2 - z1) - 1),
1323                                             -dir (90 - off_angle),
1324                                             (0, 0))
1325                              .. get_subpath (circle,
1326                                              dir (90 + alpha),
1327                                              -dir (90 + alpha),
1328                                              z13)
1329                              .. get_subpath (stropha_ellipse,
1330                                              dir (90 - off_angle),
1331                                              direction t of stropha_ellipse,
1332                                              z11)
1333                              -- cycle;
1334
1335                         labels (11, 13);
1336                 fi;
1337         fet_endchar;
1338 enddef;
1339
1340
1341 % punctum
1342 vat_punctum_char ("Ed. Vat. punctum", "vaticana.punctum",
1343                   false, false, false, false,
1344                   false, false, false, 1.0);
1345
1346
1347 % punctum cavum (for OpusTeX compatibility)
1348 vat_punctum_char ("Ed. Vat. punctum cavum", "vaticana.punctum.cavum",
1349                   false, true, false, false,
1350                   false, false, false, 1.0);
1351
1352
1353 % linea punctum (for OpusTeX compatibility)
1354 vat_punctum_char ("Ed. Vat. linea punctum", "vaticana.linea.punctum",
1355                   true, false, false, false,
1356                   false, false, false, 1.0);
1357
1358
1359 % linea punctum cavum (for OpusTeX compatibility)
1360 vat_punctum_char ("Ed. Vat. linea punctum cavum", "vaticana.linea.punctum.cavum",
1361                   true, true, false, false,
1362                   false, false, false, 1.0);
1363
1364
1365 % punctum inclinatum
1366 inclinatum_char ("Ed. Vat. inclinatum", "vaticana.inclinatum",
1367                  false, false, false);
1368
1369
1370 % pes lower punctum
1371 vat_punctum_char ("Ed. Vat. pes lower punctum", "vaticana.lpes",
1372                   false, false, true, false,
1373                   true, false, false, 1.0);
1374
1375
1376 % pes lower punctum
1377 vat_punctum_char ("Ed. Vat. pes var lower punctum", "vaticana.vlpes",
1378                   false, false, true, false,
1379                   true, false, true, 1.0);
1380
1381
1382 % pes upper punctum
1383 vat_punctum_char ("Ed. Vat. pes upper punctum", "vaticana.upes",
1384                   false, false, true, false,
1385                   false, false, false, 1.0);
1386
1387
1388 % pes upper punctum (shifted variation)
1389 %
1390 % This note head is used instead of the regular pes upper punctum to
1391 % avoid collision with the lower punctum note of the pes when the upper
1392 % punctum sits directly on top of the lower punctum.
1393 %
1394 vat_punctum_char ("Ed. Vat. var pes upper punctum", "vaticana.vupes",
1395                   false, false, true, false,
1396                   false, true, false, 1.0);
1397
1398
1399 % small punctum as used in epiphonus
1400 vat_punctum_char ("Ed. Vat. plica", "vaticana.plica",
1401                   false, false, false, false,
1402                   false, false, false, 0.6);
1403
1404
1405 % small punctum as used in epiphonus
1406 plica_char ("Ed. Vat. var plica", "vaticana.vplica",
1407             false, 0.6);
1408
1409
1410 % eccentric punctum as used in epiphonus
1411 epiphonus_char ("Ed. Vat. epiphonus", "vaticana.epiphonus",
1412                 false, true, false, 1.0);
1413
1414
1415 % eccentric punctum as used in epiphonus (shifted variation)
1416 %
1417 % This note head is used instead of the regular epiphonus punctum to
1418 % avoid collision with the plica head when the plica sits directly on
1419 % top of the lower head.
1420 %
1421 epiphonus_char ("Ed. Vat. var epiphonus", "vaticana.vepiphonus",
1422                 false, true, true, 1.0);
1423
1424
1425 % small punctum as used in cephalicus
1426 vat_punctum_char ("Ed. Vat. rev. plica", "vaticana.reverse.plica",
1427                   false, false, false, false,
1428                   true, false, false, 0.6);
1429
1430
1431 % small punctum as used in cephalicus
1432 plica_char ("Ed. Vat. rev. var plica", "vaticana.reverse.vplica",
1433             true, 0.6);
1434
1435
1436 % eccentric punctum as used in cephalicus; without left stem
1437 epiphonus_char ("Ed. Vat. inner cephalicus", "vaticana.inner.cephalicus",
1438                 false, false, false, 1.0);
1439
1440
1441 % eccentric punctum as used in cephalicus; with left stem
1442 epiphonus_char ("Ed. Vat. cephalicus", "vaticana.cephalicus",
1443                 true, false, false, 1.0);
1444
1445
1446 % quilisma
1447 fet_beginchar ("Ed. Vat. quilisma", "svaticana.quilisma");
1448         save a_b, b_h, a_w;
1449
1450         a_b := 1.54; % b_h * a_b / a_w = wd / ht
1451         b_h := 0.85;
1452         a_w := 1.09;
1453
1454         save a, beta, ht, wd;
1455
1456         ht# = noteheight#;
1457         2 beta = ht# * b_h;
1458         a = beta * a_b;
1459         wd# = 2 a / a_w;
1460
1461         set_char_box (0, 0.42 wd#, 0.28 ht#, 0.36 ht#);
1462
1463         black_notehead_width# := wd#;
1464
1465         define_pixels (ht, wd);
1466
1467         save ellipse, T;
1468         path ellipse;
1469         transform T;
1470
1471         T := identity xscaled linethickness
1472                       yscaled 0.44 ht;
1473         pickup pencircle transformed T;
1474         ellipse := reverse fullcircle transformed T;
1475
1476         z1 = (rt 0.00 wd, top -0.28 ht);
1477         z2 = (0.11 wd, -0.14 ht);
1478         z3 = (0.12 wd, +0.03 ht);
1479         z4 = (0.25 wd, -0.09 ht);
1480         z5 = (0.25 wd, +0.08 ht);
1481         z6 = (lft 0.42 wd, -0.04 ht);
1482         z7 = (lft 0.40 wd, bot +0.36 ht);
1483
1484         fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
1485              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
1486              -- cycle;
1487         fill get_subpath (ellipse, z3 - z4, z4 - z3, z3)
1488              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
1489              -- cycle;
1490         fill get_subpath (ellipse, z5 - z6, z6 - z5, z5)
1491              -- point 0 of get_subpath (ellipse, z6 - z5, z5 - z6, z6)
1492              -- get_subpath (ellipse, z7 - z6, z6 - z7, z7)
1493              -- get_subpath (ellipse, z6 - z7, z5 - z6, z6)
1494              -- cycle;
1495
1496         labels (1, 2, 3, 4, 5, 6, 7);
1497 fet_endchar;
1498
1499
1500 % solesmes punctum inclinatum parvum
1501 inclinatum_char ("Solesmes punctum inclinatum parvum", "solesmes.incl.parvum",
1502                  true, false, false);
1503
1504
1505 % solesmes punctum auctum ascendens
1506 vat_punctum_char ("Solesmes punctum auctum ascendens", "solesmes.auct.asc",
1507                   false, false, false, true,
1508                   true, false, false, 1.0);
1509
1510
1511 % solesmes punctum auctum descendens
1512 vat_punctum_char ("Solesmes punctum auctum descendens", "solesmes.auct.desc",
1513                   false, false, false, true,
1514                   false, false, false, 1.0);
1515
1516
1517 % solesmes punctum inclinatum auctum
1518 inclinatum_char ("Solesmes punctum incl. auctum", "solesmes.incl.auctum",
1519                  false, false, true);
1520
1521
1522 % solesmes stropha
1523 inclinatum_char ("Solesmes stropha", "solesmes.stropha",
1524                  false, true, false);
1525
1526
1527 % solesmes stropha aucta
1528 inclinatum_char ("Solesmes stropha aucta", "solesmes.stropha.aucta",
1529                  false, true, true);
1530
1531
1532 % solesmes oriscus
1533 fet_beginchar ("Solesmes oriscus", "ssolesmes.oriscus");
1534         save a_b, b_h, a_w;
1535
1536         a_b := 1.54; % b_h * a_b / a_w = wd / ht
1537         b_h := 0.85;
1538         a_w := 1.09;
1539
1540         save a, beta, ht, wd;
1541
1542         ht# = noteheight#;
1543         2 beta = ht# * b_h;
1544         a = beta * a_b;
1545         wd# = 2 a / a_w;
1546         black_notehead_width# := wd#;
1547
1548         save convexity;
1549
1550         convexity# = +0.05 ht#;
1551
1552         define_pixels (ht, wd, convexity);
1553
1554         set_char_box (0.00 wd#, 0.50 wd#,
1555                       0.25 ht# + convexity#, 0.25 ht# + convexity#);
1556
1557         z1 = (0.00 wd + blot_diameter / 2, -convexity);
1558         z2 = (1/6 wd, +convexity);
1559         z3 = (2/6 wd, -convexity);
1560         z4 = (0.50 wd - blot_diameter / 2, +convexity);
1561
1562
1563         save height;
1564
1565         height = 2 ypart (directionpoint right of (z1
1566                                                    .. z2
1567                                                    .. z3
1568                                                    .. z4));
1569
1570         save ellipse, T;
1571         path ellipse;
1572         transform T;
1573
1574         T := identity xscaled blot_diameter
1575                       yscaled (h + d - height);
1576         pickup pencircle transformed T;
1577         ellipse := fullcircle transformed T;
1578
1579         % Adjust vertical coordinates to touch bounding box.
1580         y1 := top -d;
1581         y4 := bot h;
1582
1583         save d_;
1584         pair d_;
1585
1586         d_ := direction 0 of (z1
1587                               .. z2
1588                               .. z3
1589                               .. z4);
1590
1591         fill get_subpath (ellipse, -d_, d_, z1)
1592              .. bot z2
1593              .. bot z3
1594              .. get_subpath (ellipse, d_, -d_, z4)
1595              .. top z3
1596              .. top z2
1597              .. cycle;
1598
1599         labels (1, 2, 3, 4);
1600 fet_endchar;
1601
1602
1603 %%%%%%%%
1604 %
1605 %
1606 %
1607 % EDITIO MEDICAEA
1608 %
1609 %
1610 %
1611
1612 % inclinatum
1613 fet_beginchar ("Ed. Med. inclinatum", "smedicaea.inclinatum");
1614         draw_diamond_head (1.2 staff_space#, 0, 0, 35, false);
1615 fet_endchar;
1616
1617
1618 def med_punctum_char (expr verbose_name, internal_name,
1619                            left_up_stem, left_down_stem) =
1620         fet_beginchar (verbose_name, "s" & internal_name);
1621                 save a, ht, wd;
1622
1623                 ht# = 2 staff_space#;
1624                 wd# = ht#;
1625                 black_notehead_width# := wd#;
1626
1627                 define_pixels (ht, wd);
1628
1629                 save ellipse;
1630                 path ellipse;
1631
1632                 ellipse := fullcircle xscaled blot_diameter
1633                                       yscaled 0.50 ht;
1634
1635                 z1 = (0.00 wd + blot_diameter / 2, 0);
1636                 z2 = (0.4 wd - blot_diameter / 2, 0);
1637
1638                 labels (1, 2);
1639
1640                 pickup pencircle scaled linethickness;
1641
1642                 if left_down_stem:
1643                         z4 = (0.00 wd + linethickness / 2, -1.25 ht);
1644
1645                         fill get_subpath (ellipse, left, down, z1)
1646                              -- top lft z4{down}
1647                              .. z4{right}
1648                              .. top rt z4{up}
1649                              -- (rt x4, -.5 ht / 2)
1650                              -- get_subpath (ellipse, right, left, z2)
1651                              -- cycle;
1652
1653                         labels (4);
1654
1655                         set_char_box (0.0, 0.4 wd#, 1.25 ht#, 0.25 ht#);
1656                 elseif left_up_stem:
1657                         z4 = (0.00 wd + linethickness / 2, +1.25 ht);
1658
1659                         fill get_subpath (ellipse, down, right, z1)
1660                              -- get_subpath (ellipse, right, left, z2)
1661                              -- (rt x4, .5 ht / 2)
1662                              -- bot rt z4{up}
1663                              .. z4{left}
1664                              .. bot lft z4{down}
1665                              -- cycle;
1666
1667                         labels (4);
1668
1669                         set_char_box (0.0, 0.4 wd#, 0.25 ht#, 1.25 ht#);
1670                 else:
1671                         fill get_subpath (ellipse, left, right, z1)
1672                              -- get_subpath (ellipse, right, left, z2)
1673                              -- cycle;
1674
1675                         set_char_box (0.0, 0.4 wd#, 0.25 ht#, 0.25 ht#);
1676                 fi;
1677
1678         fet_endchar;
1679 enddef;
1680
1681
1682 % punctum
1683 med_punctum_char ("Ed. Med. punctum", "medicaea.punctum",
1684                   false, false);
1685
1686
1687 % left up-stemmed punctum
1688 med_punctum_char ("Ed. Med. reverse virga", "medicaea.rvirga",
1689                   true, false);
1690
1691
1692 % virga (i.e. left down-stemmed punctum)
1693 med_punctum_char ("Ed. Med. virga", "medicaea.virga",
1694                   false, true);
1695
1696
1697 %%%%%%%%
1698 %
1699 %
1700 %
1701 % HUFNAGEL
1702 %
1703 %
1704 %
1705
1706 def huf_punctum_char (expr verbose_name, internal_name,
1707                            down_stem) =
1708         fet_beginchar (verbose_name, "s" & internal_name);
1709                 save alpha;
1710
1711                 alpha = 55;
1712
1713                 draw_diamond_head (staff_space#, 0, 0, alpha, false);
1714
1715                 if down_stem:
1716                         set_char_box (0, head_width#,
1717                                       1.5 staff_space#, head_height# / 2);
1718
1719                         save ellipse;
1720                         path ellipse;
1721
1722                         ellipse := reverse fullcircle xscaled blot_diameter
1723                                                       yscaled 0.7 staff_space
1724                                                       rotated -alpha;
1725
1726                         z11 = (head_width / 2, 0);
1727                         z12 = find_tangent_shift (((0, -d) -- (w, -d)), ellipse,
1728                                                   (w / 2, -d), (w / 2, 0));
1729
1730                         fill get_subpath (ellipse, up, down, z11)
1731                              -- get_subpath (ellipse, down, up, z12)
1732                              -- cycle;
1733
1734                         labels (11, 12);
1735                 fi;
1736         fet_endchar;
1737 enddef;
1738
1739
1740 % punctum
1741 huf_punctum_char ("Hufnagel punctum", "hufnagel.punctum", false)
1742
1743
1744 % virga
1745 huf_punctum_char ("Hufnagel virga", "hufnagel.virga", true)
1746
1747
1748 % pes lower punctum
1749 fet_beginchar ("Hufnagel pes lower punctum", "shufnagel.lpes")
1750         save width, height, alpha;
1751
1752         width# = 2 * staff_space#;
1753         height# = 0.7 * staff_space#;
1754         alpha = 35;
1755
1756         set_char_box (0, width#, height# / 2, height# / 2);
1757
1758         define_pixels (width, height);
1759
1760         save circle;
1761         path circle;
1762
1763         circle := reverse fullcircle scaled linethickness;
1764
1765         pickup pencircle scaled linethickness;
1766
1767         rt x3 = -lft x1 = width / 2;
1768         y2 = y3 = height / 2;
1769         y1 = y4 = -height / 2;
1770
1771         tand (alpha) * (y2 - y1) = x2 - x1 = x3 - x4;
1772
1773         fill get_subpath (circle, left, z2 - z1, z1)
1774              -- get_subpath (circle, z2 - z1, right, z2)
1775              -- get_subpath (circle, right, z4 - z3, z3)
1776              -- get_subpath (circle, z4 - z3, left, z4)
1777              -- cycle;
1778
1779         currentpicture := currentpicture shifted (width/2, 0);
1780
1781 %       labels (1, 2, 3, 4);
1782 fet_endchar;
1783
1784
1785 %%%%%%%%%%%%
1786 %%
1787 %% Noteheads for Medieval East-Slavic (Kievan) Notation
1788 %% Code by Aleksandr Andreev <aleksandr.andreev@gmail.com>
1789 %%
1790 %%%%%%%%%%%%
1791
1792
1793 fet_beginchar ("Kievan final note", "sM2kievan");
1794         % This draws the Final Note.
1795         % It is the last note of a piece of music
1796         % equivalent to having a whole note and fermata in CMN.
1797         % It always has an invariant representation.
1798
1799         vert_bar_thickness# := 2 * stafflinethickness#;
1800         vert_height# := 1.5 * staff_space#;
1801         blank_space# := 1.5 * stafflinethickness#;
1802         note_width#  := vert_height# - 2 * vert_bar_thickness#;
1803
1804         define_pixels (vert_height, blank_space, note_width);
1805         define_blacker_pixels (vert_bar_thickness);
1806
1807         path p;
1808         p := (0, blank_space)
1809              -- (0, staff_space - blank_space)
1810              -- (note_width + 0.5 vert_bar_thickness,
1811                  staff_space - blank_space)
1812              -- (note_width + 0.5 vert_bar_thickness, blank_space)
1813              -- cycle;
1814         fill p;
1815         fill p reflectedabout ((0, 0), (1, 0));
1816
1817         pickup pensquare xscaled vert_bar_thickness;
1818
1819         draw (note_width + 0.5 * vert_bar_thickness, vert_height)
1820              -- (note_width + 0.5 * vert_bar_thickness, -vert_height);
1821
1822         set_char_box (0, note_width# + vert_bar_thickness#,
1823                       vert_height#, vert_height#);
1824 fet_endchar;
1825
1826
1827 fet_beginchar ("Kievan recitative mark", "sM1kievan");
1828         inner_width# := 4 * staff_space#;
1829         vert_bar_thickness# := 2 * stafflinethickness#;
1830         vert_bar_height# := staff_space# - stafflinethickness#;
1831         blank_space# := 0.20 * vert_bar_height#;
1832
1833         define_pixels (inner_width, blank_space, vert_bar_height);
1834         define_blacker_pixels (vert_bar_thickness);
1835
1836         path p;
1837         p := (2.5 * vert_bar_thickness, blank_space)
1838              -- (2.5 * vert_bar_thickness, vert_bar_height - blank_space)
1839              -- (3.5 * vert_bar_thickness + inner_width,
1840                  vert_bar_height - blank_space)
1841              -- (3.5 * vert_bar_thickness + inner_width, blank_space)
1842              -- cycle;
1843         fill p;
1844         fill p reflectedabout ((0, 0), (1, 0));
1845
1846         % draw the four vertical lines
1847         pickup pensquare xscaled vert_bar_thickness;
1848         p := (0.5 * vert_bar_thickness, vert_bar_height)
1849              -- (0.5 * vert_bar_thickness, -vert_bar_height);
1850         draw p;
1851         draw p shifted (2 * vert_bar_thickness, 0);
1852         draw p shifted (3 * vert_bar_thickness + inner_width, 0);
1853         draw p shifted (5 * vert_bar_thickness + inner_width, 0);
1854
1855         set_char_box (0, 6 * vert_bar_thickness# + inner_width#,
1856                       vert_bar_height#, vert_bar_height#);
1857 fet_endchar;
1858
1859
1860 fet_beginchar ("Kievan whole note", "s0kievan");
1861         % the amount by which top and bottom diamond overlap
1862         overlap# := stafflinethickness#;
1863         height# := staff_space# - stafflinethickness#;
1864         width# := height# + overlap#;
1865
1866         define_pixels (overlap, height, width);
1867
1868         % parameters for superellipse are right, top, left, bottom
1869         fill superellipse ((width, 0.5 * (height + overlap)),
1870                            (width/2, height + overlap),
1871                            (0, 0.5 * (height + overlap)),
1872                            (width/2, -overlap),
1873                            0.51);
1874         fill superellipse ((width, -0.5 * (height + overlap)),
1875                            (width/2, overlap),
1876                            (0, -0.5 * (height + overlap)),
1877                            (width/2, -height - overlap),
1878                            0.51);
1879
1880         set_char_box (0, width#, height# + overlap#,
1881                       height# + overlap#);
1882 fet_endchar;
1883
1884
1885 fet_beginchar ("Kievan quarter note down", "d2kievan");
1886         z1 = (0.09 * staff_space, 0.33 * staff_space);
1887         z2 = (0.66 * staff_space, 0.37 * staff_space);
1888         z3 = (0.99 * staff_space, 0.36 * staff_space);
1889         z4 = (0.90 * staff_space, -1.05 * staff_space);
1890         z5 = (1.02 * staff_space, -2.19 * staff_space);
1891         z6 = (0.60 * staff_space, -2.49 * staff_space);
1892         z7 = (0.58 * staff_space, -1.91 * staff_space);
1893         z8 = (0.73 * staff_space, -0.35 * staff_space);
1894         z9 = (0.02 * staff_space, -0.39 * staff_space);
1895         z10 = (0, -0.24 * staff_space);
1896
1897         fill z1{dir 8.6}
1898              .. z2
1899              .. z3
1900              & z3
1901              .. z4
1902              .. z5
1903              -- z6
1904              .. z7
1905              .. z8
1906              & z8{left}
1907              .. z9
1908              & z9
1909              .. z10
1910              ... {dir 75}cycle;
1911
1912         set_char_box (0, 1.02 staff_space#,
1913                       2.50 staff_space#, 0.40 staff_space#);
1914 fet_endchar;
1915
1916
1917 fet_beginchar ("Kievan quarter note up", "u2kievan");
1918         z1 = (0.090 staff_space, -0.330 staff_space);
1919         z2 = (0.664 staff_space, -0.371 staff_space);
1920         z3 = (0.986 staff_space, -0.363 staff_space);
1921         z4 = (0.897 staff_space, 1.051 staff_space);
1922         z5 = (1.019 staff_space, 2.387 staff_space);
1923         z6 = (0.603 staff_space, 2.587 staff_space);
1924         z7 = (0.583 staff_space, 1.911 staff_space);
1925         z8 = (0.725 staff_space, 0.346 staff_space);
1926         z9 = (0.017 staff_space, 0.391 staff_space);
1927         z10 = (0, 0.240 staff_space);
1928
1929         fill z1{dir -6.9}
1930              .. z2
1931              .. z3
1932              & z3
1933              .. z4
1934              .. z5
1935              -- z6
1936              .. z7
1937              .. z8
1938              & z8{left}
1939              .. z9
1940              & z9
1941              .. z10
1942              ... {dir -76.9}cycle;
1943
1944         set_char_box (0, 1.02 staff_space#,
1945                       0.40 staff_space#, 2.6 staff_space#);
1946 fet_endchar;
1947
1948
1949 fet_beginchar ("Kievan half note (line position)", "s1kievan");
1950         % This draws the half note with a short tail up and a long tail down.
1951         % This version of the half note is used on any line of the staff.
1952
1953         z1 = (1.031 staff_space, 0.945 staff_space);
1954         z2 = (0.945 staff_space, -0.122 staff_space);
1955         z3 = (1.059 staff_space, -1.393 staff_space);
1956         z4 = (0.713 staff_space, -1.564 staff_space);
1957         z5 = (0.672 staff_space, -0.729 staff_space);
1958         z6 = (0.684 staff_space, -0.318 staff_space);
1959         z7 = (0.448 staff_space, -0.326 staff_space);
1960         z8 = (0, -0.281 staff_space);
1961         z9 = (0.086 staff_space, 0.350 staff_space);
1962         z10 = (0.746 staff_space, 0.277 staff_space);
1963         z11 = (0.909 staff_space, 0.921 staff_space);
1964
1965         fill z1
1966              .. z2{down}
1967              .. z3
1968              -- z4
1969              .. z5{up}
1970              .. z6
1971              & z6
1972              .. z7{left}
1973              .. z8
1974              -- z9
1975              .. {right}z10
1976              & z10{up}
1977              .. z11
1978              -- cycle;
1979
1980         set_char_box (0, 1.06 staff_space#,
1981                       1.6 staff_space#, 1.0 staff_space#);
1982 fet_endchar;
1983
1984
1985 fet_beginchar ("Kievan half note (space position)", "sr1kievan");
1986         % This draws the half note with a short tail down and a long tail up.
1987         % This version of the half note is used in any space of the staff.
1988
1989         z1 = (1.071 staff_space, 1.426 staff_space);
1990         z2 = (0.974 staff_space, 0.191 staff_space);
1991         z3 = (1.059 staff_space, -0.994 staff_space);
1992         z4 = (0.713 staff_space, -1.169 staff_space);
1993         z5 = (0.676 staff_space, -0.436 staff_space);
1994         z6 = (0.684 staff_space, -0.310 staff_space);
1995         z7 = (0.448 staff_space, -0.322 staff_space);
1996         z8 = (0, -0.277 staff_space);
1997         z9 = (0.0856 staff_space, 0.359 staff_space);
1998         z10 = (0.746 staff_space, 0.281 staff_space);
1999         z11 = (0.807 staff_space, 0.847 staff_space);
2000         z12 = (0.945 staff_space, 1.401 staff_space);
2001
2002         fill z1
2003              .. z2{down}
2004              .. z3
2005              -- z4
2006              .. z5{up}
2007              .. z6
2008              & z6
2009              .. z7{left}
2010              .. z8
2011              -- z9
2012              .. z10{right}
2013              & z10
2014              .. z11
2015              .. z12
2016              -- cycle;
2017
2018         set_char_box (0, 1.1 staff_space#,
2019                       1.0 staff_space#, 1.4 staff_space#);
2020 fet_endchar;
2021
2022
2023 fet_beginchar ("Kievan eighth note (down)", "d3kievan");
2024         % This draws the eighth note.
2025         % This form of the eight note occurs on the third line or higher
2026         % and sometimes between the second line and the third line.
2027
2028         z1 = (0.261 staff_space, 0.416 staff_space);
2029         z2 = (1.022 staff_space, 0.269 staff_space);
2030         z3 = (0.664 staff_space, -0.603 staff_space);
2031         z4 = (1.259 staff_space, -0.726 staff_space);
2032         z5 = (1.055 staff_space, -2.012 staff_space);
2033         z6 = (1.186 staff_space, -2.794 staff_space);
2034         z7 = (0.778 staff_space, -2.999 staff_space);
2035         z8 = (0.741 staff_space, -2.567 staff_space);
2036         z9 = (0.941 staff_space, -1.467 staff_space);
2037         z10 = (0.33 staff_space, -1.340 staff_space);
2038         z11 = (0.631 staff_space, -0.448 staff_space);
2039         z12 = (0, -0.334 staff_space);
2040
2041         fill z1{right}
2042              .. z2
2043              -- z3{right}
2044              .. z4
2045              & z4
2046              .. z5{down}
2047              .. z6
2048              -- z7
2049              .. z8{up}
2050              .. z9
2051              & z9
2052              .. {left}z10
2053              & z10{dir 78.7}
2054              .. z11
2055              & z11
2056              .. {left}z12
2057              & z12{dir 78.7}
2058              .. {dir 62}cycle;
2059
2060         set_char_box (0, 1.25 staff_space#,
2061                       3.0 staff_space#, 0.5 staff_space#);
2062 fet_endchar;
2063
2064
2065 fet_beginchar ("Kievan eighth note (up)", "u3kievan");
2066         % This draws the flagged eighth note.
2067         % This version of the eighth note occurs on the second line or lower.
2068
2069         % first, draw the upside down quarter note
2070         z1 = (0.090 staff_space, -0.33 staff_space);
2071         z2 = (0.664 staff_space, -0.371 staff_space);
2072         z3 = (0.986 staff_space, -0.363 staff_space);
2073         z4 = (0.896 staff_space, 1.051 staff_space);
2074         z5 = (1.019 staff_space, 2.387 staff_space);
2075         z6 = (0.603 staff_space, 2.587 staff_space);
2076         z7 = (0.583 staff_space, 1.911 staff_space);
2077         z8 = (0.725 staff_space, 0.346 staff_space);
2078         z9 = (0.016 staff_space, 0.391 staff_space);
2079         z10 = (0, 0.240 staff_space);
2080
2081         fill z1{dir -6.9}
2082              .. z2
2083              .. z3
2084              & z3
2085              .. z4
2086              .. z5
2087              -- z6
2088              .. z7
2089              .. z8
2090              & z8{left}
2091              .. z9
2092              & z9
2093              .. z10
2094              ... {dir -76.9}cycle;
2095
2096         % now, draw the stem
2097         z11 = (0.033 staff_space, 2.823 staff_space);
2098         z12 = (0.391 staff_space, 2.648 staff_space);
2099         z13 = (0.354 staff_space, 2.290 staff_space);
2100         z14 = (0.676 staff_space, 1.076 staff_space);
2101         z15 = (0.693 staff_space, 0.88 staff_space);
2102         z16 = (0.208 staff_space, 1.699 staff_space);
2103         z17 = (0.024 staff_space, 2.616 staff_space);
2104
2105         fill z11
2106              -- z12
2107              .. z13{down}
2108              .. z14
2109              -- z15
2110              .. z16
2111              .. z17{up}
2112              .. cycle;
2113
2114         set_char_box (0, 1.0 staff_space#,
2115                       0.4 staff_space#, 2.9 staff_space#);
2116 fet_endchar;
2117
2118 fet_endgroup ("noteheads");