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--2010 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 ("Quart 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 ("Quart 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 ("Quart diamondhead", "s2diamond");
410 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
412 draw_staff (-2, 2, 0);
417 fet_beginchar ("Quart 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 ("Quart trianglehead (upstem)", "u2triangle");
643 draw_closed_triangle_head (1);
645 draw_staff (-2, 2, 0);
649 fet_beginchar ("Quart 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 ("Quart 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 pickup pencircle scaled solfa_pen_thick;
1056 bottom_thick_factor := 2 * thickness_factor - 1;
1057 % no different thickness for left side if we want uniform thickness
1058 if thickness_factor = 1:
1059 left_thick_factor := 1;
1061 left_thick_factor := 0.7 * bottom_thick_factor;
1071 left_dist = (unitvector (z3 - z1) rotated 90) * solfa_pen_radius;
1072 right_dist = (unitvector (z2 - z3) rotated 90) * solfa_pen_radius;
1073 bottom_dist = (0,1) * solfa_pen_radius;
1077 save point_a, point_b, point_c;
1078 pair point_a, point_b, point_c;
1080 pa := (z1 - left_thick_factor * left_dist)
1081 -- (z3 - left_thick_factor * left_dist);
1082 pb := (z1 + bottom_thick_factor * bottom_dist)
1083 -- (z2 + bottom_thick_factor * bottom_dist);
1084 pc := (z2 - right_dist)
1085 -- (z3 - right_dist);
1087 point_a := pa intersectionpoint pb;
1088 point_b := pb intersectionpoint pc;
1089 point_c := pc intersectionpoint pa;
1099 .. (z2 + right_dist){z3 - z2}
1100 -- (z3 + right_dist){z3 - z2}
1102 .. (z3 + left_dist){z1 - z3}
1103 -- (z1 + left_dist){z1 - z3}
1110 charwy := -chardp + 0.5 stafflinethickness#;
1120 fet_beginchar ("Whole dohead", "s0do");
1121 draw_do_head (solfa_whole_width, 1, do_weight);
1127 fet_beginchar ("Half dohead", "d1do");
1128 draw_do_head (solfa_half_width, -1, do_weight);
1134 fet_beginchar ("Half dohead", "u1do");
1135 draw_do_head (solfa_half_width, 1, do_weight);
1141 fet_beginchar ("Quart dohead", "d2do");
1142 draw_do_head (solfa_quarter_width, -1, do_weight);
1147 fet_beginchar ("Quart dohead", "u2do");
1148 draw_do_head (solfa_quarter_width, 1, do_weight);
1153 fet_beginchar ("Whole thin dohead", "s0doThin");
1154 draw_do_head (solfa_whole_width, 1, 1);
1160 fet_beginchar ("Half thin dohead", "d1doThin");
1161 draw_do_head (solfa_half_width, -1, 1);
1167 fet_beginchar ("Half thin dohead", "u1doThin");
1168 draw_do_head (solfa_half_width, 1, 1);
1174 fet_beginchar ("Quart thin dohead", "d2doThin");
1175 draw_do_head (solfa_quarter_width, -1, 1);
1180 fet_beginchar ("Quart thin dohead", "u2doThin");
1181 draw_do_head (solfa_quarter_width, 1, 1);
1187 % re - flat top, curved bottom:
1191 % .. {dir 90} (w,h/2)
1194 % (broader along the base and with more vertical sides for half and
1197 % Note: According to some shape-note singers, there should be no size
1198 % differences for half and whole notes, contrary to the comment above.
1199 % Consequently, we have made them all the same width.
1201 % stem attachment: h/2
1203 def draw_re_head (expr width_factor, dir, thickness_factor) =
1207 set_char_box (0, width_factor * solfa_base_notewidth#,
1208 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1210 pickup pencircle scaled solfa_pen_thick;
1217 y2 = curve_start [y3, y1];
1226 offset = (2 * thickness_factor - 1);
1228 labels (range 1 thru 5);
1230 p_in := (z1 + solfa_pen_radius * (1, -1 * offset))
1232 .. ((top z3) + (0, offset * solfa_pen_radius))
1234 -- (z5 + solfa_pen_radius * (-1, -1 * offset))
1247 charwy := curve_start [-chardp, charht];
1258 fet_beginchar ("Whole rehead", "s0re");
1259 draw_re_head (solfa_whole_width, 1, re_weight);
1265 fet_beginchar ("Half up rehead", "u1re");
1266 draw_re_head (solfa_half_width, 1, re_weight);
1272 fet_beginchar ("Half down rehead", "d1re");
1273 draw_re_head (solfa_half_width, -1, re_weight);
1279 fet_beginchar ("Quart up rehead", "u2re");
1280 draw_re_head (solfa_quarter_width, 1, re_weight);
1285 fet_beginchar ("Quart down rehead", "d2re");
1286 draw_re_head (solfa_quarter_width, -1, re_weight);
1291 fet_beginchar ("Whole thin rehead", "s0reThin");
1292 draw_re_head (solfa_whole_width, 1, 1);
1298 fet_beginchar ("Half up thin rehead", "u1reThin");
1299 draw_re_head (solfa_half_width, 1, 1);
1305 fet_beginchar ("Half down thin rehead", "d1reThin");
1306 draw_re_head (solfa_half_width, -1, 1);
1312 fet_beginchar ("Quart thin rehead", "u2reThin");
1313 draw_re_head (solfa_quarter_width, 1, 1);
1318 fet_beginchar ("Quart thin rehead", "d2reThin");
1319 draw_re_head (solfa_quarter_width, -1, 1);
1324 %%%% mi head -- diamond shape
1326 % two versions, depending on whether the `strong' lines are on the nw & se
1329 def draw_mi_head (expr width_factor, thickness_factor, mirror) =
1330 save path_out, path_in;
1331 save ne_dist, se_dist, ne, se;
1332 save path_a, path_b, path_c, path_d;
1333 path path_out, path_in;
1334 pair ne_dist, se_dist, ne, se;
1335 path path_a, path_b, path_c, path_d;
1339 set_char_box (0, width_factor * solfa_base_notewidth#,
1340 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1342 pickup pencircle scaled solfa_pen_thick;
1345 offset := 2 * thickness_factor - 1;
1356 % inner sides are parallel to outer sides
1357 z6 - z5 = whatever * (z2 - z1);
1358 z8 - z7 = whatever * (z4 - z3);
1359 z8 - z5 = whatever * (z4 - z1);
1360 z7 - z6 = whatever * (z3 - z2);
1362 ne = unitvector (z4 - z1);
1363 se = unitvector (z2 - z1);
1365 ne_dist = (ne rotated 90) * solfa_pen_radius;
1366 se_dist = (se rotated 90) * solfa_pen_radius;
1368 path_a := (z1 + se_dist)
1370 path_b := (z2 + (ne_dist * offset))
1371 -- (z3 + (ne_dist * offset));
1372 path_c := (z3 - se_dist)
1374 path_d := (z4 - (ne_dist * offset))
1375 -- (z1 - (ne_dist * offset));
1377 z5 = path_a intersectionpoint path_d;
1378 z7 = path_b intersectionpoint path_c;
1380 labels (range 1 thru 8);
1389 path_in := inner_path;
1391 path_in := inner_path reflectedabout (z2, z4);
1394 path_out := lft z1 {down}
1395 .. (z1 - se_dist){se}
1396 -- (z2 - se_dist){se}
1398 .. (z2 - ne_dist){ne}
1399 -- (z3 - ne_dist){ne}
1401 .. (z3 + se_dist){-se}
1402 -- (z4 + se_dist){-se}
1404 .. (z4 + ne_dist){-ne}
1405 -- (z1 + ne_dist){-ne}
1410 save mi_weight, mi_width;
1414 fet_beginchar ("Whole mihead", "s0mi");
1415 draw_mi_head (mi_width * solfa_whole_width, mi_weight, false);
1421 fet_beginchar ("Half mihead", "s1mi");
1422 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1428 fet_beginchar ("Quart mihead", "s2mi");
1429 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1434 fet_beginchar ("Whole mirror mihead", "s0miMirror");
1435 draw_mi_head (mi_width * solfa_whole_width, mi_weight, true);
1441 fet_beginchar ("Half mirror mihead", "s1miMirror");
1442 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1448 fet_beginchar ("Quart mirror mihead", "s2miMirror");
1449 draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1454 fet_beginchar ("Whole thin mihead", "s0miThin");
1455 draw_mi_head (mi_width * solfa_whole_width, 1, false);
1461 fet_beginchar ("Half thin mihead", "s1miThin");
1462 draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1468 fet_beginchar ("Quart thin mihead", "s2miThin");
1469 draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1476 % Right triangle, hypotenuse from nw to se corner. Stem attaches on
1477 % vertical side in direction of horizontal side.
1479 def draw_fa_head (expr width_factor, thickness_factor) =
1480 set_char_box (0, width_factor * solfa_base_notewidth#,
1481 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1483 save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1484 path p_down_in, p_down_out, p_up_in, p_up_out;
1485 save path_a, path_b, path_c;
1486 path path_a, path_b, path_c;
1490 offset := 2 * thickness_factor - 0.5;
1492 pickup pencircle scaled solfa_pen_thick;
1505 labels (1, 2, 3, 4);
1507 nw = unitvector (z1 - z3);
1508 nw_dist = (nw rotated 90) * solfa_pen_radius;
1510 path_a := (z1 - (0,1) * offset * solfa_pen_radius)
1511 -- (z2 - (0,1) * offset * solfa_pen_radius);
1512 path_b := (z2 - (1,0) * solfa_pen_radius)
1513 -- (z3 - (1,0) * solfa_pen_radius);
1514 path_c := (z3 - nw_dist)
1517 p_up_in := (path_a intersectionpoint path_b)
1518 -- (path_b intersectionpoint path_c)
1519 -- (path_c intersectionpoint path_a)
1522 p_up_out := lft z1{down}
1523 .. (z1 + nw_dist){-nw}
1524 -- (z3 + nw_dist){-nw}
1532 p_down_in := p_up_in rotated 180 shifted (w, 0);
1533 p_down_out := p_up_out rotated 180 shifted (w, 0);
1542 fet_beginchar ("Whole fa up head", "u0fa");
1543 draw_fa_head (solfa_whole_width, fa_weight);
1549 fet_beginchar ("Whole fa down head", "d0fa");
1550 draw_fa_head (solfa_whole_width, fa_weight);
1556 fet_beginchar ("half fa up head", "u1fa");
1557 draw_fa_head (solfa_half_width, fa_weight);
1563 fet_beginchar ("Half fa down head", "d1fa");
1564 draw_fa_head (solfa_half_width, fa_weight);
1570 fet_beginchar ("Quarter fa up head", "u2fa");
1571 draw_fa_head (solfa_quarter_width, fa_weight);
1576 fet_beginchar ("Quarter fa down head", "d2fa");
1577 draw_fa_head (solfa_quarter_width, fa_weight);
1582 fet_beginchar ("Whole thin fa up head", "u0faThin");
1583 draw_fa_head (solfa_whole_width, 1);
1589 fet_beginchar ("Whole thin fa down head", "d0faThin");
1590 draw_fa_head (solfa_whole_width, 1);
1596 fet_beginchar ("half thin fa up head", "u1faThin");
1597 draw_fa_head (solfa_half_width, 1);
1603 fet_beginchar ("Half thin fa down head", "d1faThin");
1604 draw_fa_head (solfa_half_width, 1);
1610 fet_beginchar ("Quarter thin fa up head", "u2faThin");
1611 draw_fa_head (solfa_quarter_width, 1);
1616 fet_beginchar ("Quarter thin fa down head", "d2faThin");
1617 draw_fa_head (solfa_quarter_width, 1);
1625 % Note: sol head is the same shape as a standard music head, and doesn't
1626 % vary from style to style. However, width is constant with duration,
1627 % so we can't just use the standard note font.
1629 def draw_sol_head (expr filled) =
1630 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
1632 undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
1634 draw_staff (-2, 2, 0);
1637 fet_beginchar ("Whole solhead", "s0sol");
1638 draw_sol_head ( false);
1642 fet_beginchar ("Half solhead", "s1sol");
1643 draw_sol_head ( false);
1647 fet_beginchar ("Quart solhead", "s2sol");
1648 draw_sol_head ( true);
1656 def draw_la_head (expr width_factor, thickness_factor) =
1657 set_char_box (0, width_factor * solfa_base_notewidth#,
1658 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1662 pickup pencircle scaled solfa_pen_thick;
1665 offset := 2 * thickness_factor - 1;
1678 labels (range 1 thru 4);
1680 p_in := (z1 + solfa_pen_radius * (1, -offset))
1681 -- (z2 + solfa_pen_radius * (-1, -offset))
1682 -- (z3 + solfa_pen_radius * (-1, offset))
1683 -- (z4 + solfa_pen_radius * (1, offset))
1701 fet_beginchar ("Whole lahead", "s0la");
1702 draw_la_head (solfa_whole_width, la_weight);
1708 fet_beginchar ("Half lahead", "s1la");
1709 draw_la_head (solfa_half_width, la_weight);
1715 fet_beginchar ("Quart lahead", "s2la");
1716 draw_la_head (solfa_quarter_width, la_weight);
1721 fet_beginchar ("Whole thin lahead", "s0laThin");
1722 draw_la_head (solfa_whole_width, 1);
1728 fet_beginchar ("Half thin lahead", "s1laThin");
1729 draw_la_head (solfa_half_width, 1);
1735 fet_beginchar ("Quart lahead", "s2laThin");
1736 draw_la_head (solfa_quarter_width, 1);
1743 % `Snow-cone', V with rounded top.
1745 def draw_ti_head (expr width_factor, dir, thickness_factor) =
1746 set_char_box (0, width_factor * solfa_base_notewidth#,
1747 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1748 save p_in, p_out, p_top, p_top_in;
1749 path p_in, p_out, p_top, p_top_in;
1754 offset := 2 * thickness_factor - 1;
1756 pickup pencircle scaled solfa_pen_thick;
1761 y2 = cone_height [y1, y3];
1767 y5 = y1 + offset * solfa_pen_radius;
1769 labels (range 1 thru 4);
1771 save nw_dist, sw_dist, nw, sw;
1772 pair nw_dist, sw_dist, nw, sw;
1774 nw = unitvector (z2 - z1);
1775 sw = unitvector (z1 - z4);
1777 nw_dist = (nw rotated 90) * solfa_pen_radius;
1778 sw_dist = (sw rotated 90) * solfa_pen_radius;
1780 p_top := (z2 + nw * solfa_pen_radius)
1782 .. (z4 - sw * solfa_pen_radius);
1784 p_top_in := (z2 - nw * offset * solfa_pen_radius)
1785 .. (z3 - (0,1) * solfa_pen_radius) {right}
1786 .. (z4 + sw * offset * solfa_pen_radius);
1788 save path_a, path_b;
1789 path path_a, path_b;
1795 z6 = path_a intersectionpoint p_top_in;
1796 z7 = path_b intersectionpoint p_top_in;
1808 .. (z2 + nw * solfa_pen_radius){direction 0 of p_top}
1810 & {direction infinity of p_top}(z4 - sw * solfa_pen_radius)
1817 charwy := cone_height [-chardp, charht];
1827 fet_beginchar ("Whole up tihead", "s0ti");
1828 draw_ti_head (solfa_whole_width, 1, ti_weight);
1834 fet_beginchar ("Half up tihead", "u1ti");
1835 draw_ti_head (solfa_half_width, 1, ti_weight);
1841 fet_beginchar ("Half down tihead", "d1ti");
1842 draw_ti_head (solfa_half_width, -1, ti_weight);
1848 fet_beginchar ("Quart up tihead", "u2ti");
1849 draw_ti_head (solfa_quarter_width, 1, ti_weight);
1854 fet_beginchar ("Quart down tihead", "d2ti");
1855 draw_ti_head (solfa_quarter_width, -1, ti_weight);
1860 fet_beginchar ("Whole thin up tihead", "s0tiThin");
1861 draw_ti_head (solfa_whole_width, 1, 1);
1867 fet_beginchar ("Half thin up tihead", "u1tiThin");
1868 draw_ti_head (solfa_half_width, 1, 1);
1874 fet_beginchar ("Half thin down tihead", "d1tiThin");
1875 draw_ti_head (solfa_half_width, -1, 1);
1881 fet_beginchar ("Quart thin up tihead", "u2tiThin");
1882 draw_ti_head (solfa_quarter_width, 1, 1);
1887 fet_beginchar ("Quart thin down tihead", "d2tiThin");
1888 draw_ti_head (solfa_quarter_width, -1, 1);
1893 %%%%%% Funk shape note heads
1895 % Funk heads are narrower than Aiken and Sacred Harp, so we need a new
1898 funk_notehead_width := 0.75;
1902 % Parabolic on one side, vertical line on other
1903 % Has up and down shapes for *all* notes
1905 def draw_Funk_do_head (expr width_factor, thickness_factor) =
1906 set_char_box (0, width_factor * solfa_base_notewidth#,
1907 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1909 pickup pencircle scaled solfa_pen_thick;
1911 offset := 2 * thickness_factor - 1;
1922 x4 = x1 - solfa_pen_radius;
1923 y4 = y1 + offset * solfa_pen_radius;
1926 x5 = x2 + solfa_pen_radius;
1929 y6 = y3 - offset * solfa_pen_radius;
1931 save p_up_in, p_up_out, p_down_in, p_down_out;
1932 path p_up_in, p_up_out, p_down_in, p_down_out;
1934 p_down_in := z4{left}
1939 p_down_out := bot z1{left}
1946 p_up_in := p_down_in rotated 180 shifted (w,0);
1947 p_up_out := p_down_out rotated 180 shifted (w,0);
1952 save funk_do_weight;
1953 funk_do_weight := 1.7;
1955 fet_beginchar ("Whole up Funk dohead", "u0doFunk");
1956 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1962 fet_beginchar ("Whole down Funk dohead", "d0doFunk");
1963 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1969 fet_beginchar ("Half up Funk dohead", "u1doFunk");
1970 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1976 fet_beginchar ("Half down Funk dohead", "d1doFunk");
1977 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1983 fet_beginchar ("Quarter up Funk dohead", "u2doFunk");
1984 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1989 fet_beginchar ("Quarter down Funk dohead", "d2doFunk");
1990 draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1997 % Has up and down shapes for *all* notes
1999 def draw_Funk_re_head (expr width_factor, thickness_factor) =
2000 set_char_box (0, width_factor * solfa_base_notewidth#,
2001 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2003 pickup pencircle scaled solfa_pen_thick;
2005 offset := 2 * thickness_factor - 1;
2016 x3 := curve_in [x1, x2];
2024 save ne, se, ne_perp, se_perp;
2025 pair ne, se, ne_perp, se_perp;
2027 ne := unitvector (z2 - z1);
2028 se := unitvector (z4 - z1);
2029 ne_perp := ne rotated 90;
2030 se_perp := se rotated 90;
2032 save path_a, path_b, path_c, path_d;
2033 path path_a, path_b, path_c, path_d;
2034 save arrow_a_perp, arrow_b_perp;
2035 pair arrow_a_perp, arrow_b_perp;
2038 path_d := z2 .. z3{down} .. z4;
2039 arrow_a_perp = unitvector (direction 0 of path_d rotated 90)
2041 arrow_b_perp = unitvector (direction 1 of path_d rotated 90)
2044 path_b := (z1 + se_perp * solfa_pen_radius)
2045 -- z4 + se_perp * offset * solfa_pen_radius;
2046 path_a := (z1 - ne_perp * solfa_pen_radius)
2047 -- z2 - ne_perp * offset * solfa_pen_radius;
2048 path_c := z2 - arrow_a_perp
2050 .. z4 - arrow_b_perp;
2052 z5 = path_a intersectionpoint path_b;
2053 z7 = path_a intersectionpoint path_c;
2054 z8 = path_b intersectionpoint path_c;
2056 save p_up_in, p_down_in, p_up_out, p_down_out;
2057 path p_up_in, p_down_in, p_up_out, p_down_out;
2065 p_down_out := lft z1{up}
2066 .. (z1 + ne_perp * solfa_pen_radius){ne}
2067 -- (z2 + ne_perp * solfa_pen_radius){ne}
2070 .. (z2 + arrow_a_perp)
2072 .. (z4 + arrow_b_perp)
2075 .. z4 - se_perp * solfa_pen_radius
2076 -- z1 - se_perp * solfa_pen_radius
2079 p_up_in := p_down_in rotated 180 shifted (w, 0);
2080 p_up_out := p_down_out rotated 180 shifted (w, 0);
2085 save funk_re_weight;
2086 funk_re_weight = 1.7;
2088 fet_beginchar ("Whole up Funk rehead", "u0reFunk");
2089 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2095 fet_beginchar ("Whole down Funk rehead", "d0reFunk");
2096 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2102 fet_beginchar ("Half up Funk rehead", "u1reFunk");
2103 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2109 fet_beginchar ("Half down Funk rehead", "d1reFunk");
2110 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2116 fet_beginchar ("Quarter up Funk rehead", "u2reFunk");
2117 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2122 fet_beginchar ("Quarter down Funk rehead", "d2reFunk");
2123 draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2130 % Has up and down shapes for all hollow notes
2132 save funk_mi_width, funk_mi_weight;
2133 funk_mi_width := 1.2;
2134 funk_mi_weight := 1.9;
2136 fet_beginchar ("Whole up Funk mihead", "u0miFunk");
2137 draw_mi_head (funk_mi_width * funk_notehead_width,
2138 funk_mi_weight, false);
2144 fet_beginchar ("Whole down Funk mihead", "d0miFunk");
2145 draw_mi_head (funk_mi_width * funk_notehead_width,
2146 funk_mi_weight, true);
2152 fet_beginchar ("Half up Funk mihead", "u1miFunk");
2153 draw_mi_head (funk_mi_width * funk_notehead_width,
2154 funk_mi_weight, false);
2160 fet_beginchar ("Half down Funk mihead", "d1miFunk");
2161 draw_mi_head (funk_mi_width * funk_notehead_width,
2162 funk_mi_weight, true);
2168 fet_beginchar ("Quarter Funk mihead", "s2miFunk");
2169 draw_mi_head (funk_mi_width * funk_notehead_width,
2170 funk_mi_weight, false);
2177 % Does it rotate for whole notes?
2178 % Same as other shape note systems
2179 % Need special notes because of special width
2181 save funk_fa_weight;
2182 funk_fa_weight := 1.9;
2184 fet_beginchar ("Whole up Funk fahead", "u0faFunk");
2185 draw_fa_head (funk_notehead_width, funk_fa_weight);
2191 fet_beginchar ("Whole down Funk fahead", "d0faFunk");
2192 draw_fa_head (funk_notehead_width, funk_fa_weight);
2198 fet_beginchar ("Half up Funk fahead", "u1faFunk");
2199 draw_fa_head (funk_notehead_width, funk_fa_weight);
2205 fet_beginchar ("Half down Funk fahead", "d1faFunk");
2206 draw_fa_head (funk_notehead_width, funk_fa_weight);
2212 fet_beginchar ("Quarter up Funk fahead", "u2faFunk");
2213 draw_fa_head (funk_notehead_width, funk_fa_weight);
2218 fet_beginchar ("Quarter down Funk fahead", "d2faFunk");
2219 draw_fa_head (funk_notehead_width, funk_fa_weight);
2224 %%%%%% Funk sol head is the same as the others
2225 % Need special character because of skinnier head
2227 def draw_Funk_sol_head (expr filled) =
2230 noteheight# := solfa_noteheight#;
2231 draw_outside_ellipse (1.2, 34, 0.71, 0.);
2233 undraw_inside_ellipse (1.9, 33, 0.74, 5.5 stafflinethickness#);
2235 draw_staff (-2, 2, 0);
2240 fet_beginchar ("Whole Funk solhead", "s0solFunk");
2241 draw_Funk_sol_head ( false);
2245 fet_beginchar ("Half Funk solhead", "s1solFunk");
2246 draw_Funk_sol_head ( false);
2250 fet_beginchar ("Quarter Funk solhead", "s2solFunk");
2251 draw_Funk_sol_head ( true);
2257 % Same as for other shape notes
2258 % Smaller width requires special characters
2260 save funk_la_weight;
2261 funk_la_weight := 1.9;
2263 fet_beginchar ("Whole Funk lahead", "s0laFunk");
2264 draw_la_head (funk_notehead_width, funk_notehead_width);
2270 fet_beginchar ("Half Funk lahead", "s1laFunk");
2271 draw_la_head (funk_notehead_width, funk_notehead_width);
2277 fet_beginchar ("Quart Funk lahead", "s2laFunk");
2278 draw_la_head (funk_notehead_width, funk_notehead_width);
2284 % `Sideways snow cone'.
2285 % Rotates for all notes.
2287 def draw_Funk_ti_head (expr width_factor, thickness_factor) =
2288 set_char_box (0, width_factor * solfa_base_notewidth#,
2289 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2294 offset := 2 * thickness_factor - 1;
2296 pickup pencircle scaled solfa_pen_thick;
2301 x2 = cone_width [x1, x3];
2310 save nw_dist, sw_dist, ne, se;
2311 pair nw_dist, sw_dist, ne, se;
2313 ne = unitvector (z2 - z1);
2314 se = unitvector (z4 - z1);
2316 nw_dist = (ne rotated 90) * solfa_pen_radius ;
2317 sw_dist = (se rotated -90) * solfa_pen_radius;
2319 save path_a, path_b;
2320 path path_a, path_b;
2321 path_a := z1 - nw_dist
2322 -- z2 - offset * nw_dist;
2323 path_b := z1 - sw_dist
2324 -- z4 - offset * sw_dist;
2326 save path_right, path_right_in;
2327 path path_right, path_right_in;
2328 path_right := (z2 + ne * solfa_pen_radius)
2330 .. (z4 + se * solfa_pen_radius);
2332 path_right_in := (z2 - ne * solfa_pen_radius)
2334 .. (z4 - se * solfa_pen_radius);
2336 z5 = path_a intersectionpoint path_b;
2337 z6 = path_a intersectionpoint path_right_in;
2338 z7 = path_b intersectionpoint path_right_in;
2340 save p_up_in, p_down_in, p_up_out, p_down_out;
2341 path p_up_in, p_down_in, p_up_out, p_down_out;
2349 p_down_out := lft z1
2353 .. (z2 + ne * solfa_pen_radius){direction 0 of path_right}
2355 & {direction infinity of path_right}(z4 + se * solfa_pen_radius)
2361 p_up_in := p_down_in rotated 180 shifted (w, 0);
2362 p_up_out := p_down_out rotated 180 shifted (w, 0);
2366 save funk_ti_weight;
2367 funk_ti_weight := 1.6;
2369 fet_beginchar ("Whole up Funk tihead", "u0tiFunk");
2370 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2376 fet_beginchar ("Whole down Funk tihead", "d0tiFunk");
2377 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2383 fet_beginchar ("Half up Funk tihead", "u1tiFunk");
2384 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2390 fet_beginchar ("Half down Funk tihead", "d1tiFunk");
2391 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2397 fet_beginchar ("Quarter up Funk tihead", "u2tiFunk");
2398 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2403 fet_beginchar ("Quarter down Funk tihead", "d2tiFunk");
2404 draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2409 %%%%%% Walker shape note heads
2411 % Walker heads are narrow like Funk heads, so use funk_notehead_width.
2414 %%%%%% Walker do head
2416 % Trapezoid, with largest side on stem side
2418 def draw_Walker_do_head (expr width_factor, dir, thickness_factor) =
2419 set_char_box (0, width_factor * solfa_base_notewidth#,
2420 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2422 pickup pencircle scaled solfa_pen_thick;
2425 offset := 2 * thickness_factor - 1;
2427 % adjust width so stem can be centered
2428 if .5w <> good.x .5w: change_width; fi
2432 scaling# = charwd / w;
2437 x1 = inset [x4, x3];
2440 x2 = inset [x3, x4];
2449 labels (range 1 thru 4);
2451 save left_dir, left_perp, right_dir, right_perp;
2452 pair left_dir, left_perp, right_dir, right_perp;
2454 left_dir = unitvector(z1 - z4);
2455 left_perp = (left_dir rotated 90) * solfa_pen_radius;
2456 right_dir = unitvector(z3 - z2);
2457 right_perp = (right_dir rotated 90) * solfa_pen_radius;
2459 save path_a, path_b, path_c, path_d;
2460 path path_a, path_b, path_c, path_d;
2462 path_a := (z4 - left_perp)
2463 -- (z1 - left_perp);
2464 path_b := (z1 - (0, offset*solfa_pen_radius))
2465 -- (z2 - (0, offset*solfa_pen_radius));
2466 path_c := (z2 - right_perp)
2467 -- (z3 - right_perp);
2468 path_d := (z3 + (0, offset*solfa_pen_radius))
2469 -- (z4 + (0, offset*solfa_pen_radius));
2474 p_in := (path_a intersectionpoint path_b)
2475 -- (path_b intersectionpoint path_c)
2476 -- (path_c intersectionpoint path_d)
2477 -- (path_d intersectionpoint path_a)
2480 p_out := top z1{right}
2482 .. z2 + right_perp {right_dir}
2483 -- z3 + right_perp {right_dir}
2486 .. z4 + left_perp {left_dir}
2487 .. z1 + left_perp {left_dir}
2490 charwx := scaling# * (w/2 + solfa_pen_radius);
2491 charwy := scaling# * y2 ;
2494 p_in := p_in rotated 180 shifted (w,0);
2495 p_out := p_out rotated 180 shifted (w,0);
2500 save walker_do_weight;
2501 walker_do_weight := 1.5;
2503 fet_beginchar ("Whole Walker dohead", "s0doWalker");
2504 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2510 fet_beginchar ("Half up Walker dohead", "u1doWalker");
2511 draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2517 fet_beginchar ("Half down Walker dohead", "d1doWalker");
2518 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2524 fet_beginchar ("Quarter up Walker dohead", "u2doWalker");
2525 draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2530 fet_beginchar ("Quarter down Walker dohead", "d2doWalker");
2531 draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2536 %%%%%% Walker re head
2537 % Parabolic on one side, shallow parabola on other
2538 % Has up and down shapes for *all* notes
2540 def draw_Walker_re_head (expr width_factor, thickness_factor) =
2541 set_char_box (0, width_factor * solfa_base_notewidth#,
2542 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2544 pickup pencircle scaled solfa_pen_thick;
2546 offset := 2 * thickness_factor - 1;
2549 dish_factor := 0.20;
2560 x4 = dish_factor [x1, x2];
2564 y5 = y1 + offset * solfa_pen_radius;
2567 x6 = x2 + solfa_pen_radius;
2570 y7 = y3 - offset * solfa_pen_radius;
2573 x8 = x4 - solfa_pen_radius;
2575 save path_a, path_d;
2576 path path_a, path_d;
2578 save p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2579 pair p_a_start_dir, p_a_end_dir, p_a_start_perp, p_a_end_perp;
2581 path_a := z3 .. z4{down} .. z1;
2583 p_a_start_dir := unitvector(direction 0 of path_a);
2584 p_a_end_dir := unitvector(direction infinity of path_a);
2585 p_a_start_perp := (p_a_start_dir rotated 90) * solfa_pen_radius;
2586 p_a_end_perp := (p_a_end_dir rotated 90) * solfa_pen_radius;
2588 path_d := (z3 - p_a_start_perp){p_a_start_dir}
2590 ..(z1 - p_a_end_perp){p_a_end_dir};
2592 save path_b, path_c;
2593 path path_b, path_c;
2595 path_b := z5 {left} .. z6{up};
2596 path_c := z7 {left} .. z6{down};
2598 z9 = path_d intersectionpoint path_b;
2599 z10 = path_d intersectionpoint path_c;
2601 labels (range 1 thru 4);
2603 save p_in_dir_b, p_in_dir_c;
2604 pair p_in_dir_b, p_in_dir_c;
2606 p_in_dir_b := unitvector (direction 0.4 of path_b);
2607 p_in_dir_c := unitvector (direction 0.4 of path_c);
2609 save p_up_in, p_up_out, p_down_in, p_down_out;
2610 path p_up_in, p_up_out, p_down_in, p_down_out;
2612 p_down_in := z6{up} .. tension 1 and 1.5
2613 .. {- p_in_dir_c} z10 {p_a_start_dir}
2615 .. {p_a_end_dir} z9 {p_in_dir_b} .. tension 1.5 and 1
2618 p_down_out := lft z2{up}
2621 .. (z3 + p_a_start_perp){p_a_start_dir}
2623 .. (z1 + p_a_end_perp) {p_a_end_dir}
2628 p_up_in := p_down_in rotated 180 shifted (w,0);
2629 p_up_out := p_down_out rotated 180 shifted (w,0);
2633 save walker_re_weight;
2634 walker_re_weight := 1.5;
2636 fet_beginchar ("Whole Walker rehead", "s0reWalker");
2637 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2643 fet_beginchar ("Half up Walker rehead", "u1reWalker");
2644 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2650 fet_beginchar ("Half down Walker rehead", "d1reWalker");
2651 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2657 fet_beginchar ("Quarter up Walker rehead", "u2reWalker");
2658 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2663 fet_beginchar ("Quarter down Walker rehead", "d2reWalker");
2664 draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2669 %%%%%% Walker mi head
2671 % Symmetric for all hollow notes
2673 save walker_mi_width, walker_mi_weight;
2674 walker_mi_width := 1.2;
2675 walker_mi_weight := 1.5;
2677 fet_beginchar ("Whole Walker mihead", "s0miWalker");
2678 draw_mi_head (walker_mi_width * funk_notehead_width,
2679 walker_mi_weight, true);
2685 fet_beginchar ("Half Walker mihead", "s1miWalker");
2686 draw_mi_head (walker_mi_width * funk_notehead_width,
2687 walker_mi_weight, true);
2693 fet_beginchar ("Quarter Walker mihead", "s2miWalker");
2694 draw_mi_head (walker_mi_width * funk_notehead_width,
2695 walker_mi_weight, true);
2702 % Does not rotate for whole notes
2703 % Whole rotation is different from Funk, so special notes
2705 %%%%%% Funk sol head is the same as the others
2706 % Need special character because of skinnier head
2708 save walker_fa_weight;
2709 walker_fa_weight := 1.5;
2711 fet_beginchar ("Whole Walker fahead", "s0faWalker");
2712 draw_fa_head (funk_notehead_width, walker_fa_weight);
2718 fet_beginchar ("Half up Walker fahead", "u1faWalker");
2719 draw_fa_head (funk_notehead_width, walker_fa_weight);
2725 fet_beginchar ("Half down Walker fahead", "d1faWalker");
2726 draw_fa_head (funk_notehead_width, walker_fa_weight);
2732 fet_beginchar ("Quarter up Walker fahead", "u2faWalker");
2733 draw_fa_head (funk_notehead_width, walker_fa_weight);
2738 fet_beginchar ("Quarter down Walker fahead", "d2faWalker");
2739 draw_fa_head (funk_notehead_width, walker_fa_weight);
2745 % Same as Funk, no special notes
2748 %%%%%% Walker la head
2750 % Lighter weight requires separate notes
2752 save walker_la_weight;
2753 walker_la_weight := 1.5;
2755 fet_beginchar ("Whole Walker lahead", "s0laWalker");
2756 draw_la_head (funk_notehead_width, walker_la_weight);
2762 fet_beginchar ("Half Funk lahead", "s1laWalker");
2763 draw_la_head (funk_notehead_width, walker_la_weight);
2769 fet_beginchar ("Quart Funk lahead", "s2laWalker");
2770 draw_la_head (funk_notehead_width, walker_la_weight);
2775 %%%%%% Walker ti head
2776 % Triangular arrowhead
2777 % Rotates for all but whole notes
2779 def draw_Walker_ti_head (expr width_factor, thickness_factor) =
2780 set_char_box (0, width_factor * solfa_base_notewidth#,
2781 0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
2784 offset := 2 * thickness_factor - 1;
2786 pickup pencircle scaled solfa_pen_thick;
2798 labels (range 1 thru 4);
2800 save nw_dist, sw_dist, ne, se;
2801 pair nw_dist, sw_dist, ne, se;
2803 ne = unitvector (z2 - z1);
2804 se = unitvector (z3 - z1);
2806 nw_dist = (ne rotated 90) * solfa_pen_radius ;
2807 sw_dist = (se rotated -90) * solfa_pen_radius;
2810 save path_a, path_b, path_c;
2811 path path_a, path_b, path_c;
2812 path_a := z2 - nw_dist * offset
2813 -- z1 - nw_dist * offset;
2814 path_b := z3 - sw_dist * offset
2815 -- z1 - sw_dist * offset;
2816 path_c := z2 + left * solfa_pen_radius
2817 -- z3 + left * solfa_pen_radius;
2819 z4 = path_a intersectionpoint path_b;
2820 z5 = path_a intersectionpoint path_c;
2821 z6 = path_b intersectionpoint path_c;
2823 save p_up_in, p_down_in, p_up_out, p_down_out;
2824 path p_up_in, p_down_in, p_up_out, p_down_out;
2831 p_down_out := lft z1{up}
2832 .. (z1 + nw_dist){ne}
2833 -- (z2 + nw_dist){ne}
2838 .. (z3 + sw_dist){- se}
2839 .. (z1 + sw_dist){- se}
2842 p_up_in := p_down_in rotated 180 shifted (w, 0);
2843 p_up_out := p_down_out rotated 180 shifted (w, 0);
2847 save walker_ti_weight;
2848 walker_ti_weight := 1.4;
2850 fet_beginchar ("Whole Walker tihead", "s0tiWalker");
2851 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2857 fet_beginchar ("Half up Walker tihead", "u1tiWalker");
2858 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2864 fet_beginchar ("Half down Walker tihead", "d1tiWalker");
2865 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2871 fet_beginchar ("Quarter up Walker tihead", "u2tiWalker");
2872 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2877 fet_beginchar ("Quarter down Walker tihead", "d2tiWalker");
2878 draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2882 fet_endgroup ("noteheads");
2886 % we derive black_notehead_width# from the quarter head,
2887 % so we have to define black_notehead_width (pixel qty)
2888 % after the black_notehead_width# itself.
2890 % Let's keep it outside the group as well.
2893 define_pixels (black_notehead_width);