]> git.donarmstrong.com Git - lilypond.git/blob - mf/parmesan-noteheads.mf
12fd9322f7936a03d82c4a2970a76426888fc281
[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--2012 Juergen Reuter <reuter@ipd.uka.de>
5 %
6 % Neo-mensural heads originally by
7 % Christian Mondrup and Mats Bengtsson
8 %
9 % LilyPond 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.
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) =
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)
201              -- (z2 + nw_dist)
202              .. top z2
203              .. (z2 + ne_dist)
204              -- (z3 + ne_dist)
205              .. rt z3
206              .. (z3 - nw_dist)
207              -- (z4 - nw_dist)
208              .. bot z4
209              .. (z4 - ne_dist)
210              -- (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)=
218         draw_neomensural_black_head (width, height);
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);
321 fet_endchar;
322
323 fet_beginchar ("Neo-mensural minima head", "s1neomensural");
324         draw_neomensural_open_head (nm_width, nm_height);
325 fet_endchar;
326
327 fet_beginchar ("Neo-mensural semiminima head", "s2neomensural");
328         draw_neomensural_black_head (nm_width, nm_height);
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#);
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#);
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 fet_beginchar ("Mensural maxima notehead (up)", "uM3mensural");
477         draw_mensural_longa (m_maxima_width, m_holeheight, true, true, 1, false);
478 fet_endchar;
479
480 fet_beginchar ("Mensural maxima notehead (down)", "dM3mensural");
481         draw_mensural_longa (m_maxima_width, m_holeheight, true, true, -1, false);
482 fet_endchar;
483
484 fet_beginchar ("Mensural maxima notehead (ligature)", "sM3ligmensural");
485         draw_mensural_brevis (m_maxima_width, m_holeheight, true, true);
486 fet_endchar;
487
488 fet_beginchar ("Mensural longa notehead (up)", "uM2mensural");
489         draw_mensural_longa (m_longa_width, m_holeheight, true, true, 1, false);
490 fet_endchar;
491
492 fet_beginchar ("Mensural longa notehead (down)", "dM2mensural");
493         draw_mensural_longa (m_longa_width, m_holeheight, true, true, -1, false);
494 fet_endchar;
495
496 fet_beginchar ("Mensural longa notehead (ligature)", "sM2ligmensural");
497         draw_mensural_longa (m_longa_width, m_holeheight, true, true, -1, true);
498 fet_endchar;
499
500 fet_beginchar ("Mensural brevis notehead", "sM1mensural");
501         draw_mensural_brevis (m_brevis_width, m_holeheight, true, true);
502 fet_endchar;
503
504 fet_beginchar ("Mensural maxima notehead (up, reduced hole)", "urM3mensural");
505         draw_mensural_longa (m_maxima_width, m_red_holeheight, true, true, 1, false);
506 fet_endchar;
507
508 fet_beginchar ("Mensural maxima notehead (down, reduced hole)", "drM3mensural");
509         draw_mensural_longa (m_maxima_width, m_red_holeheight, true, true, -1, false);
510 fet_endchar;
511
512 fet_beginchar ("Mensural maxima notehead (ligature, reduced hole)", "srM3ligmensural");
513         draw_mensural_brevis (m_maxima_width, m_red_holeheight, true, true);
514 fet_endchar;
515
516 fet_beginchar ("Mensural longa notehead (up, reduced hole)", "urM2mensural");
517         draw_mensural_longa (m_longa_width, m_red_holeheight, true, true, 1, false);
518 fet_endchar;
519
520 fet_beginchar ("Mensural longa notehead (down, reduced hole)", "drM2mensural");
521         draw_mensural_longa (m_longa_width, m_red_holeheight, true, true, -1, false);
522 fet_endchar;
523
524 fet_beginchar ("Mensural longa notehead (ligature, reduced hole)", "srM2ligmensural");
525         draw_mensural_longa (m_longa_width, m_red_holeheight, true, true, -1, true);
526 fet_endchar;
527
528 fet_beginchar ("Mensural brevis notehead (reduced hole)", "srM1mensural");
529         draw_mensural_brevis (m_brevis_width, m_red_holeheight, true, true);
530 fet_endchar;
531
532
533 %
534 % Semi-colored mensural/Petrucci maxima/longa/brevis
535 %
536
537 fet_beginchar ("Semi-colored mensural maxima notehead (up)", "uM3semimensural");
538         draw_mensural_longa (m_maxima_width, m_holeheight, true, false, 1, false);
539 fet_endchar;
540
541 fet_beginchar ("Semi-colored mensural maxima notehead (down)", "dM3semimensural");
542         draw_mensural_longa (m_maxima_width, m_holeheight, true, false, -1, false);
543 fet_endchar;
544
545 fet_beginchar ("Semi-colored mensural maxima notehead (ligature)", "sM3semiligmensural");
546         draw_mensural_brevis (m_maxima_width, m_holeheight, true, false);
547 fet_endchar;
548
549 fet_beginchar ("Semi-colored mensural longa notehead (up)", "uM2semimensural");
550         draw_mensural_longa (m_longa_width, m_holeheight, true, false, 1, false);
551 fet_endchar;
552
553 fet_beginchar ("Semi-colored mensural longa notehead (down)", "dM2semimensural");
554         draw_mensural_longa (m_longa_width, m_holeheight, true, false, -1, false);
555 fet_endchar;
556
557 fet_beginchar ("Semi-colored mensural longa notehead (ligature)", "sM2semiligmensural");
558         draw_mensural_longa (m_longa_width, m_holeheight, true, false, -1, true);
559 fet_endchar;
560
561 fet_beginchar ("Semi-colored mensural brevis notehead", "sM1semimensural");
562         draw_mensural_brevis (m_brevis_width, m_holeheight, true, false);
563 fet_endchar;
564
565 fet_beginchar ("Semi-colored mensural maxima notehead (up, reduced hole)", "urM3semimensural");
566         draw_mensural_longa (m_maxima_width, m_red_holeheight, true, false, 1, false);
567 fet_endchar;
568
569 fet_beginchar ("Semi-colored mensural maxima notehead (down, reduced hole)", "drM3semimensural");
570         draw_mensural_longa (m_maxima_width, m_red_holeheight, true, false, -1, false);
571 fet_endchar;
572
573 fet_beginchar ("Semi-colored mensural maxima notehead (ligature, reduced hole)", "srM3semiligmensural");
574         draw_mensural_brevis (m_maxima_width, m_red_holeheight, true, false);
575 fet_endchar;
576
577 fet_beginchar ("Semi-colored mensural longa notehead (up, reduced hole)", "urM2semimensural");
578         draw_mensural_longa (m_longa_width, m_red_holeheight, true, false, 1, false);
579 fet_endchar;
580
581 fet_beginchar ("Semi-colored mensural longa notehead (down, reduced hole)", "drM2semimensural");
582         draw_mensural_longa (m_longa_width, m_red_holeheight, true, false, -1, false);
583 fet_endchar;
584
585 fet_beginchar ("Semi-colored mensural longa notehead (ligature, reduced hole)", "srM2semiligmensural");
586         draw_mensural_longa (m_longa_width, m_red_holeheight, true, false, -1, true);
587 fet_endchar;
588
589 fet_beginchar ("Semi-colored mensural brevis notehead (reduced hole)", "srM1semimensural");
590         draw_mensural_brevis (m_brevis_width, m_red_holeheight, true, false);
591 fet_endchar;
592
593
594 %
595 % Black mensural/Petrucci maxima/longa/brevis
596 %
597
598 fet_beginchar ("Black mensural maxima notehead (up)", "uM3blackmensural");
599         draw_mensural_longa (m_maxima_width, 0, false, false, 1, false);
600 fet_endchar;
601
602 fet_beginchar ("Black mensural maxima notehead (down)", "dM3blackmensural");
603         draw_mensural_longa (m_maxima_width, 0, false, false, -1, false);
604 fet_endchar;
605
606 fet_beginchar ("Black mensural maxima notehead (ligature)", "sM3blackligmensural");
607         draw_mensural_brevis (m_maxima_width, 0, false, false);
608 fet_endchar;
609
610 fet_beginchar ("Black mensural longa notehead (up)", "uM2blackmensural");
611         draw_mensural_longa (m_longa_width, 0, false, false, 1, false);
612 fet_endchar;
613
614 fet_beginchar ("Black mensural longa notehead (down)", "dM2blackmensural");
615         draw_mensural_longa (m_longa_width, 0, false, false, -1, false);
616 fet_endchar;
617
618 fet_beginchar ("Black mensural longa notehead (ligature)", "sM2blackligmensural");
619         draw_mensural_longa (m_longa_width, 0, false, false, -1, true);
620 fet_endchar;
621
622 fet_beginchar ("Black mensural brevis notehead", "sM1blackmensural");
623         draw_mensural_brevis (m_brevis_width, 0, false, false);
624 fet_endchar;
625
626
627 %
628 % Mensural semibrevis/minima/semiminima
629 %
630
631 fet_beginchar ("Mensural semibrevis head", "s0mensural");
632         draw_diamond_head (staff_space#, 0.15, 0.30, 30, true);
633 fet_endchar;
634
635 fet_beginchar ("Mensural minima head", "s1mensural");
636         draw_diamond_head (staff_space#, 0.15, 0.30, 30, true);
637 fet_endchar;
638
639 fet_beginchar ("Mensural semiminima head", "s2mensural");
640         draw_diamond_head (staff_space#, 0.15, 0.30, 30, false);
641 fet_endchar;
642
643
644 %
645 % Black mensural semibrevis/minima/semiminima
646 %
647
648 fet_beginchar ("Black mensural semibrevis head", "s0blackmensural");
649         draw_diamond_head (staff_space#, 0.15, 0.30, 30, false);
650 fet_endchar;
651
652
653 %
654 % Petrucci semibrevis/minima/semiminima
655 %
656 % These values can be measured in several sources.
657 % I used "Modulis ex sacris literis delecti, Liber primus"
658 % Josquin Desprez, BNF
659
660 save petrucci_width, petrucci_height;
661 petrucci_height := 1.4 noteheight#;
662 petrucci_width := .72 petrucci_height;
663
664 fet_beginchar ("Petrucci semibrevis head", "s0petrucci");
665         draw_neomensural_open_head (petrucci_width, petrucci_height);
666 fet_endchar;
667
668 fet_beginchar ("Petrucci minima head", "s1petrucci");
669         draw_neomensural_open_head (petrucci_width, petrucci_height);
670 fet_endchar;
671
672 fet_beginchar ("Petrucci semiminima head", "s2petrucci");
673         draw_neomensural_black_head (petrucci_width, petrucci_height);
674 fet_endchar;
675
676
677 %
678 % Black Petrucci semibrevis/minima/semiminima
679 %
680
681 fet_beginchar ("Petrucci colored semibrevis head", "s0blackpetrucci");
682         draw_neomensural_black_head (petrucci_width, petrucci_height);
683 fet_endchar;
684
685 fet_beginchar ("Petrucci colored minima head", "s1blackpetrucci");
686         draw_neomensural_black_head (petrucci_width, petrucci_height);
687 fet_endchar;
688
689 fet_beginchar ("Petrucci colored semiminima head", "s2blackpetrucci");
690         draw_neomensural_black_head (petrucci_width, petrucci_height);
691 fet_endchar;
692
693
694 %%%%%%%%
695 %
696 %
697 %
698 % EDITIO VATICANA (including solesmes extensions)
699 %
700 %
701 %
702
703 def vat_punctum_char (expr verbose_name, internal_name,
704                            linea, cavum, straight, auctum,
705                            d_up, up_shift, down_shift, mag) =
706         fet_beginchar (verbose_name, "s" & internal_name);
707                 save a_b, b_h, a_w;
708
709                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
710                 b_h := 0.85;
711                 a_w := 1.09;
712
713                 save a, beta, ht, wd;
714
715                 ht# = noteheight# * mag;
716                 2 beta = ht# * b_h;
717                 a = beta * a_b;
718                 wd# = 2 a / a_w;
719                 black_notehead_width# := wd#;
720
721                 % direction
722                 save d_, d_sign;
723                 pair d_;
724
725                 if d_up:
726                         d_ := up;
727                         d_sign := 1;
728                 else:
729                         d_ := down;
730                         d_sign := -1;
731                 fi;
732
733                 % convexity and eccentricity
734                 save u_convexity, u_eccentricity;
735
736                 if straight:
737                         u_convexity# := -0.01 ht#;
738                         u_eccentricity# := 0.0 ht#; % dummy
739                 elseif auctum:
740                         u_convexity# := -0.03 ht#;
741                         u_eccentricity# := +0.25 ht#;
742                 else:
743                         u_convexity# := -0.05 ht#;
744                         u_eccentricity# := 0.0 ht#; % dummy
745                 fi;
746
747                 save convexity, eccentricity;
748
749                 convexity# := d_sign * u_convexity#;
750                 eccentricity# := d_sign * u_eccentricity#;
751
752                 % y shift offset
753                 save yoffs;
754
755                 if up_shift:
756                         yoffs# := 0.08 ht#;
757                 elseif down_shift:
758                         yoffs# := -0.11 ht#;
759                 else:
760                         yoffs# := 0.00 ht#;
761                 fi;
762
763                 define_pixels (convexity, eccentricity, yoffs, ht, wd);
764
765                 pickup pencircle scaled linethickness;
766
767                 save height, yoffs_bt, p, circle, circle_r;
768                 path p, circle, circle_r;
769
770                 height# = 0.47 ht#;
771                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
772
773                 define_pixels (height, yoffs_bt);
774
775                 circle := fullcircle scaled linethickness;
776
777                 x1 = x6;
778                 x2 = x5;
779                 x3 = x4;
780                 y1 + height = y6;
781                 y2 + height = y5;
782                 y3 + height = y4;
783
784                 save box_top, box_bt;
785
786                 if auctum:
787                         z1 = (0.00 wd + linethickness / 2, yoffs_bt);
788                         z2 = (0.21 wd, yoffs_bt + convexity);
789                         z3 = (0.42 wd - linethickness/ 2,
790                               yoffs_bt + eccentricity);
791                         box_top# = height# + yoffs_bt# +
792                                      max (0, convexity#, eccentricity#);
793                         box_bt# = yoffs_bt# +
794                                      min (0, convexity#, eccentricity#);
795                         p = z1
796                             .. {right}z2
797                             .. {d_}z3
798                             -- z4{-d_}
799                             .. z5{left}
800                             .. z6
801                             -- cycle;
802                 else:
803                         z1 = (0.00 wd + linethickness / 2, yoffs_bt);
804                         z2 = (0.21 wd, yoffs_bt + convexity);
805                         z3 = (0.42 wd - linethickness / 2, yoffs_bt);
806                         box_top# = height# + yoffs_bt# + max (0, convexity#);
807                         box_bt# = yoffs_bt# + min (0, convexity#);
808                         p = z1
809                             .. z2
810                             .. z3
811                             -- z4
812                             .. z5
813                             .. z6
814                             -- cycle;
815                 fi;
816
817                 labels (1, 2, 3, 4, 5, 6);
818
819                 save dirs;
820                 pair dirs[];
821
822                 dirs12 := direction (0 + epsilon) of p;
823                 dirs2 := direction 1 of p;
824                 dirs32 := direction (2 - epsilon) of p;
825                 dirs45 := direction (3 + epsilon) of p;
826                 dirs5 := direction 4 of p;
827                 dirs65 := direction (5 - epsilon) of p;
828
829                 fill get_subpath (circle, down, dirs12, z1)
830                      .. (bot z2){dirs2}
831                      .. get_subpath (circle, dirs32, up, z3)
832                      -- get_subpath (circle, up, dirs45, z4)
833                      .. (top z5){dirs5}
834                      .. get_subpath (circle, dirs65, down, z6)
835                      -- cycle;
836
837                 if cavum:
838                         save pat, t;
839                         path pat[];
840                         numeric t[];
841
842                         pat123 := ((directionpoint -dirs12 of circle)
843                                     shifted z1){dirs12}
844                                   .. (top z2){dirs2}
845                                   .. {dirs32}((directionpoint -dirs32 of circle)
846                                        shifted z3);
847                         pat34 := lft z3
848                                  -- lft z4;
849                         pat456 := ((directionpoint -dirs45 of circle)
850                                     shifted z4){dirs45}
851                                   .. (bot z5){dirs5}
852                                   .. {dirs65}((directionpoint -dirs65 of circle)
853                                        shifted z6);
854                         pat61 := rt z6
855                                  -- rt z1;
856
857                         t61 := ypart (pat61 intersectiontimes pat123);
858                         t12 := xpart (pat123 intersectiontimes pat34);
859                         t34 := ypart (pat34 intersectiontimes pat456);
860                         t45 := xpart (pat456 intersectiontimes pat61);
861
862                         unfill subpath (t61, t12) of pat123
863                                -- subpath (t34, t45) of pat456
864                                -- cycle;
865                 fi;
866
867                 set_char_box (0.00 wd#, 0.42 wd#,
868                               max (0, -box_bt#) + linethickness# / 2,
869                               max (0, box_top#) + linethickness# / 2);
870
871                 if linea:
872                         save linea_width, linea_height;
873
874                         linea_width# = 0.6 linethickness#;
875                         linea_height# = 0.7 ht#;
876
877                         define_pixels (linea_width, linea_height);
878
879                         pickup pencircle scaled 0.6 linethickness;
880
881                         draw_rounded_block ((-0.10 wd - linea_width / 2,
882                                              -linea_height / 2),
883                                             (-0.10 wd + linea_width / 2,
884                                              +linea_height / 2),
885                                             0.6 linethickness);
886                         draw_rounded_block ((+0.52 wd - linea_width / 2,
887                                              -linea_height / 2),
888                                             (+0.52 wd + linea_width / 2,
889                                              +linea_height / 2),
890                                             0.6 linethickness);
891
892                         set_char_box (0, 0.62 wd# + linea_width#,
893                                       linea_height# / 2,
894                                       linea_height# / 2);
895
896                         currentpicture := currentpicture
897                                 shifted (0.10 wd + linea_width / 2, 0);
898                 fi;
899         fet_endchar;
900 enddef;
901
902
903 def plica_char (expr verbose_name, internal_name,
904                      d_up, mag) =
905         fet_beginchar (verbose_name, "s" & internal_name);
906                 save a_b, b_h, a_w;
907
908                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
909                 b_h := 0.85;
910                 a_w := 1.09;
911
912                 save a, beta, ht, wd;
913
914                 ht# = noteheight# * mag;
915                 2 beta = ht# * b_h;
916                 a = beta * a_b;
917                 wd# = 2 a / a_w;
918                 black_notehead_width# := wd#;
919
920                 % direction
921                 save d_, d_sign;
922                 pair d_;
923
924                 if d_up:
925                         d_ := up;
926                         d_sign := 1;
927                 else:
928                         d_ := down;
929                         d_sign := -1;
930                 fi;
931
932                 % convexity and eccentricity
933                 save convexity, eccentricity;
934
935                 convexity# := d_sign * -0.10 ht#;
936                 eccentricity# := d_sign * -0.12 ht#;
937
938                 % y shift offset
939                 save yoffs;
940
941                 yoffs# := -0.11 ht#;
942
943                 define_pixels (convexity, eccentricity, yoffs, ht, wd);
944
945                 pickup pencircle scaled linethickness;
946
947                 save height, yoffs_bt, p, circle, circle_r;
948                 path p, circle, circle_r;
949
950                 height# = 0.47 ht#;
951                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
952
953                 define_pixels (height, yoffs_bt);
954
955                 circle := fullcircle scaled linethickness;
956
957                 x1 = x6;
958                 x2 = x5;
959                 x3 = x4;
960                 y1 + height = y6;
961                 y2 + height = y5;
962                 y3 + height = y4;
963
964                 save box_top, box_bt;
965
966                 z1 = (0.00 wd + linethickness / 2, yoffs_bt);
967                 z2 = (0.21 wd, yoffs_bt + convexity);
968                 z3 = (0.42 wd - linethickness/ 2, yoffs_bt + eccentricity);
969                 box_top# = height# + yoffs_bt# +
970                              max (0, convexity#, eccentricity#);
971                 box_bt# = yoffs_bt# +
972                              min (0, convexity#, eccentricity#);
973                 p = z1
974                     .. z2{right}
975                     .. z3
976                     -- z4
977                     .. z5{left}
978                     .. z6
979                     -- cycle;
980
981                 labels (1, 2, 3, 4, 5, 6);
982
983                 save dirs;
984                 pair dirs[];
985
986                 dirs12 := direction (0 + epsilon) of p;
987                 dirs2 := direction 1 of p;
988                 dirs32 := direction (2 - epsilon) of p;
989                 dirs45 := direction (3 + epsilon) of p;
990                 dirs5 := direction 4 of p;
991                 dirs65 := direction (5 - epsilon) of p;
992
993                 fill get_subpath (circle, down, dirs12, z1)
994                      .. (bot z2){dirs2}
995                      .. get_subpath (circle, dirs32, up, z3)
996                      -- get_subpath (circle, up, dirs45, z4)
997                      .. (top z5){dirs5}
998                      .. get_subpath (circle, dirs65, down, z6)
999                      -- cycle;
1000
1001                 pickup pencircle scaled 0.6 linethickness;
1002
1003                 save stem_bt;
1004
1005                 set_char_box (0.00 wd#, 0.42 wd#,
1006                               max (0, -box_bt#) + linethickness# / 2,
1007                               max (0, box_top#) + linethickness# / 2);
1008
1009         fet_endchar;
1010 enddef;
1011
1012
1013 def epiphonus_char (expr verbose_name, internal_name,
1014                          left_stem, d_up, down_shift, mag) =
1015         fet_beginchar (verbose_name, "s" & internal_name);
1016                 save a_b, b_h, a_w;
1017
1018                 a_b := 1.54; % b_h * a_b / a_w = wd / ht
1019                 b_h := 0.85;
1020                 a_w := 1.09;
1021
1022                 save a, beta, ht, wd;
1023
1024                 ht# = noteheight# * mag;
1025                 2 beta = ht# * b_h;
1026                 a = beta * a_b;
1027                 wd# = 2 a / a_w;
1028                 black_notehead_width# := wd#;
1029
1030                 % direction
1031                 save d_, d_sign;
1032                 pair d_;
1033
1034                 if d_up:
1035                         d_ := up;
1036                         d_sign := 1;
1037                 else:
1038                         d_ := down;
1039                         d_sign := -1;
1040                 fi;
1041
1042                 % convexity and eccentricity
1043                 save convexity;
1044
1045                 convexity# := d_sign * -0.05ht#;
1046
1047                 % y shift offset
1048                 save yoffs;
1049
1050                 if down_shift:
1051                         yoffs# := -0.11 ht#;
1052                 else:
1053                         yoffs# := 0.00 ht#;
1054                 fi;
1055
1056                 define_pixels (convexity, yoffs, ht, wd);
1057
1058                 pickup pencircle scaled linethickness;
1059
1060                 save height, yoffs_bt, p, circle, circle_r;
1061                 path p, circle, circle_r;
1062
1063                 height# = 0.47 ht#;
1064                 yoffs_bt# = yoffs# - 0.5 height# - 0.25 convexity#;
1065
1066                 define_pixels (height, yoffs_bt);
1067
1068                 circle := fullcircle scaled linethickness;
1069
1070                 x1 = x6;
1071                 x2 = x5;
1072                 x3 = x4;
1073                 y1 + height = y6;
1074                 y2 + height = y5;
1075                 y3 + height = y4;
1076
1077                 save box_top, box_bt;
1078
1079                 z1 = (0.00 wd + linethickness / 2, yoffs_bt - 2.5 convexity);
1080                 z2 = (0.06 wd, yoffs_bt + 1.4 convexity);
1081                 z3 = (0.42 wd - linethickness / 2, yoffs_bt - 1.0 convexity);
1082                 box_top# = height# + yoffs_bt# +
1083                              max (-1.0 convexity#, 1.4 convexity#, 0);
1084                 box_bt# = yoffs_bt# +
1085                              min (-1.0 convexity#, 1.4 convexity#, 0);
1086                 p = z1{-d_}
1087                     .. {curl 1}z2{right}
1088                     .. z3
1089                     -- z4
1090                     .. {left}z5{curl 1}
1091                     .. {d_}z6
1092                     -- cycle;
1093
1094                 labels (1, 2, 3, 4, 5, 6);
1095
1096                 save dirs;
1097                 pair dirs[];
1098
1099                 dirs12 := direction (0 + epsilon) of p;
1100                 dirs21 := direction (1 - epsilon) of p;
1101                 dirs23 := direction (1 + epsilon) of p;
1102                 dirs32 := direction (2 - epsilon) of p;
1103                 dirs45 := direction (3 + epsilon) of p;
1104                 dirs54 := direction (4 - epsilon) of p;
1105                 dirs56 := direction (4 + epsilon) of p;
1106                 dirs65 := direction (5 - epsilon) of p;
1107
1108                 fill get_subpath (circle, down, dirs12, z1)
1109                      .. get_subpath (circle, dirs21, dirs23, z2)
1110                      .. get_subpath (circle, dirs32, up, z3)
1111                      -- get_subpath (circle, up, dirs45, z4)
1112                      .. get_subpath (circle, dirs54, dirs56, z5)
1113                      .. get_subpath (circle, dirs65, down, z6)
1114                      -- cycle;
1115
1116                 save stem_bt;
1117
1118                 if left_stem:
1119                         pickup pencircle scaled 0.6 linethickness;
1120
1121                         lft x11 = x1 - linethickness / 2;
1122                         bot y11 = yoffs - 1.1 ht - linethickness / 2;
1123                         x12 = x11;
1124                         y12 = y1;
1125
1126                         draw_rounded_block (bot lft z11, top rt z12,
1127                                             0.6 linethickness);
1128                         stem_bt# = yoffs# - 1.1 ht#;
1129
1130                         labels (11, 12);
1131                 else:
1132                         stem_bt# = 0;
1133                 fi;
1134
1135                 set_char_box (0.00 wd#, 0.42 wd#,
1136                               max (0, -box_bt#, -stem_bt#) + linethickness# / 2,
1137                               max (0, box_top#) + linethickness# / 2);
1138         fet_endchar;
1139 enddef;
1140
1141
1142 def inclinatum_char (expr verbose_name, internal_name,
1143                           small, stropha, auctum) =
1144         fet_beginchar (verbose_name, "s" & internal_name);
1145                 save ht, alpha;
1146
1147                 alpha := 35;
1148
1149                 if small:
1150                         ht# = 0.50 noteheight#;
1151                 else:
1152                         ht# = 0.80 noteheight#;
1153                 fi;
1154
1155                 draw_diamond_head (ht#, 0, 0, alpha, false);
1156
1157                 save off_angle;
1158
1159                 off_angle := alpha + 15;
1160
1161                 save stropha_ellipse, auctum_hook, circle;
1162                 path stropha_ellipse, auctum_hook, circle;
1163
1164                 circle := reverse fullcircle scaled linethickness;
1165
1166                 stropha_ellipse := fullcircle xscaled 0.25 head_height
1167                                               yscaled 0.55 head_height
1168                                               rotated alpha;
1169
1170                 z11 = z12
1171                       + linethickness / 2 * dir (180 - off_angle)
1172                       - directionpoint dir (90 - off_angle)
1173                           of stropha_ellipse;
1174                 z12 = directionpoint -dir (90 - off_angle) of diamond_shape +
1175                         linethickness / 2 * dir (180 - off_angle);
1176                 z13 = (0, -0.5 head_height + linethickness);
1177
1178                 auctum_hook := z12{-dir (90 - off_angle)}
1179                                .. {dir (90 + alpha)}z13;
1180
1181                 labels (12);
1182
1183                 if (stropha and not auctum):
1184                         clearit;
1185
1186                         save t_in, t_out;
1187
1188                         t_in := xpart ((stropha_ellipse shifted z11)
1189                                        intersectiontimes
1190                                        get_subpath (diamond_shape,
1191                                                     left, up,
1192                                                     (0, 0)));
1193                         t_out := xpart ((stropha_ellipse shifted z11)
1194                                         intersectiontimes
1195                                         get_subpath (diamond_shape,
1196                                                      up, right,
1197                                                      (0, 0)));
1198
1199                         % the addition or subtraction of `1' is necessary
1200                         % so that we get the right starting point
1201                         fill get_subpath_i (diamond_shape,
1202                                             dir (angle (z2 - z1) - 1),
1203                                             dir (angle (z1 - z4) + 1),
1204                                             (0, 0))
1205                              -- get_subpath (stropha_ellipse,
1206                                              direction t_in of stropha_ellipse,
1207                                              direction t_out of stropha_ellipse,
1208                                              z11)
1209                              -- cycle;
1210
1211                         labels (11);
1212                 fi;
1213
1214                 if (auctum and not stropha):
1215                         clearit;
1216
1217                         fill get_subpath (diamond_shape,
1218                                           left,
1219                                           -dir (90 - off_angle),
1220                                           (0, 0))
1221                              .. get_subpath (circle,
1222                                              dir (90 + alpha),
1223                                              -dir (90 + alpha),
1224                                              z13)
1225                              .. get_subpath (circle,
1226                                              dir (90 - off_angle),
1227                                              right,
1228                                              z12)
1229                              -- cycle;
1230
1231                         labels (13);
1232                 fi;
1233
1234                 if (auctum and stropha):
1235                         clearit;
1236
1237                         save t;
1238
1239                         t := xpart ((stropha_ellipse shifted z11)
1240                                     intersectiontimes
1241                                     get_subpath (diamond_shape, up, right,
1242                                                  (0, 0)));
1243
1244                         % the addition or subtraction of `1' is necessary
1245                         % so that we get the right starting point
1246                         fill get_subpath_i (diamond_shape,
1247                                             dir (angle (z2 - z1) - 1),
1248                                             -dir (90 - off_angle),
1249                                             (0, 0))
1250                              .. get_subpath (circle,
1251                                              dir (90 + alpha),
1252                                              -dir (90 + alpha),
1253                                              z13)
1254                              .. get_subpath (stropha_ellipse,
1255                                              dir (90 - off_angle),
1256                                              direction t of stropha_ellipse,
1257                                              z11)
1258                              -- cycle;
1259
1260                         labels (11, 13);
1261                 fi;
1262         fet_endchar;
1263 enddef;
1264
1265
1266 % punctum
1267 vat_punctum_char ("Ed. Vat. punctum", "vaticana.punctum",
1268                   false, false, false, false,
1269                   false, false, false, 1.0);
1270
1271
1272 % punctum cavum (for OpusTeX compatibility)
1273 vat_punctum_char ("Ed. Vat. punctum cavum", "vaticana.punctum.cavum",
1274                   false, true, false, false,
1275                   false, false, false, 1.0);
1276
1277
1278 % linea punctum (for OpusTeX compatibility)
1279 vat_punctum_char ("Ed. Vat. linea punctum", "vaticana.linea.punctum",
1280                   true, false, false, false,
1281                   false, false, false, 1.0);
1282
1283
1284 % linea punctum cavum (for OpusTeX compatibility)
1285 vat_punctum_char ("Ed. Vat. linea punctum cavum", "vaticana.linea.punctum.cavum",
1286                   true, true, false, false,
1287                   false, false, false, 1.0);
1288
1289
1290 % punctum inclinatum
1291 inclinatum_char ("Ed. Vat. inclinatum", "vaticana.inclinatum",
1292                  false, false, false);
1293
1294
1295 % pes lower punctum
1296 vat_punctum_char ("Ed. Vat. pes lower punctum", "vaticana.lpes",
1297                   false, false, true, false,
1298                   true, false, false, 1.0);
1299
1300
1301 % pes lower punctum
1302 vat_punctum_char ("Ed. Vat. pes var lower punctum", "vaticana.vlpes",
1303                   false, false, true, false,
1304                   true, false, true, 1.0);
1305
1306
1307 % pes upper punctum
1308 vat_punctum_char ("Ed. Vat. pes upper punctum", "vaticana.upes",
1309                   false, false, true, false,
1310                   false, false, false, 1.0);
1311
1312
1313 % pes upper punctum (shifted variation)
1314 %
1315 % This note head is used instead of the regular pes upper punctum to
1316 % avoid collision with the lower punctum note of the pes when the upper
1317 % punctum sits directly on top of the lower punctum.
1318 %
1319 vat_punctum_char ("Ed. Vat. var pes upper punctum", "vaticana.vupes",
1320                   false, false, true, false,
1321                   false, true, false, 1.0);
1322
1323
1324 % small punctum as used in epiphonus
1325 vat_punctum_char ("Ed. Vat. plica", "vaticana.plica",
1326                   false, false, false, false,
1327                   false, false, false, 0.6);
1328
1329
1330 % small punctum as used in epiphonus
1331 plica_char ("Ed. Vat. var plica", "vaticana.vplica",
1332             false, 0.6);
1333
1334
1335 % eccentric punctum as used in epiphonus
1336 epiphonus_char ("Ed. Vat. epiphonus", "vaticana.epiphonus",
1337                 false, true, false, 1.0);
1338
1339
1340 % eccentric punctum as used in epiphonus (shifted variation)
1341 %
1342 % This note head is used instead of the regular epiphonus punctum to
1343 % avoid collision with the plica head when the plica sits directly on
1344 % top of the lower head.
1345 %
1346 epiphonus_char ("Ed. Vat. var epiphonus", "vaticana.vepiphonus",
1347                 false, true, true, 1.0);
1348
1349
1350 % small punctum as used in cephalicus
1351 vat_punctum_char ("Ed. Vat. rev. plica", "vaticana.reverse.plica",
1352                   false, false, false, false,
1353                   true, false, false, 0.6);
1354
1355
1356 % small punctum as used in cephalicus
1357 plica_char ("Ed. Vat. rev. var plica", "vaticana.reverse.vplica",
1358             true, 0.6);
1359
1360
1361 % eccentric punctum as used in cephalicus; without left stem
1362 epiphonus_char ("Ed. Vat. inner cephalicus", "vaticana.inner.cephalicus",
1363                 false, false, false, 1.0);
1364
1365
1366 % eccentric punctum as used in cephalicus; with left stem
1367 epiphonus_char ("Ed. Vat. cephalicus", "vaticana.cephalicus",
1368                 true, false, false, 1.0);
1369
1370
1371 % quilisma
1372 fet_beginchar ("Ed. Vat. quilisma", "svaticana.quilisma");
1373         save a_b, b_h, a_w;
1374
1375         a_b := 1.54; % b_h * a_b / a_w = wd / ht
1376         b_h := 0.85;
1377         a_w := 1.09;
1378
1379         save a, beta, ht, wd;
1380
1381         ht# = noteheight#;
1382         2 beta = ht# * b_h;
1383         a = beta * a_b;
1384         wd# = 2 a / a_w;
1385
1386         set_char_box (0, 0.42 wd#, 0.28 ht#, 0.36 ht#);
1387
1388         black_notehead_width# := wd#;
1389
1390         define_pixels (ht, wd);
1391
1392         save ellipse, T;
1393         path ellipse;
1394         transform T;
1395
1396         T := identity xscaled linethickness
1397                       yscaled 0.44 ht;
1398         pickup pencircle transformed T;
1399         ellipse := reverse fullcircle transformed T;
1400
1401         z1 = (rt 0.00 wd, top -0.28 ht);
1402         z2 = (0.11 wd, -0.14 ht);
1403         z3 = (0.12 wd, +0.03 ht);
1404         z4 = (0.25 wd, -0.09 ht);
1405         z5 = (0.25 wd, +0.08 ht);
1406         z6 = (lft 0.42 wd, -0.04 ht);
1407         z7 = (lft 0.40 wd, bot +0.36 ht);
1408
1409         fill get_subpath (ellipse, z1 - z2, z2 - z1, z1)
1410              -- get_subpath (ellipse, z2 - z1, z1 - z2, z2)
1411              -- cycle;
1412         fill get_subpath (ellipse, z3 - z4, z4 - z3, z3)
1413              -- get_subpath (ellipse, z4 - z3, z3 - z4, z4)
1414              -- cycle;
1415         fill get_subpath (ellipse, z5 - z6, z6 - z5, z5)
1416              -- point 0 of get_subpath (ellipse, z6 - z5, z5 - z6, z6)
1417              -- get_subpath (ellipse, z7 - z6, z6 - z7, z7)
1418              -- get_subpath (ellipse, z6 - z7, z5 - z6, z6)
1419              -- cycle;
1420
1421         labels (1, 2, 3, 4, 5, 6, 7);
1422 fet_endchar;
1423
1424
1425 % solesmes punctum inclinatum parvum
1426 inclinatum_char ("Solesmes punctum inclinatum parvum", "solesmes.incl.parvum",
1427                  true, false, false);
1428
1429
1430 % solesmes punctum auctum ascendens
1431 vat_punctum_char ("Solesmes punctum auctum ascendens", "solesmes.auct.asc",
1432                   false, false, false, true,
1433                   true, false, false, 1.0);
1434
1435
1436 % solesmes punctum auctum descendens
1437 vat_punctum_char ("Solesmes punctum auctum descendens", "solesmes.auct.desc",
1438                   false, false, false, true,
1439                   false, false, false, 1.0);
1440
1441
1442 % solesmes punctum inclinatum auctum
1443 inclinatum_char ("Solesmes punctum incl. auctum", "solesmes.incl.auctum",
1444                  false, false, true);
1445
1446
1447 % solesmes stropha
1448 inclinatum_char ("Solesmes stropha", "solesmes.stropha",
1449                  false, true, false);
1450
1451
1452 % solesmes stropha aucta
1453 inclinatum_char ("Solesmes stropha aucta", "solesmes.stropha.aucta",
1454                  false, true, true);
1455
1456
1457 % solesmes oriscus
1458 fet_beginchar ("Solesmes oriscus", "ssolesmes.oriscus");
1459         save a_b, b_h, a_w;
1460
1461         a_b := 1.54; % b_h * a_b / a_w = wd / ht
1462         b_h := 0.85;
1463         a_w := 1.09;
1464
1465         save a, beta, ht, wd;
1466
1467         ht# = noteheight#;
1468         2 beta = ht# * b_h;
1469         a = beta * a_b;
1470         wd# = 2 a / a_w;
1471         black_notehead_width# := wd#;
1472
1473         save convexity;
1474
1475         convexity# = +0.05 ht#;
1476
1477         define_pixels (ht, wd, convexity);
1478
1479         set_char_box (0.00 wd#, 0.50 wd#,
1480                       0.25 ht# + convexity#, 0.25 ht# + convexity#);
1481
1482         z1 = (0.00 wd + blot_diameter / 2, -convexity);
1483         z2 = (1/6 wd, +convexity);
1484         z3 = (2/6 wd, -convexity);
1485         z4 = (0.50 wd - blot_diameter / 2, +convexity);
1486
1487
1488         save height;
1489
1490         height = 2 ypart (directionpoint right of (z1
1491                                                    .. z2
1492                                                    .. z3
1493                                                    .. z4));
1494
1495         save ellipse, T;
1496         path ellipse;
1497         transform T;
1498
1499         T := identity xscaled blot_diameter
1500                       yscaled (h + d - height);
1501         pickup pencircle transformed T;
1502         ellipse := fullcircle transformed T;
1503
1504         % Adjust vertical coordinates to touch bounding box.
1505         y1 := top -d;
1506         y4 := bot h;
1507
1508         save d_;
1509         pair d_;
1510
1511         d_ := direction 0 of (z1
1512                               .. z2
1513                               .. z3
1514                               .. z4);
1515
1516         fill get_subpath (ellipse, -d_, d_, z1)
1517              .. bot z2
1518              .. bot z3
1519              .. get_subpath (ellipse, d_, -d_, z4)
1520              .. top z3
1521              .. top z2
1522              .. cycle;
1523
1524         labels (1, 2, 3, 4);
1525 fet_endchar;
1526
1527
1528 %%%%%%%%
1529 %
1530 %
1531 %
1532 % EDITIO MEDICAEA
1533 %
1534 %
1535 %
1536
1537 % inclinatum
1538 fet_beginchar ("Ed. Med. inclinatum", "smedicaea.inclinatum");
1539         draw_diamond_head (1.2 staff_space#, 0, 0, 35, false);
1540 fet_endchar;
1541
1542
1543 def med_punctum_char (expr verbose_name, internal_name,
1544                            left_up_stem, left_down_stem) =
1545         fet_beginchar (verbose_name, "s" & internal_name);
1546                 save a, ht, wd;
1547
1548                 ht# = 2 staff_space#;
1549                 wd# = ht#;
1550                 black_notehead_width# := wd#;
1551
1552                 define_pixels (ht, wd);
1553
1554                 save ellipse;
1555                 path ellipse;
1556
1557                 ellipse := fullcircle xscaled blot_diameter
1558                                       yscaled 0.50 ht;
1559
1560                 z1 = (0.00 wd + blot_diameter / 2, 0);
1561                 z2 = (0.4 wd - blot_diameter / 2, 0);
1562
1563                 labels (1, 2);
1564
1565                 pickup pencircle scaled linethickness;
1566
1567                 if left_down_stem:
1568                         z4 = (0.00 wd + linethickness / 2, -1.25 ht);
1569
1570                         fill get_subpath (ellipse, left, down, z1)
1571                              -- top lft z4{down}
1572                              .. z4{right}
1573                              .. top rt z4{up}
1574                              -- (rt x4, -.5 ht / 2)
1575                              -- get_subpath (ellipse, right, left, z2)
1576                              -- cycle;
1577
1578                         labels (4);
1579
1580                         set_char_box (0.0, 0.4 wd#, 1.25 ht#, 0.25 ht#);
1581                 elseif left_up_stem:
1582                         z4 = (0.00 wd + linethickness / 2, +1.25 ht);
1583
1584                         fill get_subpath (ellipse, down, right, z1)
1585                              -- get_subpath (ellipse, right, left, z2)
1586                              -- (rt x4, .5 ht / 2)
1587                              -- bot rt z4{up}
1588                              .. z4{left}
1589                              .. bot lft z4{down}
1590                              -- cycle;
1591
1592                         labels (4);
1593
1594                         set_char_box (0.0, 0.4 wd#, 0.25 ht#, 1.25 ht#);
1595                 else:
1596                         fill get_subpath (ellipse, left, right, z1)
1597                              -- get_subpath (ellipse, right, left, z2)
1598                              -- cycle;
1599
1600                         set_char_box (0.0, 0.4 wd#, 0.25 ht#, 0.25 ht#);
1601                 fi;
1602
1603         fet_endchar;
1604 enddef;
1605
1606
1607 % punctum
1608 med_punctum_char ("Ed. Med. punctum", "medicaea.punctum",
1609                   false, false);
1610
1611
1612 % left up-stemmed punctum
1613 med_punctum_char ("Ed. Med. reverse virga", "medicaea.rvirga",
1614                   true, false);
1615
1616
1617 % virga (i.e. left down-stemmed punctum)
1618 med_punctum_char ("Ed. Med. virga", "medicaea.virga",
1619                   false, true);
1620
1621
1622 %%%%%%%%
1623 %
1624 %
1625 %
1626 % HUFNAGEL
1627 %
1628 %
1629 %
1630
1631 def huf_punctum_char (expr verbose_name, internal_name,
1632                            down_stem) =
1633         fet_beginchar (verbose_name, "s" & internal_name);
1634                 save alpha;
1635
1636                 alpha = 55;
1637
1638                 draw_diamond_head (staff_space#, 0, 0, alpha, false);
1639
1640                 if down_stem:
1641                         set_char_box (0, head_width#,
1642                                       1.5 staff_space#, head_height# / 2);
1643
1644                         save ellipse;
1645                         path ellipse;
1646
1647                         ellipse := reverse fullcircle xscaled blot_diameter
1648                                                       yscaled 0.7 staff_space
1649                                                       rotated -alpha;
1650
1651                         z11 = (head_width / 2, 0);
1652                         z12 = find_tangent_shift (((0, -d) -- (w, -d)), ellipse,
1653                                                   (w / 2, -d), (w / 2, 0));
1654
1655                         fill get_subpath (ellipse, up, down, z11)
1656                              -- get_subpath (ellipse, down, up, z12)
1657                              -- cycle;
1658
1659                         labels (11, 12);
1660                 fi;
1661         fet_endchar;
1662 enddef;
1663
1664
1665 % punctum
1666 huf_punctum_char ("Hufnagel punctum", "hufnagel.punctum", false)
1667
1668
1669 % virga
1670 huf_punctum_char ("Hufnagel virga", "hufnagel.virga", true)
1671
1672
1673 % pes lower punctum
1674 fet_beginchar ("Hufnagel pes lower punctum", "shufnagel.lpes")
1675         save width, height, alpha;
1676
1677         width# = 2 * staff_space#;
1678         height# = 0.7 * staff_space#;
1679         alpha = 35;
1680
1681         set_char_box (0, width#, height# / 2, height# / 2);
1682
1683         define_pixels (width, height);
1684
1685         save circle;
1686         path circle;
1687
1688         circle := reverse fullcircle scaled linethickness;
1689
1690         pickup pencircle scaled linethickness;
1691
1692         rt x3 = -lft x1 = width / 2;
1693         y2 = y3 = height / 2;
1694         y1 = y4 = -height / 2;
1695
1696         tand (alpha) * (y2 - y1) = x2 - x1 = x3 - x4;
1697
1698         fill get_subpath (circle, left, z2 - z1, z1)
1699              -- get_subpath (circle, z2 - z1, right, z2)
1700              -- get_subpath (circle, right, z4 - z3, z3)
1701              -- get_subpath (circle, z4 - z3, left, z4)
1702              -- cycle;
1703
1704         currentpicture := currentpicture shifted (width/2, 0);
1705
1706 %       labels (1, 2, 3, 4);
1707 fet_endchar;
1708
1709 %%%%%%%%%%%%
1710 %%
1711 %% Noteheads for Medieval East-Slavic (Kievan) Notation
1712 %% Code by Aleksandr Andreev <aleksandr.andreev@gmail.com>
1713 %%
1714 %%%%%%%%%%%%
1715
1716 fet_beginchar ("kievan final note", "sM2kievan");
1717         % this draws the Final Note
1718         % the final note is the last note of a piece of music
1719         % equivalent to having a whole note and fermata in CMN
1720         % it always has an invariant representation
1721         vert_bar_thickness# := 2 * stafflinethickness#;
1722         vert_height# := 1.5 * staff_space#;
1723         blank_space# := 1.5 * stafflinethickness#;
1724         note_width#  := vert_height# - 2 * vert_bar_thickness#;
1725         define_pixels(vert_height, blank_space, note_width);
1726         define_blacker_pixels (vert_bar_thickness);
1727
1728         path p;
1729         p := (0, blank_space) --
1730              (0, staff_space - blank_space) --
1731              (note_width, staff_space - blank_space) --
1732              (note_width, blank_space) --
1733               cycle;
1734         fill p;
1735         fill p reflectedabout ((0, 0), (1, 0));
1736         pickup pensquare xscaled vert_bar_thickness;
1737         draw (note_width + 0.5 * vert_bar_thickness, vert_height) --
1738              (note_width + 0.5 * vert_bar_thickness, -vert_height);
1739
1740         set_char_box (0, note_width# + vert_bar_thickness#,
1741                       vert_height#, vert_height#);
1742 fet_endchar;
1743
1744 fet_beginchar ("kievan recitative mark", "sM1kievan");
1745         inner_width# := 4 * staff_space#;
1746         vert_bar_thickness# := 2 * stafflinethickness#;
1747         vert_bar_height# := staff_space# - stafflinethickness#;
1748         blank_space# := 0.20 * vert_bar_height#;
1749         define_pixels(inner_width, blank_space, vert_bar_height);
1750         define_blacker_pixels (vert_bar_thickness);
1751
1752         path p;
1753         p := (3 * vert_bar_thickness, blank_space) --
1754              (3 * vert_bar_thickness, vert_bar_height - blank_space) --
1755              (3 * vert_bar_thickness + inner_width, vert_bar_height - blank_space) --
1756              (3 * vert_bar_thickness + inner_width, blank_space) --
1757               cycle;
1758         fill p;
1759         fill p reflectedabout ((0, 0), (1, 0));
1760
1761         % draw the four vertical lines
1762         pickup pensquare xscaled vert_bar_thickness;
1763         p := (0.5 * vert_bar_thickness, vert_bar_height) --
1764              (0.5 * vert_bar_thickness, -vert_bar_height);
1765         draw p;
1766         draw p shifted (2 * vert_bar_thickness, 0);
1767         draw p shifted (3 * vert_bar_thickness + inner_width, 0);
1768         draw p shifted (5 * vert_bar_thickness + inner_width, 0);
1769
1770         set_char_box (0, 6 * vert_bar_thickness# + inner_width#,
1771                       vert_bar_height#, vert_bar_height#);
1772 fet_endchar;
1773
1774 fet_beginchar ("Kievan whole note", "s0kievan");
1775         % the amount by which top and bottom diamond overlap
1776         overlap# := stafflinethickness#;
1777         height# := staff_space# - stafflinethickness#;
1778         width# := height# + overlap#;
1779         define_pixels(overlap, height, width);
1780
1781         % pars for superellipse are right, top, left, bottom
1782         fill superellipse((width, 0.5 * (height + overlap)),
1783                           (width/2, height + overlap),
1784                           (0, 0.5 * (height + overlap)),
1785                           (width/2, -overlap),
1786                            0.51);
1787         fill superellipse((width, -0.5 * (height + overlap)),
1788                           (width/2, overlap),
1789                           (0, -0.5 * (height + overlap)),
1790                           (width/2, -height - overlap),
1791                            0.51);
1792         set_char_box (0, width#, height# + overlap#,
1793                       height# + overlap#);
1794 fet_endchar;
1795
1796 fet_beginchar ("Kievan quarter note down", "d2kievan");
1797         z1 = (0.09 * staff_space, 0.33 * staff_space);
1798         z2 = (0.66 * staff_space, 0.37 * staff_space);
1799         z3 = (0.99 * staff_space, 0.36 * staff_space);
1800         z4 = (0.90 * staff_space, -1.05 * staff_space);
1801         z5 = (1.02 * staff_space, -2.19 * staff_space);
1802         z6 = (0.60 * staff_space, -2.49 * staff_space);
1803         z7 = (0.58 * staff_space, -1.91 * staff_space);
1804         z8 = (0.73 * staff_space, -0.35 * staff_space);
1805         z9 = (0.02 * staff_space, -0.39 * staff_space);
1806         z10 = (0, -0.24 * staff_space);
1807         fill z1{dir 8.6} .. z2 .. z3
1808              & z3 .. z4 .. z5
1809              & z5 -- z6
1810              & z6 .. z7 .. z8
1811              & z8{left} .. z9
1812              & z9 .. z10 ... {dir 75}cycle;
1813         set_char_box (0, 1.02 staff_space#, 2.50 staff_space#, 0.40 staff_space#);
1814 fet_endchar;
1815
1816 fet_beginchar ("Kievan quarter note up", "u2kievan");
1817         z1 = (0.090 staff_space, -0.330 staff_space);
1818         z2 = (0.664 staff_space, -0.371 staff_space);
1819         z3 = (0.986 staff_space, -0.363 staff_space);
1820         z4 = (0.897 staff_space, 1.051 staff_space);
1821         z5 = (1.019 staff_space, 2.387 staff_space);
1822         z6 = (0.603 staff_space, 2.587 staff_space);
1823         z7 = (0.583 staff_space, 1.911 staff_space);
1824         z8 = (0.725 staff_space, 0.346 staff_space);
1825         z9 = (0.017 staff_space, 0.391 staff_space);
1826         z10 = (0, 0.240 staff_space);
1827         fill z1{dir -6.9} .. z2 .. z3
1828              & z3 .. z4 .. z5
1829              & z5 -- z6
1830              & z6 .. z7 .. z8
1831              & z8{left} .. z9
1832              & z9 .. z10 ... {dir -76.9}cycle;
1833         set_char_box (0, 1.02 staff_space#, 0.40 staff_space#, 2.6 staff_space#);
1834 fet_endchar;
1835
1836 fet_beginchar ("kievan half note (line position)", "s1kievan");
1837         % this draws the half note with a short tail up and a long tail down
1838         % this version of the half note is used on any line of the staff
1839         z1 = (1.031 staff_space, 0.945 staff_space);
1840         z2 = (0.945 staff_space, -0.122 staff_space);
1841         z3 = (1.059 staff_space, -1.393 staff_space);
1842         z4 = (0.713 staff_space, -1.564 staff_space);
1843         z5 = (0.672 staff_space, -0.729 staff_space);
1844         z6 = (0.684 staff_space, -0.318 staff_space);
1845         z7 = (0.448 staff_space, -0.326 staff_space);
1846         z8 = (0, -0.281 staff_space);
1847         z9 = (0.086 staff_space, 0.350 staff_space);
1848         z10 = (0.746 staff_space, 0.277 staff_space);
1849         z11 = (0.909 staff_space, 0.921 staff_space);
1850         fill z1 .. z2{down} .. z3
1851              & z3 -- z4
1852              & z4 .. z5{up} .. z6
1853              & z6 .. z7{left} .. z8
1854              & z8 -- z9
1855              & z9 .. {right}z10
1856              & z10{up} .. z11
1857              & z11 -- cycle;
1858         set_char_box (0, 1.06 staff_space#, 1.6 staff_space#, 1.0 staff_space#);
1859 fet_endchar;
1860
1861 fet_beginchar ("kievan half note (space position)", "sr1kievan");
1862         % this draws the half note with a short tail down and a long tail up
1863         % this version of the half note is used in any space of the staff
1864         z1 = (1.071 staff_space, 1.426 staff_space);
1865         z2 = (0.974 staff_space, 0.191 staff_space);
1866         z3 = (1.059 staff_space, -0.994 staff_space);
1867         z4 = (0.713 staff_space, -1.169 staff_space);
1868         z5 = (0.676 staff_space, -0.436 staff_space);
1869         z6 = (0.684 staff_space, -0.310 staff_space);
1870         z7 = (0.448 staff_space, -0.322 staff_space);
1871         z8 = (0, -0.277 staff_space);
1872         z9 = (0.0856 staff_space, 0.359 staff_space);
1873         z10 = (0.746 staff_space, 0.281 staff_space);
1874         z11 = (0.807 staff_space, 0.847 staff_space);
1875         z12 = (0.945 staff_space, 1.401 staff_space);
1876         fill z1 .. z2{down} .. z3
1877              & z3 -- z4
1878              & z4 .. z5{up} .. z6
1879              & z6 .. z7{left} .. z8
1880              & z8 -- z9
1881              & z9 .. z10{right}
1882              & z10 .. z11 .. z12
1883              & z12 -- cycle;
1884         set_char_box (0, 1.1 staff_space#, 1.0 staff_space#, 1.4 staff_space#);
1885 fet_endchar;
1886
1887 fet_beginchar ("kievan eighth note (down)", "d3kievan");
1888         % this draws the eighth note
1889         % this form of the eight note occurs on the third line or higher
1890         % and sometimes between the second line and the third line
1891         z1 = (0.261 staff_space, 0.416 staff_space);
1892         z2 = (1.022 staff_space, 0.269 staff_space);
1893         z3 = (0.664 staff_space, -0.603 staff_space);
1894         z4 = (1.259 staff_space, -0.726 staff_space);
1895         z5 = (1.055 staff_space, -2.012 staff_space);
1896         z6 = (1.186 staff_space, -2.794 staff_space);
1897         z7 = (0.778 staff_space, -2.999 staff_space);
1898         z8 = (0.741 staff_space, -2.567 staff_space);
1899         z9 = (0.941 staff_space, -1.467 staff_space);
1900         z10 = (0.33 staff_space, -1.340 staff_space);
1901         z11 = (0.631 staff_space, -0.448 staff_space);
1902         z12 = (0, -0.334 staff_space);
1903         fill z1{right} .. z2
1904              & z2 -- z3
1905              & z3{right} .. z4
1906              & z4 .. z5{down} .. z6
1907              & z6 -- z7
1908              & z7 .. z8{up} .. z9
1909              & z9 .. {left}z10
1910              & z10{dir 78.7} .. z11
1911              & z11 .. {left}z12
1912              & z12{dir 78.7} .. {dir 62}cycle;
1913         set_char_box (0, 1.25 staff_space#, 3.0 staff_space#, 0.5 staff_space#);
1914 fet_endchar;
1915
1916 fet_beginchar ("kievan eighth note (up)", "u3kievan");
1917         % this draws the flagged eighth note
1918         % this version of the eighth note occurs on the second line or lower
1919         % first, draw the upside down quarter note
1920         z1 = (0.090 staff_space, -0.33 staff_space);
1921         z2 = (0.664 staff_space, -0.371 staff_space);
1922         z3 = (0.986 staff_space, -0.363 staff_space);
1923         z4 = (0.896 staff_space, 1.051 staff_space);
1924         z5 = (1.019 staff_space, 2.387 staff_space);
1925         z6 = (0.603 staff_space, 2.587 staff_space);
1926         z7 = (0.583 staff_space, 1.911 staff_space);
1927         z8 = (0.725 staff_space, 0.346 staff_space);
1928         z9 = (0.016 staff_space, 0.391 staff_space);
1929         z10 = (0, 0.240 staff_space);
1930         fill z1{dir -6.9} .. z2 .. z3
1931              & z3 .. z4 .. z5
1932              & z5 -- z6
1933              & z6 .. z7 .. z8
1934              & z8{left} .. z9
1935              & z9 .. z10 ... {dir -76.9}cycle;
1936         % now, draw the stem
1937         z11 = (0.033 staff_space, 2.823 staff_space);
1938         z12 = (0.391 staff_space, 2.648 staff_space);
1939         z13 = (0.354 staff_space, 2.290 staff_space);
1940         z14 = (0.676 staff_space, 1.076 staff_space);
1941         z15 = (0.693 staff_space, 0.88 staff_space);
1942         z16 = (0.208 staff_space, 1.699 staff_space);
1943         z17 = (0.024 staff_space, 2.616 staff_space);
1944         fill z11 -- z12
1945              & z12 .. z13{down} .. z14
1946              & z14 -- z15
1947              & z15 .. z16 .. z17{up} .. cycle;
1948         set_char_box (0, 1.0 staff_space#, 0.4 staff_space#, 2.9 staff_space#);
1949 fet_endchar;
1950
1951 fet_endgroup ("noteheads");