1 % Feta (not the Font-En-Tja) music font -- implement noteheads
2 % This file is part of LilyPond, the GNU music typesetter.
4 % Copyright (C) 1997--2011 Jan Nieuwenhuizen <janneke@gnu.org>
5 % & Han-Wen Nienhuys <hanwen@xs4all.nl>
6 % & Juergen Reuter <reuter@ipd.uka.de>
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.
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.
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/>.
29 % Most beautiful noteheads are pronounced, not circular,
30 % and not even symmetric.
31 % These examples are inspired by [Wanske]; see literature list.
35 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
39 save black_notehead_width, noteheight;
40 save half_notehead_width, whole_notehead_width, slash_thick;
41 save slash_slope, overdone_heads, solfa_noteheight;
45 numeric black_notehead_width;
46 numeric whole_notehead_width;
47 numeric half_notehead_width;
50 fet_begingroup ("noteheads");
53 % Slope of slash. From scm/grob-description.scm. How to auto-copy?
56 % Thickness of slash lines. Quarter notes get 1.5slt width.
57 slash_thick# := 2/3 * 0.48 staff_space#;
61 % Hand-engraved music often has balls extending above and below
62 % the lines. If you like that, modify overdone heads (unit:
63 % stafflinethickness).
66 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
70 % solfa heads should not overlap on chords.
72 solfa_noteheight# := staff_space# - stafflinethickness#;
74 define_pixels (slash_thick);
75 define_whole_vertical_pixels (noteheight);
78 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80 % SLANT moves both extrema on the long axis (by SLANT * ELLIPTICITY,
81 % so SLANT = -1, puts the extreme on the long axis next to the short
85 def draw_outside_ellipse (expr ellipticity, tilt, superness, slant) =
90 pat := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
91 (-ellipticity, 0), (slant * ellipticity, -1.0),
93 pat := pat rotated tilt;
95 save top_point, right_point;
96 pair top_point, right_point;
98 top_point := directionpoint left of pat;
99 right_point := directionpoint up of pat;
103 scaling# = noteheight# / (2 ypart (top_point));
104 width# := 2 xpart (right_point) * scaling#;
105 define_pixels (scaling, width);
107 set_char_box (0, width#, noteheight# / 2, noteheight# / 2);
109 d := d - feta_space_shift;
112 charwy := ypart (right_point) * scaling#;
115 pat := pat scaled scaling shifted (w / 2, .5 (h - d));
117 width := hround width;
119 if test_outlines = 1:
127 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) =
132 pat := superellipse ((ellipticity, 0), (0, 1.0),
133 (-ellipticity, 0), (0, -1.0),
135 pat := pat rotated tilt;
137 save top_point, right_point;
138 pair top_point, right_point;
140 top_point := directionpoint left of pat;
141 right_point := directionpoint up of pat;
143 save height, scaling;
145 height# = staff_space# + stafflinethickness# - clearance;
146 scaling# = height# / (2 ypart (top_point));
147 define_pixels (scaling);
148 pat := pat scaled scaling shifted (w / 2, .5 (h - d));
150 if test_outlines = 1:
160 % dimensions aren't entirely right.
162 def draw_longa (expr up) =
163 save stemthick, fudge;
165 stemthick# = 2 stafflinethickness#;
166 define_whole_blacker_pixels (stemthick);
168 fudge = hround (blot_diameter / 2);
170 draw_outside_ellipse (1.80, 0, 0.707, 0);
171 undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
173 pickup pencircle scaled stemthick;
183 top y4 = h + 3.0 staff_space;
186 bot y1 = -d - 3.0 staff_space;
197 draw_gridline (z1, z2, stemthick);
198 draw_gridline (z3, z4, stemthick);
204 fet_beginchar ("Longa notehead", "uM2");
207 draw_staff (-2, 2, 0);
211 fet_beginchar ("Longa notehead", "dM2");
214 draw_staff (-2, 2, 0);
219 fet_beginchar ("Longa notehead", "uM2");
222 draw_staff (-2, 2, 0.5);
226 fet_beginchar ("Longa notehead", "dM2");
229 draw_staff (-2, 2, 0.5);
235 % dimensions aren't entirely right.
237 def draw_brevis (expr linecount) =
238 save stemthick, fudge;
240 stemthick# = 2 stafflinethickness#;
241 define_whole_blacker_pixels (stemthick);
243 fudge = hround (blot_diameter / 2);
245 draw_outside_ellipse (1.80, 0, 0.707, 0);
246 undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
248 pickup pencircle scaled stemthick;
260 for i := 0 step 1 until linecount - 1:
261 draw_gridline (z1 - (1.5 * i * stemthick, 0),
262 z2 - (1.5 * i * stemthick, 0), stemthick);
263 draw_gridline (z3 + (1.5 * i * stemthick, 0),
264 z4 + (1.5 * i * stemthick, 0), stemthick);
269 fet_beginchar ("Brevis notehead", "sM1");
272 draw_staff (-2, 2, 0);
277 fet_beginchar ("Brevis notehead", "sM1");
280 draw_staff (-2, 2, 0.5);
285 fet_beginchar ("Double-lined brevis notehead", "sM1double");
288 draw_staff (-2, 2, 0);
293 fet_beginchar ("Double-lined brevis notehead", "sM1double");
296 draw_staff (-2, 2, 0.5);
301 fet_beginchar ("Whole notehead", "s0");
302 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0);
303 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
304 0.68, 2 stafflinethickness#);
306 whole_notehead_width# := charwd;
308 draw_staff (-2, 2, 0);
313 fet_beginchar ("Whole notehead", "s0");
314 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0,
316 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
317 0.68, 2 stafflinethickness#);
319 draw_staff (-2, 2, 0.5);
324 fet_beginchar ("Half notehead", "s1");
325 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
326 undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
328 half_notehead_width# := charwd;
330 draw_staff (-2, 2, 0);
335 fet_beginchar ("Half notehead", "s1");
336 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34,
338 undraw_inside_ellipse (3.25, 33, 0.81,
339 2.5 stafflinethickness#);
341 draw_staff (-2, 2, 0.5);
346 fet_beginchar ("Quarter notehead", "s2");
347 % used to have 32. With 31, they are slightly bolder.
348 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0);
349 black_notehead_width# := charwd;
351 draw_staff (-2, 2, 0);
356 fet_beginchar ("Quarter notehead", "s2");
357 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31,
360 draw_staff (-2, 2, 0.5);
365 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
368 fet_beginchar ("Whole diamondhead", "s0diamond");
369 draw_outside_ellipse (1.80, 0, 0.495, 0);
370 undraw_inside_ellipse (1.30, 125, 0.6,
371 .4 staff_space# + stafflinethickness#);
373 draw_staff (-2, 2, 0);
378 fet_beginchar ("Whole diamondhead", "s0diamond");
379 draw_outside_ellipse (1.80, 0, 0.495, 0);
380 undraw_inside_ellipse (1.30, 125, 0.6,
381 .4 staff_space# + stafflinethickness#);
383 draw_staff (-2, 2, 0.5);
388 fet_beginchar ("Half diamondhead", "s1diamond");
389 draw_outside_ellipse (1.50, 34, 0.49, 0.17);
390 undraw_inside_ellipse (3.5, 33, 0.80,
391 .3 staff_space# + 1.5 stafflinethickness#);
393 draw_staff (-2, 2, 0);
398 fet_beginchar ("Half diamondhead", "s1diamond");
399 draw_outside_ellipse (1.50, 34, 0.49, 0.17);
400 undraw_inside_ellipse (3.5, 33, 0.80,
402 + 1.5 stafflinethickness#);
404 draw_staff (-2, 2, 0.5);
409 fet_beginchar ("Quarter diamondhead", "s2diamond");
410 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
412 draw_staff (-2, 2, 0);
417 fet_beginchar ("Quarter diamondhead", "s2diamond");
418 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
420 draw_staff (-2, 2, 0.5);
425 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
428 vardef penposx@# (expr d) =
438 z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180));
439 z@#r = pat intersectionpoint (z@# -- infinity * dir (d));
445 % UGH: xs not declared as argument.
447 def define_triangle_shape (expr stemdir) =
448 save triangle_a, triangle_b, triangle_c;
449 save triangle_out_a, triangle_out_b, triangle_out_c;
450 save triangle_in, triangle_out;
451 save width, depth, height;
452 save origin, left_up_dir;
453 save exact_left_point, exact_right_point, exact_down_point;
455 path triangle_a, triangle_b, triangle_c;
456 path triangle_out_a, triangle_out_b, triangle_out_c;
457 path triangle_in, triangle_out;
458 pair origin, left_up_dir;
459 pair exact_down_point, exact_left_point, exact_right_point;
462 pen_thick# = stafflinethickness# + .1 staff_space#;
463 define_pixels (llap);
464 define_blacker_pixels (pen_thick);
466 left_up_dir = llap# * dir (90 + tilt);
468 xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0;
471 exact_left_point := origin + (left_up_dir xscaled xs);
472 exact_down_point := origin + (left_up_dir rotated 120 xscaled xs);
473 exact_right_point := origin + (left_up_dir rotated 240 xscaled xs);
475 height# = ypart (exact_left_point + origin) + pen_thick# / 2;
476 depth# = -ypart (exact_down_point + origin) + pen_thick# / 2;
477 width# = xpart (exact_right_point - exact_left_point)
480 set_char_box (0, width#, depth#, height#);
482 % Formerly, the shape has simply been drawn with an elliptical pen
483 % (`scaled pen_thick xscaled xs'), but the envelope of such a curve
484 % is of 6th degree. For the sake of mf2pt1, we approximate it.
486 pickup pencircle scaled pen_thick xscaled xs;
488 z0 = (hround_pixels (xpart origin), 0);
490 z1 = z1' = z0 + llap * dir (90 + tilt) xscaled xs;
491 z2 = z2' = z0 + llap * dir (90 + tilt + 120) xscaled xs;
492 z3 = z3' = z0 + llap * dir (90 + tilt + 240) xscaled xs;
494 z12 = caveness [.5[z1, z2], z3];
495 z23 = caveness [.5[z2, z3], z1];
496 z31 = caveness [.5[z3, z1], z2];
498 triangle_a = z1 .. z12 .. z2;
499 triangle_b = z2 .. z23 .. z3;
500 triangle_c = z3 .. z31 .. z1;
502 penposx1 (angle (direction 0 of triangle_a) - 90);
503 penposx2 (angle (direction 0 of triangle_b) - 90);
504 penposx3 (angle (direction 0 of triangle_c) - 90);
506 penposx1' (angle (direction infinity of triangle_c) + 90);
507 penposx2' (angle (direction infinity of triangle_a) + 90);
508 penposx3' (angle (direction infinity of triangle_b) + 90);
510 penposx12 (angle (z12 - z0));
511 penposx23 (angle (z23 - z0));
512 penposx31 (angle (z31 - z0));
514 z10 = (z0 -- z1) intersectionpoint (z1l .. z12l .. z2'r);
515 z20 = (z0 -- z2) intersectionpoint (z2l .. z23l .. z3'r);
516 z30 = (z0 -- z3) intersectionpoint (z3l .. z31l .. z1'r);
529 triangle_out_a = z1r .. z12r .. z2'l;
530 triangle_out_b = z2r .. z23r .. z3'l;
531 triangle_out_c = z3r .. z31r .. z1'l;
533 triangle_out = top z1
535 .. z1r{direction 0 of triangle_out_a}
537 & {direction infinity of triangle_out_a}z2'l
540 .. z2r{direction 0 of triangle_out_b}
542 & {direction infinity of triangle_out_b}z3'l
545 .. z3r{direction 0 of triangle_out_c}
547 & {direction infinity of triangle_out_c}z1'l
550 labels (0, 10, 20, 30);
551 penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31);
555 charwy := ypart exact_right_point;
556 charwx := xpart exact_right_point + .5 pen_thick# * xs;
558 charwy := -ypart exact_down_point;
559 charwx := width# - (xpart exact_down_point - .5 pen_thick# * xs);
564 def draw_whole_triangle_head =
570 llap# = 3/4 noteheight#;
574 define_triangle_shape (1);
580 fet_beginchar ("Whole trianglehead", "s0triangle");
581 draw_whole_triangle_head;
583 draw_staff (-2, 2, 0);
588 fet_beginchar ("Whole trianglehead", "s0triangle");
589 draw_whole_triangle_head;
591 draw_staff (-2, 2, 0.5);
596 def draw_small_triangle_head (expr dir) =
602 llap# = 2/3 noteheight#;
605 define_triangle_shape (dir);
609 filldraw triangle_out;
610 unfilldraw triangle_in;
614 fet_beginchar ("Half trianglehead (downstem)", "d1triangle");
615 draw_small_triangle_head (-1);
617 draw_staff (-2, 2, 0);
621 fet_beginchar ("Half trianglehead (upstem)", "u1triangle");
622 draw_small_triangle_head (1);
624 draw_staff (-2, 2, 0.5);
628 def draw_closed_triangle_head (expr dir) =
634 llap# = 2/3 noteheight#;
637 define_triangle_shape (dir);
642 fet_beginchar ("Quarter trianglehead (upstem)", "u2triangle");
643 draw_closed_triangle_head (1);
645 draw_staff (-2, 2, 0);
649 fet_beginchar ("Quarter trianglehead (downstem)", "d2triangle");
650 draw_closed_triangle_head (-1);
652 draw_staff (-2, 2, 0.5);
656 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
658 % Slash heads are for indicating improvisation. They are
659 % twice as high as normal heads.
661 def draw_slash (expr hwid_hash) =
665 exact_height = staff_space# + stafflinethickness# / 2;
667 set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
668 exact_height, exact_height);
677 pickup pencircle scaled blot_diameter;
682 lft x2 = 2 h / slash_slope;
689 ne = unitvector (z3 - z4);
690 nw_dist = (ne rotated 90) * 0.5 blot_diameter;
693 .. (z1 + nw_dist){ne}
694 -- (z2 + nw_dist){ne}
697 .. (z3 - nw_dist){-ne}
698 -- (z4 - nw_dist){-ne}
702 if hwid_hash > 2 slash_thick#:
705 th = slash_thick - blot_diameter;
710 z6 - z5 = whatever * ne;
711 z8 - z7 = whatever * ne;
713 z5 = z1 + whatever * ne + th * (ne rotated -90);
714 z8 = z4 + whatever * ne + th * (ne rotated 90);
722 labels (range 1 thru 10);
726 fet_beginchar ("Whole slashhead", "s0slash");
727 draw_slash (4 slash_thick# + 0.5 staff_space#);
729 draw_staff (-2, 2, 0);
733 fet_beginchar ("Half slashhead", "s1slash");
734 draw_slash (3.0 slash_thick# + 0.15 staff_space#);
736 draw_staff (-2, 2, 0);
740 fet_beginchar ("Quarter slashhead", "s2slash");
741 draw_slash (1.5 slash_thick#);
743 draw_staff (-2, 2, 0);
747 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
749 % `thick' is the distance between the NE/SW parallel lines in the cross
750 % (distance between centres of lines) in multiples of stafflinethickness
752 def draw_cross (expr thick) =
754 save ne_dist, nw_dist, rt_dist, up_dist;
755 save crz_in, crz_out;
758 pair ne_dist, nw_dist, rt_dist, up_dist;
759 path crz_in, crz_out;
761 pen_thick# := 1.2 stafflinethickness#;
762 thickness# := thick * stafflinethickness#;
763 define_pixels (thickness);
764 define_blacker_pixels (pen_thick);
766 pickup pencircle scaled pen_thick;
771 ne = unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
774 z4 - z5 = whatever * ne;
776 z6 - z3 = whatever * ne;
777 z3 - z4 = whatever * (ne yscaled -1);
779 z4 - z3 = whatever * (ne) + (ne rotated -90) * thickness;
782 x1 = charwd / 2 - .5 pen_thick#;
784 + thick / 2 * stafflinethickness# * (ne rotated -90);
786 % labels (1, 2, 3, 4, 5, 6);
788 nw = unitvector (z3 - z4);
790 up_dist = up * 0.5 pen_thick / cosd (angle (ne));
791 rt_dist = right * 0.5 pen_thick / sind (angle (ne));
792 nw_dist = (ne rotated 90) * 0.5 pen_thick;
793 ne_dist = (nw rotated -90) * 0.5 pen_thick;
799 x4 := hround (x4' + .5 pen_thick) - .5 pen_thick;
800 x5 := hfloor (x5' + xpart rt_dist) - xpart rt_dist;
801 y6 := vfloor (y6' + ypart up_dist) - ypart up_dist;
803 crz_out = (z6 + up_dist)
804 -- (z3 + nw_dist){ne}
806 .. (z3 + ne_dist){-nw}
807 -- (z4 + ne_dist){-nw}
809 .. (z4 - nw_dist){-ne}
811 crz_out := crz_out shifted (0, feta_shift)
812 -- reverse crz_out yscaled -1 shifted (0, -feta_eps);
814 -- reverse crz_out xscaled -1 shifted (-feta_eps, 0)
818 x4 := hround (x4' - xpart rt_dist) + xpart rt_dist;
819 x5 := hceiling (x5' - .5 pen_thick) + .5 pen_thick;
820 y6 := vfloor (y6' - .5 pen_thick) + .5 pen_thick;
822 crz_in = (bot z6){right}
823 .. (z6 - nw_dist){ne}
826 -- (z5 + nw_dist){-ne}
828 crz_in := crz_in shifted (0, feta_shift)
829 -- reverse crz_in yscaled -1 shifted (0, -feta_eps);
831 -- reverse crz_in xscaled -1 shifted (-feta_eps, 0)
836 currentpicture := currentpicture shifted (hround (w / 2), 0);
839 charwy := y1 + feta_shift;
841 z12 = (charwx * hppp, y1 * vppp);
847 fet_beginchar ("Whole Crossed notehead", "s0cross");
850 wid# := black_notehead_width# + 4 stafflinethickness#;
851 hei# := noteheight# + stafflinethickness#;
853 set_char_box (0, wid#, hei# / 2, hei# / 2);
857 remember_pic := currentpicture;
859 draw_staff (-2, 2, 0);
864 fet_beginchar ("Whole Crossed notehead", "s0cross");
867 wid# := black_notehead_width# + 4 stafflinethickness#;
868 hei# := noteheight# + stafflinethickness#;
870 set_char_box (0, wid#, hei# / 2, hei# / 2);
872 currentpicture := remember_pic;
874 draw_staff (-2, 2, 0.5);
879 fet_beginchar ("Half Crossed notehead", "s1cross");
882 wid# := black_notehead_width# + 2 stafflinethickness#;
883 hei# := noteheight# + stafflinethickness# / 2;
885 set_char_box (0, wid#, hei# / 2, hei# / 2);
889 remember_pic := currentpicture;
891 draw_staff (-2, 2, 0);
896 fet_beginchar ("Half Crossed notehead", "s1cross");
899 wid# := black_notehead_width# + 2 stafflinethickness#;
900 hei# := noteheight# + stafflinethickness# / 2;
902 set_char_box (0, wid#, hei# / 2, hei# / 2);
904 currentpicture := remember_pic;
906 draw_staff (-2, 2, 0.5);
911 fet_beginchar ("Crossed notehead", "s2cross");
912 wid# := black_notehead_width#;
914 set_char_box (0, wid#, hei# / 2, hei# / 2);
918 remember_pic := currentpicture;
920 draw_staff (-2, 2, 0);
925 fet_beginchar ("Crossed notehead", "s2cross");
926 wid# := black_notehead_width#;
928 set_char_box (0, wid#, hei# / 2, hei# / 2);
930 currentpicture := remember_pic;
932 draw_staff (-2, 2, 0.5);
937 fet_beginchar ("X-Circled notehead", "s2xcircle");
939 save cthick, cxd, cyd, dy;
941 wid# := black_notehead_width# * sqrt (sqrt2);
942 hei# := noteheight# * sqrt (sqrt2);
944 set_char_box (0, wid#, hei# / 2, hei# / 2);
946 d := d - feta_space_shift;
948 cthick# := (1.2 + 1/4) * stafflinethickness#;
949 define_blacker_pixels (cthick);
952 cyd := h + d - cthick / 2;
956 pickup pencircle scaled cthick;
958 fill fullcircle xscaled (cxd + cthick)
959 yscaled (cyd + cthick)
961 unfill fullcircle xscaled (cxd - cthick)
962 yscaled (cyd - cthick)
965 xpos := .5 cxd / sqrt2;
966 ypos := .5 cyd / sqrt2;
968 pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
969 draw (-xpos + w / 2, -ypos + dy)
970 -- (xpos + w / 2, ypos + dy);
972 pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
973 draw (-xpos + w / 2, ypos + dy)
974 -- (xpos + w / 2, -ypos + dy);
979 z12 = (charwx * hppp, charwy * vppp);
982 remember_pic := currentpicture;
984 draw_staff (-2, 2, 0);
989 fet_beginchar ("X-Circled notehead", "s2xcircle");
991 save cthick, cxr, cyr;
993 wid# := black_notehead_width# * sqrt (sqrt2);
994 hei# := noteheight# * sqrt (sqrt2);
996 set_char_box (0, wid#, hei# / 2, hei# / 2);
998 currentpicture := remember_pic;
1000 draw_staff (-2, 2, 0.5);
1007 % SOLFA SHAPED NOTES
1010 % Note: For whole and half notes, the `fill' curve (p_out) is offset from
1011 % the points that specify the outer geometry, because we need to add
1012 % the rounding. In contrast, the inner curve is not offset, because
1013 % there is no rounding.
1015 % This means that to get a line of thick_factor * pen_thickness,
1016 % we need to offset the inner curve by
1018 % (thick_factor - 0.5) * pen_thickness
1022 % (2 * thick_factor - 1) * half_pen_thickness
1024 save solfa_pen_thick;
1025 solfa_pen_thick# = 1.3 stafflinethickness#;
1026 define_blacker_pixels (solfa_pen_thick);
1028 save solfa_pen_radius;
1029 solfa_pen_radius = 0.5 solfa_pen_thick;
1031 save solfa_base_notewidth;
1032 solfa_base_notewidth# := black_notehead_width#;
1034 solfa_whole_width := 1.0;
1035 solfa_half_width := 1.0;
1036 solfa_quarter_width := 1.0;
1041 % Triangle with base parallel to staff lines.
1044 def draw_do_head (expr width_factor, dir, thickness_factor) =
1046 save left_dist, right_dist, bottom_dist;
1048 pair left_dist, right_dist, bottom_dist;
1050 set_char_box (0, width_factor * solfa_base_notewidth#,
1051 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1053 bottom_thick_factor := 2 * thickness_factor - 1;
1054 % no different thickness for left side if we want uniform thickness
1055 if thickness_factor = 1:
1056 left_thick_factor := 1;
1058 left_thick_factor := 0.7 * bottom_thick_factor;
1062 pen_radius := min (solfa_pen_radius,
1063 (h + d) / (3 * (1 + bottom_thick_factor)));
1065 pickup pencircle scaled (2 * pen_radius);
1074 left_dist = (unitvector (z3 - z1) rotated 90) * pen_radius;
1075 right_dist = (unitvector (z2 - z3) rotated 90) * pen_radius;
1076 bottom_dist = (0,1) * pen_radius;
1080 save point_a, point_b, point_c;
1081 pair point_a, point_b, point_c;
1083 pa := (z1 - left_thick_factor * left_dist)
1084 -- (z3 - left_thick_factor * left_dist);
1085 pb := (z1 + bottom_thick_factor * bottom_dist)
1086 -- (z2 + bottom_thick_factor * bottom_dist);
1087 pc := (z2 - right_dist)
1088 -- (z3 - right_dist);
1090 point_a := pa intersectionpoint pb;
1091 point_b := pb intersectionpoint pc;
1092 point_c := pc intersectionpoint pa;
1102 .. (z2 + right_dist){z3 - z2}
1103 -- (z3 + right_dist){z3 - z2}
1105 .. (z3 + left_dist){z1 - z3}
1106 -- (z1 + left_dist){z1 - z3}
1113 charwy := -chardp + 0.5 stafflinethickness#;
1123 fet_beginchar ("Whole dohead", "s0do");
1124 draw_do_head (solfa_whole_width, 1, do_weight);
1130 fet_beginchar ("Half dohead", "d1do");
1131 draw_do_head (solfa_half_width, -1, do_weight);
1137 fet_beginchar ("Half dohead", "u1do");
1138 draw_do_head (solfa_half_width, 1, do_weight);
1144 fet_beginchar ("Quarter dohead", "d2do");
1145 draw_do_head (solfa_quarter_width, -1, do_weight);
1150 fet_beginchar ("Quarter dohead", "u2do");
1151 draw_do_head (solfa_quarter_width, 1, do_weight);
1156 fet_beginchar ("Whole thin dohead", "s0doThin");
1157 draw_do_head (solfa_whole_width, 1, 1);
1163 fet_beginchar ("Half thin dohead", "d1doThin");
1164 draw_do_head (solfa_half_width, -1, 1);
1170 fet_beginchar ("Half thin dohead", "u1doThin");
1171 draw_do_head (solfa_half_width, 1, 1);
1177 fet_beginchar ("Quarter thin dohead", "d2doThin");
1178 draw_do_head (solfa_quarter_width, -1, 1);
1183 fet_beginchar ("Quarter thin dohead", "u2doThin");
1184 draw_do_head (solfa_quarter_width, 1, 1);
1190 % re - flat top, curved bottom:
1194 % .. {dir 90} (w,h/2)
1197 % (broader along the base and with more vertical sides for half and
1200 % Note: According to some shape-note singers, there should be no size
1201 % differences for half and whole notes, contrary to the comment above.
1202 % Consequently, we have made them all the same width.
1204 % stem attachment: h/2
1206 def draw_re_head (expr width_factor, dir, thickness_factor) =
1210 set_char_box (0, width_factor * solfa_base_notewidth#,
1211 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1214 offset = (2 * thickness_factor - 1);
1221 pen_radius := min (solfa_pen_radius,
1222 (h + d) * (1-curve_start) / (1+ offset));
1224 pickup pencircle scaled (2 * pen_radius);
1229 y2 = curve_start [y3, y1];
1237 labels (range 1 thru 5);
1239 p_in := (z1 + pen_radius * (1, -1 * offset))
1241 .. ((top z3) + (0, offset * pen_radius))
1243 -- (z5 + pen_radius * (-1, -1 * offset))
1256 charwy := curve_start [-chardp, charht];
1267 fet_beginchar ("Whole rehead", "s0re");
1268 draw_re_head (solfa_whole_width, 1, re_weight);
1274 fet_beginchar ("Half up rehead", "u1re");
1275 draw_re_head (solfa_half_width, 1, re_weight);
1281 fet_beginchar ("Half down rehead", "d1re");
1282 draw_re_head (solfa_half_width, -1, re_weight);
1288 fet_beginchar ("Quarter up rehead", "u2re");
1289 draw_re_head (solfa_quarter_width, 1, re_weight);
1294 fet_beginchar ("Quarter down rehead", "d2re");
1295 draw_re_head (solfa_quarter_width, -1, re_weight);
1300 fet_beginchar ("Whole thin rehead", "s0reThin");
1301 draw_re_head (solfa_whole_width, 1, 1);
1307 fet_beginchar ("Half up thin rehead", "u1reThin");
1308 draw_re_head (solfa_half_width, 1, 1);
1314 fet_beginchar ("Half down thin rehead", "d1reThin");
1315 draw_re_head (solfa_half_width, -1, 1);
1321 fet_beginchar ("Quarter thin rehead", "u2reThin");
1322 draw_re_head (solfa_quarter_width, 1, 1);
1327 fet_beginchar ("Quarter thin rehead", "d2reThin");
1328 draw_re_head (solfa_quarter_width, -1, 1);
1333 %%%% mi head -- diamond shape
1335 % two versions, depending on whether the `strong' lines are on the nw & se
1338 def draw_mi_head (expr width_factor, thickness_factor, mirror) =
1339 save path_out, path_in;
1340 save ne_dist, se_dist, ne, se;
1341 save path_a, path_b, path_c, path_d;
1342 path path_out, path_in;
1343 pair ne_dist, se_dist, ne, se;
1344 path path_a, path_b, path_c, path_d;
1348 set_char_box (0, width_factor * solfa_base_notewidth#,
1349 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1352 offset := 2 * thickness_factor - 1;
1356 note_diagonal := w / 2 ++ (h + d) / 2;
1360 pen_radius := min (solfa_pen_radius,
1361 .3 * note_diagonal / (1 + offset));
1363 pickup pencircle scaled (2 * pen_radius);
1374 % inner sides are parallel to outer sides
1375 z6 - z5 = whatever * (z2 - z1);
1376 z8 - z7 = whatever * (z4 - z3);
1377 z8 - z5 = whatever * (z4 - z1);
1378 z7 - z6 = whatever * (z3 - z2);
1380 ne = unitvector (z4 - z1);
1381 se = unitvector (z2 - z1);
1383 ne_dist = (ne rotated 90) * pen_radius;
1384 se_dist = (se rotated 90) * pen_radius;
1386 path_a := (z1 + se_dist)
1388 path_b := (z2 + (ne_dist * offset))
1389 -- (z3 + (ne_dist * offset));
1390 path_c := (z3 - se_dist)
1392 path_d := (z4 - (ne_dist * offset))
1393 -- (z1 - (ne_dist * offset));
1395 z5 = path_a intersectionpoint path_d;
1396 z7 = path_b intersectionpoint path_c;
1398 labels (range 1 thru 8);
1407 path_in := inner_path;
1409 path_in := inner_path reflectedabout (z2, z4);
1412 path_out := lft z1 {down}
1413 .. (z1 - se_dist){se}
1414 -- (z2 - se_dist){se}
1416 .. (z2 - ne_dist){ne}
1417 -- (z3 - ne_dist){ne}
1419 .. (z3 + se_dist){-se}
1420 -- (z4 + se_dist){-se}
1422 .. (z4 + ne_dist){-ne}
1423 -- (z1 + ne_dist){-ne}
1428 save mi_weight, mi_width;
1432 fet_beginchar ("Whole mihead", "s0mi");
1433 draw_mi_head (mi_width * solfa_whole_width, mi_weight, false);
1439 fet_beginchar ("Half mihead", "s1mi");
1440 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1446 fet_beginchar ("Quarter mihead", "s2mi");
1447 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1452 fet_beginchar ("Whole mirror mihead", "s0miMirror");
1453 draw_mi_head (mi_width * solfa_whole_width, mi_weight, true);
1459 fet_beginchar ("Half mirror mihead", "s1miMirror");
1460 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1466 fet_beginchar ("Quarter mirror mihead", "s2miMirror");
1467 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1472 fet_beginchar ("Whole thin mihead", "s0miThin");
1473 draw_mi_head (mi_width * solfa_whole_width, 1, false);
1479 fet_beginchar ("Half thin mihead", "s1miThin");
1480 draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1486 fet_beginchar ("Quarter thin mihead", "s2miThin");
1487 draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1494 % Right triangle, hypotenuse from nw to se corner. Stem attaches on
1495 % vertical side in direction of horizontal side.
1497 def draw_fa_head (expr width_factor, thickness_factor) =
1498 set_char_box (0, width_factor * solfa_base_notewidth#,
1499 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1501 save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1502 path p_down_in, p_down_out, p_up_in, p_up_out;
1503 save path_a, path_b, path_c;
1504 path path_a, path_b, path_c;
1508 offset := 2 * thickness_factor - 1;
1511 pen_radius := min (solfa_pen_radius,
1512 .33 * (h + d) / (1 + offset));
1514 pickup pencircle scaled (2 * pen_radius);
1527 labels (1, 2, 3, 4);
1529 nw = unitvector (z1 - z3);
1530 nw_dist = (nw rotated 90) * pen_radius;
1532 path_a := (z1 - (0,1) * offset * pen_radius)
1533 -- (z2 - (0,1) * offset * pen_radius);
1534 path_b := (z2 - (1,0) * pen_radius)
1535 -- (z3 - (1,0) * pen_radius);
1536 path_c := (z3 - nw_dist)
1539 p_up_in := (path_a intersectionpoint path_b)
1540 -- (path_b intersectionpoint path_c)
1541 -- (path_c intersectionpoint path_a)
1544 p_up_out := lft z1{down}
1545 .. (z1 + nw_dist){-nw}
1546 -- (z3 + nw_dist){-nw}
1554 p_down_in := p_up_in rotated 180 shifted (w, 0);
1555 p_down_out := p_up_out rotated 180 shifted (w, 0);
1564 fet_beginchar ("Whole fa up head", "u0fa");
1565 draw_fa_head (solfa_whole_width, fa_weight);
1571 fet_beginchar ("Whole fa down head", "d0fa");
1572 draw_fa_head (solfa_whole_width, fa_weight);
1578 fet_beginchar ("half fa up head", "u1fa");
1579 draw_fa_head (solfa_half_width, fa_weight);
1585 fet_beginchar ("Half fa down head", "d1fa");
1586 draw_fa_head (solfa_half_width, fa_weight);
1592 fet_beginchar ("Quarter fa up head", "u2fa");
1593 draw_fa_head (solfa_quarter_width, fa_weight);
1598 fet_beginchar ("Quarter fa down head", "d2fa");
1599 draw_fa_head (solfa_quarter_width, fa_weight);
1604 fet_beginchar ("Whole thin fa up head", "u0faThin");
1605 draw_fa_head (solfa_whole_width, 1);
1611 fet_beginchar ("Whole thin fa down head", "d0faThin");
1612 draw_fa_head (solfa_whole_width, 1);
1618 fet_beginchar ("half thin fa up head", "u1faThin");
1619 draw_fa_head (solfa_half_width, 1);
1625 fet_beginchar ("Half thin fa down head", "d1faThin");
1626 draw_fa_head (solfa_half_width, 1);
1632 fet_beginchar ("Quarter thin fa up head", "u2faThin");
1633 draw_fa_head (solfa_quarter_width, 1);
1638 fet_beginchar ("Quarter thin fa down head", "d2faThin");
1639 draw_fa_head (solfa_quarter_width, 1);
1647 % Note: sol head is the same shape as a standard music head, and doesn't
1648 % vary from style to style. However, width is constant with duration,
1649 % so we can't just use the standard note font.
1651 def draw_sol_head (expr filled) =
1652 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
1654 undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
1656 draw_staff (-2, 2, 0);
1659 fet_beginchar ("Whole solhead", "s0sol");
1660 draw_sol_head ( false);
1664 fet_beginchar ("Half solhead", "s1sol");
1665 draw_sol_head ( false);
1669 fet_beginchar ("Quarter solhead", "s2sol");
1670 draw_sol_head ( true);
1678 def draw_la_head (expr width_factor, thickness_factor) =
1679 set_char_box (0, width_factor * solfa_base_notewidth#,
1680 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1685 offset := 2 * thickness_factor - 1;
1688 pen_radius := min (solfa_pen_radius,
1689 .35 * (h + d) / (1 + offset));
1691 pickup pencircle scaled (2 * pen_radius);
1704 labels (range 1 thru 4);
1706 p_in := (z1 + pen_radius * (1, -offset))
1707 -- (z2 + pen_radius * (-1, -offset))
1708 -- (z3 + pen_radius * (-1, offset))
1709 -- (z4 + pen_radius * (1, offset))
1727 fet_beginchar ("Whole lahead", "s0la");
1728 draw_la_head (solfa_whole_width, la_weight);
1734 fet_beginchar ("Half lahead", "s1la");
1735 draw_la_head (solfa_half_width, la_weight);
1741 fet_beginchar ("Quarter lahead", "s2la");
1742 draw_la_head (solfa_quarter_width, la_weight);
1747 fet_beginchar ("Whole thin lahead", "s0laThin");
1748 draw_la_head (solfa_whole_width, 1);
1754 fet_beginchar ("Half thin lahead", "s1laThin");
1755 draw_la_head (solfa_half_width, 1);
1761 fet_beginchar ("Quarter lahead", "s2laThin");
1762 draw_la_head (solfa_quarter_width, 1);
1769 % `Snow-cone', V with rounded top.
1771 def draw_ti_head (expr width_factor, dir, thickness_factor) =
1772 set_char_box (0, width_factor * solfa_base_notewidth#,
1773 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1774 save p_in, p_out, p_top, p_top_in;
1775 path p_in, p_out, p_top, p_top_in;
1780 offset := 2 * thickness_factor - 1;
1783 pen_radius := min (solfa_pen_radius,
1784 .4 * (h + d) / (1 + offset));
1786 pickup pencircle scaled (2 * pen_radius);
1791 y2 = cone_height [y1, y3];
1797 y5 = y1 + offset * pen_radius;
1799 labels (range 1 thru 4);
1801 save nw_dist, sw_dist, nw, sw;
1802 pair nw_dist, sw_dist, nw, sw;
1804 nw = unitvector (z2 - z1);
1805 sw = unitvector (z1 - z4);
1807 nw_dist = (nw rotated 90) * pen_radius;
1808 sw_dist = (sw rotated 90) * pen_radius;
1810 p_top := (z2 + nw * pen_radius)
1812 .. (z4 - sw * pen_radius);
1814 p_top_in := (z2 - nw * offset * pen_radius)
1815 .. (z3 - (0,1) * pen_radius) {right}
1816 .. (z4 + sw * offset * pen_radius);
1818 save path_a, path_b;
1819 path path_a, path_b;
1825 z6 = path_a intersectionpoint p_top_in;
1826 z7 = path_b intersectionpoint p_top_in;
1838 .. (z2 + nw * pen_radius){direction 0 of p_top}
1840 & {direction infinity of p_top}(z4 - sw * pen_radius)
1847 charwy := cone_height [-chardp, charht];
1857 fet_beginchar ("Whole up tihead", "s0ti");
1858 draw_ti_head (solfa_whole_width, 1, ti_weight);
1864 fet_beginchar ("Half up tihead", "u1ti");
1865 draw_ti_head (solfa_half_width, 1, ti_weight);
1871 fet_beginchar ("Half down tihead", "d1ti");
1872 draw_ti_head (solfa_half_width, -1, ti_weight);
1878 fet_beginchar ("Quarter up tihead", "u2ti");
1879 draw_ti_head (solfa_quarter_width, 1, ti_weight);
1884 fet_beginchar ("Quarter down tihead", "d2ti");
1885 draw_ti_head (solfa_quarter_width, -1, ti_weight);
1890 fet_beginchar ("Whole thin up tihead", "s0tiThin");
1891 draw_ti_head (solfa_whole_width, 1, 1);
1897 fet_beginchar ("Half thin up tihead", "u1tiThin");
1898 draw_ti_head (solfa_half_width, 1, 1);
1904 fet_beginchar ("Half thin down tihead", "d1tiThin");
1905 draw_ti_head (solfa_half_width, -1, 1);
1911 fet_beginchar ("Quarter thin up tihead", "u2tiThin");
1912 draw_ti_head (solfa_quarter_width, 1, 1);
1917 fet_beginchar ("Quarter thin down tihead", "d2tiThin");
1918 draw_ti_head (solfa_quarter_width, -1, 1);
1923 %%%%%% Funk shape note heads
1925 % Funk heads are narrower than Aiken and Sacred Harp, so we need a new
1928 funk_notehead_width := 0.75;
1932 % Parabolic on one side, vertical line on other
1933 % Has up and down shapes for *all* notes
1935 def draw_Funk_do_head (expr width_factor, thickness_factor) =
1936 set_char_box (0, width_factor * solfa_base_notewidth#,
1937 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1940 offset := 2 * thickness_factor - 1;
1943 pen_radius := min (solfa_pen_radius,
1944 .3 * (h + d) / (1 + offset));
1946 pickup pencircle scaled (2 * pen_radius);
1957 x4 = x1 - pen_radius;
1958 y4 = y1 + offset * pen_radius;
1961 x5 = x2 + pen_radius;
1964 y6 = y3 - offset * pen_radius;
1966 save p_up_in, p_up_out, p_down_in, p_down_out;
1967 path p_up_in, p_up_out, p_down_in, p_down_out;
1969 p_down_in := z4{left}
1974 p_down_out := bot z1{left}
1981 p_up_in := p_down_in rotated 180 shifted (w,0);
1982 p_up_out := p_down_out rotated 180 shifted (w,0);
1987 save funk_do_weight;
1988 funk_do_weight := 1.7;
1990 fet_beginchar ("Whole up Funk dohead", "u0doFunk");
1991 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1997 fet_beginchar ("Whole down Funk dohead", "d0doFunk");
1998 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
2004 fet_beginchar ("Half up Funk dohead", "u1doFunk");
2005 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
2011 fet_beginchar ("Half down Funk dohead", "d1doFunk");
2012 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
2018 fet_beginchar ("Quarter up Funk dohead", "u2doFunk");
2019 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
2024 fet_beginchar ("Quarter down Funk dohead", "d2doFunk");
2025 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
2032 % Has up and down shapes for *all* notes
2034 def draw_Funk_re_head (expr width_factor, thickness_factor) =
2035 set_char_box (0, width_factor * solfa_base_notewidth#,
2036 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2039 offset := 2 * thickness_factor - 1;
2042 pen_radius := min (solfa_pen_radius,
2043 .3 * (h + d) / (1 + offset));
2045 pickup pencircle scaled (2 * pen_radius);
2056 x3 := curve_in [x1, x2];
2064 save ne, se, ne_perp, se_perp;
2065 pair ne, se, ne_perp, se_perp;
2067 ne := unitvector (z2 - z1);
2068 se := unitvector (z4 - z1);
2069 ne_perp := ne rotated 90;
2070 se_perp := se rotated 90;
2072 save path_a, path_b, path_c, path_d;
2073 path path_a, path_b, path_c, path_d;
2074 save arrow_a_perp, arrow_b_perp;
2075 pair arrow_a_perp, arrow_b_perp;
2078 path_d := z2 .. z3{down} .. z4;
2079 arrow_a_perp = unitvector (direction 0 of path_d rotated 90)
2081 arrow_b_perp = unitvector (direction 2 of path_d rotated 90)
2084 path_b := (z1 + se_perp * pen_radius)
2085 -- z4 + se_perp * offset * pen_radius;
2086 path_a := (z1 - ne_perp * pen_radius)
2087 -- z2 - ne_perp * offset * pen_radius;
2088 path_c := z2 - arrow_a_perp
2090 .. z4 - arrow_b_perp;
2092 z5 = path_a intersectionpoint path_b;
2093 z7 = path_a intersectionpoint path_c;
2094 z8 = path_b intersectionpoint path_c;
2096 save p_up_in, p_down_in, p_up_out, p_down_out;
2097 path p_up_in, p_down_in, p_up_out, p_down_out;
2105 p_down_out := lft z1{up}
2106 .. (z1 + ne_perp * pen_radius){ne}
2107 -- (z2 + ne_perp * pen_radius){ne}
2110 .. (z2 + arrow_a_perp)
2112 .. (z4 + arrow_b_perp)
2115 .. z4 - se_perp * pen_radius
2116 -- z1 - se_perp * pen_radius
2119 p_up_in := p_down_in rotated 180 shifted (w, 0);
2120 p_up_out := p_down_out rotated 180 shifted (w, 0);
2125 save funk_re_weight;
2126 funk_re_weight = 1.7;
2128 fet_beginchar ("Whole up Funk rehead", "u0reFunk");
2129 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2135 fet_beginchar ("Whole down Funk rehead", "d0reFunk");
2136 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2142 fet_beginchar ("Half up Funk rehead", "u1reFunk");
2143 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2149 fet_beginchar ("Half down Funk rehead", "d1reFunk");
2150 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2156 fet_beginchar ("Quarter up Funk rehead", "u2reFunk");
2157 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2162 fet_beginchar ("Quarter down Funk rehead", "d2reFunk");
2163 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2170 % Has up and down shapes for all hollow notes
2172 save funk_mi_width, funk_mi_weight;
2173 funk_mi_width := 1.2;
2174 funk_mi_weight := 1.9;
2176 fet_beginchar ("Whole up Funk mihead", "u0miFunk");
2177 draw_mi_head (funk_mi_width * funk_notehead_width,
2178 funk_mi_weight, false);
2184 fet_beginchar ("Whole down Funk mihead", "d0miFunk");
2185 draw_mi_head (funk_mi_width * funk_notehead_width,
2186 funk_mi_weight, true);
2192 fet_beginchar ("Half up Funk mihead", "u1miFunk");
2193 draw_mi_head (funk_mi_width * funk_notehead_width,
2194 funk_mi_weight, false);
2200 fet_beginchar ("Half down Funk mihead", "d1miFunk");
2201 draw_mi_head (funk_mi_width * funk_notehead_width,
2202 funk_mi_weight, true);
2208 fet_beginchar ("Quarter Funk mihead", "s2miFunk");
2209 draw_mi_head (funk_mi_width * funk_notehead_width,
2210 funk_mi_weight, false);
2217 % Does it rotate for whole notes?
2218 % Same as other shape note systems
2219 % Need special notes because of special width
2221 save funk_fa_weight;
2222 funk_fa_weight := 1.9;
2224 fet_beginchar ("Whole up Funk fahead", "u0faFunk");
2225 draw_fa_head (funk_notehead_width, funk_fa_weight);
2231 fet_beginchar ("Whole down Funk fahead", "d0faFunk");
2232 draw_fa_head (funk_notehead_width, funk_fa_weight);
2238 fet_beginchar ("Half up Funk fahead", "u1faFunk");
2239 draw_fa_head (funk_notehead_width, funk_fa_weight);
2245 fet_beginchar ("Half down Funk fahead", "d1faFunk");
2246 draw_fa_head (funk_notehead_width, funk_fa_weight);
2252 fet_beginchar ("Quarter up Funk fahead", "u2faFunk");
2253 draw_fa_head (funk_notehead_width, funk_fa_weight);
2258 fet_beginchar ("Quarter down Funk fahead", "d2faFunk");
2259 draw_fa_head (funk_notehead_width, funk_fa_weight);
2264 %%%%%% Funk sol head is the same as the others
2265 % Need special character because of skinnier head
2267 def draw_Funk_sol_head (expr filled) =
2270 noteheight# := solfa_noteheight#;
2271 draw_outside_ellipse (1.2, 34, 0.71, 0.);
2273 undraw_inside_ellipse (1.9, 33, 0.74, 5.5 stafflinethickness#);
2275 draw_staff (-2, 2, 0);
2280 fet_beginchar ("Whole Funk solhead", "s0solFunk");
2281 draw_Funk_sol_head ( false);
2285 fet_beginchar ("Half Funk solhead", "s1solFunk");
2286 draw_Funk_sol_head ( false);
2290 fet_beginchar ("Quarter Funk solhead", "s2solFunk");
2291 draw_Funk_sol_head ( true);
2297 % Same as for other shape notes
2298 % Smaller width requires special characters
2300 save funk_la_weight;
2301 funk_la_weight := 1.9;
2303 fet_beginchar ("Whole Funk lahead", "s0laFunk");
2304 draw_la_head (funk_notehead_width, funk_notehead_width);
2310 fet_beginchar ("Half Funk lahead", "s1laFunk");
2311 draw_la_head (funk_notehead_width, funk_notehead_width);
2317 fet_beginchar ("Quarter Funk lahead", "s2laFunk");
2318 draw_la_head (funk_notehead_width, funk_notehead_width);
2324 % `Sideways snow cone'.
2325 % Rotates for all notes.
2327 def draw_Funk_ti_head (expr width_factor, thickness_factor) =
2328 set_char_box (0, width_factor * solfa_base_notewidth#,
2329 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2334 offset := 2 * thickness_factor - 1;
2337 pen_radius := min (solfa_pen_radius,
2338 .33 * (h + d) / (1 + offset));
2340 pickup pencircle scaled (2 * pen_radius);
2345 x2 = cone_width [x1, x3];
2354 save nw_dist, sw_dist, ne, se;
2355 pair nw_dist, sw_dist, ne, se;
2357 ne = unitvector (z2 - z1);
2358 se = unitvector (z4 - z1);
2360 nw_dist = (ne rotated 90) * pen_radius ;
2361 sw_dist = (se rotated -90) * pen_radius;
2363 save path_a, path_b;
2364 path path_a, path_b;
2365 path_a := z1 - nw_dist
2366 -- z2 - offset * nw_dist;
2367 path_b := z1 - sw_dist
2368 -- z4 - offset * sw_dist;
2370 save path_right, path_right_in;
2371 path path_right, path_right_in;
2372 path_right := (z2 + ne * pen_radius)
2374 .. (z4 + se * pen_radius);
2376 path_right_in := (z2 - ne * pen_radius)
2378 .. (z4 - se * pen_radius);
2380 z5 = path_a intersectionpoint path_b;
2381 z6 = path_a intersectionpoint path_right_in;
2382 z7 = path_b intersectionpoint path_right_in;
2384 save p_up_in, p_down_in, p_up_out, p_down_out;
2385 path p_up_in, p_down_in, p_up_out, p_down_out;
2393 p_down_out := lft z1
2397 .. (z2 + ne * pen_radius){direction 0 of path_right}
2399 & {direction infinity of path_right}(z4 + se * pen_radius)
2405 p_up_in := p_down_in rotated 180 shifted (w, 0);
2406 p_up_out := p_down_out rotated 180 shifted (w, 0);
2410 save funk_ti_weight;
2411 funk_ti_weight := 1.6;
2413 fet_beginchar ("Whole up Funk tihead", "u0tiFunk");
2414 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2420 fet_beginchar ("Whole down Funk tihead", "d0tiFunk");
2421 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2427 fet_beginchar ("Half up Funk tihead", "u1tiFunk");
2428 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2434 fet_beginchar ("Half down Funk tihead", "d1tiFunk");
2435 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2441 fet_beginchar ("Quarter up Funk tihead", "u2tiFunk");
2442 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2447 fet_beginchar ("Quarter down Funk tihead", "d2tiFunk");
2448 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2453 %%%%%% Walker shape note heads
2455 % Walker heads are narrow like Funk heads, so use funk_notehead_width.
2458 %%%%%% Walker do head
2460 % Trapezoid, with largest side on stem side
2462 def draw_Walker_do_head (expr width_factor, dir, thickness_factor) =
2463 set_char_box (0, width_factor * solfa_base_notewidth#,
2464 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2466 pickup pencircle scaled solfa_pen_thick;
2469 offset := 2 * thickness_factor - 1;
2471 % adjust width so stem can be centered
2472 if .5w <> good.x .5w: change_width; fi
2476 scaling# = charwd / w;
2481 x1 = inset [x4, x3];
2484 x2 = inset [x3, x4];
2493 labels (range 1 thru 4);
2495 save left_dir, left_perp, right_dir, right_perp;
2496 pair left_dir, left_perp, right_dir, right_perp;
2498 left_dir = unitvector(z1 - z4);
2499 left_perp = (left_dir rotated 90) * solfa_pen_radius;
2500 right_dir = unitvector(z3 - z2);
2501 right_perp = (right_dir rotated 90) * solfa_pen_radius;
2503 save path_a, path_b, path_c, path_d;
2504 path path_a, path_b, path_c, path_d;
2506 path_a := (z4 - left_perp)
2507 -- (z1 - left_perp);
2508 path_b := (z1 - (0, offset*solfa_pen_radius))
2509 -- (z2 - (0, offset*solfa_pen_radius));
2510 path_c := (z2 - right_perp)
2511 -- (z3 - right_perp);
2512 path_d := (z3 + (0, offset*solfa_pen_radius))
2513 -- (z4 + (0, offset*solfa_pen_radius));
2518 p_in := (path_a intersectionpoint path_b)
2519 -- (path_b intersectionpoint path_c)
2520 -- (path_c intersectionpoint path_d)
2521 -- (path_d intersectionpoint path_a)
2524 p_out := top z1{right}
2526 .. z2 + right_perp {right_dir}
2527 -- z3 + right_perp {right_dir}
2530 .. z4 + left_perp {left_dir}
2531 .. z1 + left_perp {left_dir}
2534 charwx := scaling# * (w/2 + solfa_pen_radius);
2535 charwy := scaling# * y2 ;
2538 p_in := p_in rotated 180 shifted (w,0);
2539 p_out := p_out rotated 180 shifted (w,0);
2544 save walker_do_weight;
2545 walker_do_weight := 1.5;
2547 fet_beginchar ("Whole Walker dohead", "s0doWalker");
2548 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2554 fet_beginchar ("Half up Walker dohead", "u1doWalker");
2555 draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2561 fet_beginchar ("Half down Walker dohead", "d1doWalker");
2562 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2568 fet_beginchar ("Quarter up Walker dohead", "u2doWalker");
2569 draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2574 fet_beginchar ("Quarter down Walker dohead", "d2doWalker");
2575 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2580 %%%%%% Walker re head
2581 % Parabolic on one side, shallow parabola on other
2582 % Has up and down shapes for *all* notes
2584 def draw_Walker_re_head (expr width_factor, thickness_factor) =
2585 set_char_box (0, width_factor * solfa_base_notewidth#,
2586 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2589 offset := 2 * thickness_factor - 1;
2592 pen_radius := min (solfa_pen_radius,
2593 .3 * (h + d) / (1 + offset));
2595 pickup pencircle scaled (2 * pen_radius);
2598 dish_factor := 0.20;
2609 x4 = dish_factor [x1, x2];
2613 y5 = y1 + offset * pen_radius;
2616 x6 = x2 + pen_radius;
2619 y7 = y3 - offset * pen_radius;
2622 x8 = x4 - pen_radius;
2624 save path_a, path_d;
2625 path path_a, path_d;
2627 save p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2628 pair p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2630 path_a := z3 .. z4{down} .. z1;
2632 p_a_start_dir := unitvector(direction 0 of path_a);
2633 p_a_end_dir := unitvector(direction infinity of path_a);
2634 p_a_start_perp := (p_a_start_dir rotated 90) * pen_radius;
2635 p_a_end_perp := (p_a_end_dir rotated 90) * pen_radius;
2637 path_d := (z3 - p_a_start_perp){p_a_start_dir}
2639 ..(z1 - p_a_end_perp){p_a_end_dir};
2641 save path_b, path_c;
2642 path path_b, path_c;
2644 path_b := z5 {left} .. z6{up};
2645 path_c := z7 {left} .. z6{down};
2647 z9 = path_d intersectionpoint path_b;
2648 z10 = path_d intersectionpoint path_c;
2650 labels (range 1 thru 4);
2652 save p_up_in, p_up_out, p_down_in, p_down_out;
2653 path p_up_in, p_up_out, p_down_in, p_down_out;
2656 ... {right} z10 {p_a_start_dir}
2658 .. {p_a_end_dir} z9 {left}
2661 p_down_out := lft z2{up}
2664 .. (z3 + p_a_start_perp){p_a_start_dir}
2666 .. (z1 + p_a_end_perp) {p_a_end_dir}
2671 p_up_in := p_down_in rotated 180 shifted (w,0);
2672 p_up_out := p_down_out rotated 180 shifted (w,0);
2676 save walker_re_weight;
2677 walker_re_weight := 1.2;
2679 fet_beginchar ("Whole Walker rehead", "s0reWalker");
2680 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2686 fet_beginchar ("Half up Walker rehead", "u1reWalker");
2687 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2693 fet_beginchar ("Half down Walker rehead", "d1reWalker");
2694 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2700 fet_beginchar ("Quarter up Walker rehead", "u2reWalker");
2701 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2706 fet_beginchar ("Quarter down Walker rehead", "d2reWalker");
2707 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2712 %%%%%% Walker mi head
2714 % Symmetric for all hollow notes
2716 save walker_mi_width, walker_mi_weight;
2717 walker_mi_width := 1.2;
2718 walker_mi_weight := 1.5;
2720 fet_beginchar ("Whole Walker mihead", "s0miWalker");
2721 draw_mi_head (walker_mi_width * funk_notehead_width,
2722 walker_mi_weight, true);
2728 fet_beginchar ("Half Walker mihead", "s1miWalker");
2729 draw_mi_head (walker_mi_width * funk_notehead_width,
2730 walker_mi_weight, true);
2736 fet_beginchar ("Quarter Walker mihead", "s2miWalker");
2737 draw_mi_head (walker_mi_width * funk_notehead_width,
2738 walker_mi_weight, true);
2745 % Does not rotate for whole notes
2746 % Whole rotation is different from Funk, so special notes
2748 %%%%%% Funk sol head is the same as the others
2749 % Need special character because of skinnier head
2751 save walker_fa_weight;
2752 walker_fa_weight := 1.5;
2754 fet_beginchar ("Whole Walker fahead", "s0faWalker");
2755 draw_fa_head (funk_notehead_width, walker_fa_weight);
2761 fet_beginchar ("Half up Walker fahead", "u1faWalker");
2762 draw_fa_head (funk_notehead_width, walker_fa_weight);
2768 fet_beginchar ("Half down Walker fahead", "d1faWalker");
2769 draw_fa_head (funk_notehead_width, walker_fa_weight);
2775 fet_beginchar ("Quarter up Walker fahead", "u2faWalker");
2776 draw_fa_head (funk_notehead_width, walker_fa_weight);
2781 fet_beginchar ("Quarter down Walker fahead", "d2faWalker");
2782 draw_fa_head (funk_notehead_width, walker_fa_weight);
2788 % Same as Funk, no special notes
2791 %%%%%% Walker la head
2793 % Lighter weight requires separate notes
2795 save walker_la_weight;
2796 walker_la_weight := 1.5;
2798 fet_beginchar ("Whole Walker lahead", "s0laWalker");
2799 draw_la_head (funk_notehead_width, walker_la_weight);
2805 fet_beginchar ("Half Funk lahead", "s1laWalker");
2806 draw_la_head (funk_notehead_width, walker_la_weight);
2812 fet_beginchar ("Quarter Funk lahead", "s2laWalker");
2813 draw_la_head (funk_notehead_width, walker_la_weight);
2818 %%%%%% Walker ti head
2819 % Triangular arrowhead
2820 % Rotates for all but whole notes
2822 def draw_Walker_ti_head (expr width_factor, thickness_factor) =
2823 set_char_box (0, width_factor * solfa_base_notewidth#,
2824 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2827 offset := 2 * thickness_factor - 1;
2830 pen_radius := min (solfa_pen_radius,
2831 .3 * (h + d) / (1 + offset));
2833 pickup pencircle scaled (2 * pen_radius);
2845 labels (range 1 thru 4);
2847 save nw_dist, sw_dist, ne, se;
2848 pair nw_dist, sw_dist, ne, se;
2850 ne = unitvector (z2 - z1);
2851 se = unitvector (z3 - z1);
2853 nw_dist = (ne rotated 90) * pen_radius ;
2854 sw_dist = (se rotated -90) * pen_radius;
2857 save path_a, path_b, path_c;
2858 path path_a, path_b, path_c;
2859 path_a := z2 - nw_dist * offset
2860 -- z1 - nw_dist * offset;
2861 path_b := z3 - sw_dist * offset
2862 -- z1 - sw_dist * offset;
2863 path_c := z2 + left * pen_radius
2864 -- z3 + left * pen_radius;
2866 z4 = path_a intersectionpoint path_b;
2867 z5 = path_a intersectionpoint path_c;
2868 z6 = path_b intersectionpoint path_c;
2870 save p_up_in, p_down_in, p_up_out, p_down_out;
2871 path p_up_in, p_down_in, p_up_out, p_down_out;
2878 p_down_out := lft z1{up}
2879 .. (z1 + nw_dist){ne}
2880 -- (z2 + nw_dist){ne}
2885 .. (z3 + sw_dist){- se}
2886 .. (z1 + sw_dist){- se}
2889 p_up_in := p_down_in rotated 180 shifted (w, 0);
2890 p_up_out := p_down_out rotated 180 shifted (w, 0);
2894 save walker_ti_weight;
2895 walker_ti_weight := 1.4;
2897 fet_beginchar ("Whole Walker tihead", "s0tiWalker");
2898 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2904 fet_beginchar ("Half up Walker tihead", "u1tiWalker");
2905 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2911 fet_beginchar ("Half down Walker tihead", "d1tiWalker");
2912 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2918 fet_beginchar ("Quarter up Walker tihead", "u2tiWalker");
2919 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2924 fet_beginchar ("Quarter down Walker tihead", "d2tiWalker");
2925 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2929 fet_endgroup ("noteheads");
2933 % we derive black_notehead_width# from the quarter head,
2934 % so we have to define black_notehead_width (pixel qty)
2935 % after the black_notehead_width# itself.
2937 % Let's keep it outside the group as well.
2940 define_pixels (black_notehead_width);