]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-noteheads.mf
Merge branch 'lilypond/translation'
[lilypond.git] / mf / feta-noteheads.mf
1 % Feta (not the Font-En-Tja) music font -- implement noteheads
2 % This file is part of LilyPond, the GNU music typesetter.
3 %
4 % Copyright (C) 1997--2010 Jan Nieuwenhuizen <janneke@gnu.org>
5 % & Han-Wen Nienhuys <hanwen@xs4all.nl>
6 % & Juergen Reuter <reuter@ipd.uka.de>
7 %
8 %
9 % LilyPond is free software: you can redistribute it and/or modify
10 % it under the terms of the GNU General Public License as published by
11 % the Free Software Foundation, either version 3 of the License, or
12 % (at your option) any later version.
13 %
14 % LilyPond is distributed in the hope that it will be useful,
15 % but WITHOUT ANY WARRANTY; without even the implied warranty of
16 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 % GNU General Public License for more details.
18 %
19 % You should have received a copy of the GNU General Public License
20 % along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
21
22 test_outlines := 0;
23
24
25 save remember_pic;
26 picture remember_pic;
27
28
29 % Most beautiful noteheads are pronounced, not circular,
30 % and not even symmetric.
31 % These examples are inspired by [Wanske]; see literature list.
32
33
34
35 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36 % NOTE HEAD VARIABLES
37 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
38
39 save black_notehead_width, noteheight;
40 save half_notehead_width, whole_notehead_width, slash_thick;
41 save slash_slope, overdone_heads, solfa_noteheight;
42
43 numeric noteheight;
44 numeric slash_thick;
45 numeric black_notehead_width;
46 numeric whole_notehead_width;
47 numeric half_notehead_width;
48
49
50 fet_begingroup ("noteheads");
51
52
53 % Slope of slash.  From scm/grob-description.scm.  How to auto-copy?
54 slash_slope := 1.7;
55
56 % Thickness of slash lines.  Quarter notes get 1.5slt width.
57 slash_thick# := 2/3 * 0.48 staff_space#;
58
59
60 %
61 % Hand-engraved music often has balls extending above and below
62 % the lines.  If you like that, modify overdone heads (unit:
63 % stafflinethickness).
64 %
65 overdone_heads = 0.0;
66 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
67
68
69 %
70 % solfa heads should not overlap on chords.
71 %
72 solfa_noteheight# := staff_space# - stafflinethickness#;
73
74 define_pixels (slash_thick);
75 define_whole_vertical_pixels (noteheight);
76
77
78 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79 %
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
82 % axis one).
83 %
84
85 def draw_outside_ellipse (expr ellipticity, tilt, superness, slant) =
86         save attachment_y;
87         save pat;
88         path pat;
89
90         pat := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
91                              (-ellipticity, 0), (slant * ellipticity, -1.0),
92                              superness);
93         pat := pat rotated tilt;
94
95         save top_point, right_point;
96         pair top_point, right_point;
97
98         top_point := directionpoint left of pat;
99         right_point := directionpoint up of pat;
100
101         save scaling, width;
102
103         scaling# = noteheight# / (2 ypart (top_point));
104         width# := 2 xpart (right_point) * scaling#;
105         define_pixels (scaling, width);
106
107         set_char_box (0, width#, noteheight# / 2, noteheight# / 2);
108
109         d := d - feta_space_shift;
110
111         % attachment Y
112         charwy := ypart (right_point) * scaling#;
113         charwx := width#;
114
115         pat := pat scaled scaling shifted (w / 2, .5 (h - d));
116
117         width := hround width;
118
119         if test_outlines = 1:
120                 draw pat;
121         else:
122                 fill pat;
123         fi;
124 enddef;
125
126
127 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) =
128 begingroup
129         save pat;
130         path pat;
131
132         pat := superellipse ((ellipticity, 0), (0, 1.0),
133                              (-ellipticity, 0), (0, -1.0),
134                              superness);
135         pat := pat rotated tilt;
136
137         save top_point, right_point;
138         pair top_point, right_point;
139
140         top_point := directionpoint left of pat;
141         right_point := directionpoint up of pat;
142
143         save height, scaling;
144
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));
149
150         if test_outlines = 1:
151                 draw pat;
152         else:
153                 unfill pat;
154         fi
155 endgroup;
156 enddef;
157
158
159 %
160 % dimensions aren't entirely right.
161 %
162 def draw_longa (expr up) =
163         save stemthick, fudge;
164
165         stemthick# = 2 stafflinethickness#;
166         define_whole_blacker_pixels (stemthick);
167
168         fudge = hround (blot_diameter / 2);
169
170         draw_outside_ellipse (1.80, 0, 0.707, 0);
171         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
172
173         pickup pencircle scaled stemthick;
174
175         if up:
176                 bot y1 = -d;
177                 top y2 = h;
178                 rt x1 - fudge = 0;
179                 x1 = x2;
180
181                 fudge + lft x3 = w;
182                 x4 = x3;
183                 top y4 = h + 3.0 staff_space;
184                 y3 = y1;
185         else:
186                 bot y1 = -d - 3.0 staff_space;
187                 top y2 = h;
188                 rt x1 - fudge = 0;
189                 x1 = x2;
190
191                 fudge + lft x3 = w;
192                 x4 = x3;
193                 y4 = y2;
194                 bot y3 = -d;
195         fi;
196
197         draw_gridline (z1, z2, stemthick);
198         draw_gridline (z3, z4, stemthick);
199
200         labels (1, 2, 3, 4);
201 enddef;
202
203
204 fet_beginchar ("Longa notehead", "uM2");
205         draw_longa (true);
206
207         draw_staff (-2, 2, 0);
208 fet_endchar;
209
210
211 fet_beginchar ("Longa notehead", "dM2");
212         draw_longa (false);
213
214         draw_staff (-2, 2, 0);
215 fet_endchar;
216
217
218 if test > 0:
219         fet_beginchar ("Longa notehead", "uM2");
220                 draw_longa (true);
221
222                 draw_staff (-2, 2, 0.5);
223         fet_endchar;
224
225
226         fet_beginchar ("Longa notehead", "dM2");
227                 draw_longa (false);
228
229                 draw_staff (-2, 2, 0.5);
230         fet_endchar;
231 fi;
232
233
234 %
235 % dimensions aren't entirely right.
236 %
237 def draw_brevis (expr linecount) =
238         save stemthick, fudge;
239
240         stemthick# = 2 stafflinethickness#;
241         define_whole_blacker_pixels (stemthick);
242
243         fudge = hround (blot_diameter / 2);
244
245         draw_outside_ellipse (1.80, 0, 0.707, 0);
246         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
247
248         pickup pencircle scaled stemthick;
249
250         bot y1 = -d;
251         top y2 = h;
252         rt x1 - fudge = 0;
253         x1 = x2;
254
255         fudge + lft x3 = w;
256         x4 = x3;
257         y4 = y2;
258         y3 = y1;
259
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);
265         endfor;
266 enddef;
267
268
269 fet_beginchar ("Brevis notehead", "sM1");
270         draw_brevis (1);
271
272         draw_staff (-2, 2, 0);
273 fet_endchar;
274
275
276 if test > 0:
277         fet_beginchar ("Brevis notehead", "sM1");
278                 draw_brevis(1);
279
280                 draw_staff (-2, 2, 0.5);
281         fet_endchar;
282 fi;
283
284
285 fet_beginchar ("Double-lined brevis notehead", "sM1double");
286         draw_brevis (2);
287
288         draw_staff (-2, 2, 0);
289 fet_endchar;
290
291
292 if test > 0:
293         fet_beginchar ("Double-lined brevis notehead", "sM1double");
294                 draw_brevis (2);
295
296                 draw_staff (-2, 2, 0.5);
297         fet_endchar;
298 fi;
299
300
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#);
305
306         whole_notehead_width# := charwd;
307
308         draw_staff (-2, 2, 0);
309 fet_endchar;
310
311
312 if test > 0:
313         fet_beginchar ("Whole notehead", "s0");
314                 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0,
315                                       0.707, 0);
316                 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
317                                        0.68, 2 stafflinethickness#);
318
319                 draw_staff (-2, 2, 0.5);
320         fet_endchar;
321 fi;
322
323
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#);
327
328         half_notehead_width# := charwd;
329
330         draw_staff (-2, 2, 0);
331 fet_endchar;
332
333
334 if test > 0:
335         fet_beginchar ("Half notehead", "s1");
336                 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34,
337                                       0.66, 0.17);
338                 undraw_inside_ellipse (3.25, 33, 0.81,
339                                        2.5 stafflinethickness#);
340
341                 draw_staff (-2, 2, 0.5);
342         fet_endchar;
343 fi;
344
345
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;
350
351         draw_staff (-2, 2, 0);
352 fet_endchar;
353
354
355 if test > 0:
356         fet_beginchar ("Quart notehead", "s2");
357                 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31,
358                                       0.707, 0);
359
360                 draw_staff (-2, 2, 0.5);
361         fet_endchar;
362 fi;
363
364
365 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
366
367
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#);
372
373         draw_staff (-2, 2, 0);
374 fet_endchar;
375
376
377 if test > 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#);
382
383                 draw_staff (-2, 2, 0.5);
384         fet_endchar;
385 fi;
386
387
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#);
392
393         draw_staff (-2, 2, 0);
394 fet_endchar;
395
396
397 if test > 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,
401                                        .3 staff_space#
402                                        + 1.5 stafflinethickness#);
403
404                 draw_staff (-2, 2, 0.5);
405         fet_endchar;
406 fi;
407
408
409 fet_beginchar ("Quart diamondhead", "s2diamond");
410         draw_outside_ellipse (1.80, 35, 0.495, -0.25);
411
412         draw_staff (-2, 2, 0);
413 fet_endchar;
414
415
416 if test > 0:
417         fet_beginchar ("Quart diamondhead", "s2diamond");
418                 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
419
420                 draw_staff (-2, 2, 0.5);
421         fet_endchar;
422 fi;
423
424
425 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
426
427
428 vardef penposx@# (expr d) =
429 begingroup;
430         save pat;
431         path pat;
432
433         pat = top z@#
434               .. lft z@#
435               .. bot z@#
436               .. rt z@#
437               .. cycle;
438         z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180));
439         z@#r = pat intersectionpoint (z@# -- infinity * dir (d));
440 endgroup
441 enddef;
442
443
444 %
445 % UGH: xs not declared as argument.
446 %
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;
454
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;
460
461         save pen_thick;
462         pen_thick# = stafflinethickness# + .1 staff_space#;
463         define_pixels (llap);
464         define_blacker_pixels (pen_thick);
465
466         left_up_dir = llap# * dir (90 + tilt);
467
468         xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0;
469         ypart origin = 0;
470
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);
474
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)
478                  + pen_thick# * xs;
479
480         set_char_box (0, width#, depth#, height#);
481
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.
485
486         pickup pencircle scaled pen_thick xscaled xs;
487
488         z0 = (hround_pixels (xpart origin), 0);
489
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;
493
494         z12 = caveness [.5[z1, z2], z3];
495         z23 = caveness [.5[z2, z3], z1];
496         z31 = caveness [.5[z3, z1], z2];
497
498         triangle_a = z1 .. z12 .. z2;
499         triangle_b = z2 .. z23 .. z3;
500         triangle_c = z3 .. z31 .. z1;
501
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);
505
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);
509
510         penposx12 (angle (z12 - z0));
511         penposx23 (angle (z23 - z0));
512         penposx31 (angle (z31 - z0));
513
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);
517
518         triangle_in = z10
519                       .. z12l
520                       .. z20
521                       & z20
522                       .. z23l
523                       .. z30
524                       & z30
525                       .. z31l
526                       .. z10
527                       & cycle;
528
529         triangle_out_a = z1r .. z12r .. z2'l;
530         triangle_out_b = z2r .. z23r .. z3'l;
531         triangle_out_c = z3r .. z31r .. z1'l;
532
533         triangle_out = top z1
534                        .. lft z1
535                        .. z1r{direction 0 of triangle_out_a}
536                        & triangle_out_a
537                        & {direction infinity of triangle_out_a}z2'l
538                        .. lft z2
539                        .. bot z2
540                        .. z2r{direction 0 of triangle_out_b}
541                        & triangle_out_b
542                        & {direction infinity of triangle_out_b}z3'l
543                        .. rt z3
544                        .. top z3
545                        .. z3r{direction 0 of triangle_out_c}
546                        & triangle_out_c
547                        & {direction infinity of triangle_out_c}z1'l
548                        .. cycle;
549
550         labels (0, 10, 20, 30);
551         penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31);
552
553         % attachment Y
554         if stemdir = 1:
555                 charwy := ypart exact_right_point;
556                 charwx := xpart exact_right_point + .5 pen_thick# * xs;
557         else:
558                 charwy := -ypart exact_down_point;
559                 charwx := width# - (xpart exact_down_point - .5 pen_thick# * xs);
560         fi
561 enddef;
562
563
564 def draw_whole_triangle_head =
565         save hei, xs;
566         save llap;
567         save tilt;
568
569         tilt = 40;
570         llap# = 3/4 noteheight#;
571
572         xs = 1.5;
573         caveness := 0.1;
574         define_triangle_shape (1);
575         fill triangle_out;
576         unfill triangle_in;
577 enddef;
578
579
580 fet_beginchar ("Whole trianglehead", "s0triangle");
581         draw_whole_triangle_head;
582
583         draw_staff (-2, 2, 0);
584 fet_endchar;
585
586
587 if test > 0:
588         fet_beginchar ("Whole trianglehead", "s0triangle");
589                 draw_whole_triangle_head;
590
591                 draw_staff (-2, 2, 0.5);
592         fet_endchar;
593 fi;
594
595
596 def draw_small_triangle_head (expr dir) =
597         save hei, xs;
598         save llap;
599         save tilt;
600
601         tilt = 40;
602         llap# = 2/3 noteheight#;
603         xs = 1.2;
604         caveness := 0.1;
605         define_triangle_shape (dir);
606
607         pickup feta_fillpen;
608
609         filldraw triangle_out;
610         unfilldraw triangle_in;
611 enddef;
612
613
614 fet_beginchar ("Half trianglehead (downstem)", "d1triangle");
615         draw_small_triangle_head (-1);
616
617         draw_staff (-2, 2, 0);
618 fet_endchar;
619
620
621 fet_beginchar ("Half trianglehead (upstem)", "u1triangle");
622         draw_small_triangle_head (1);
623
624         draw_staff (-2, 2, 0.5);
625 fet_endchar;
626
627
628 def draw_closed_triangle_head (expr dir) =
629         save hei, xs;
630         save llap;
631         save tilt;
632
633         tilt = 40;
634         llap# = 2/3 noteheight#;
635         xs = 1.0;
636         caveness := 0.1;
637         define_triangle_shape (dir);
638         fill triangle_out;
639 enddef;
640
641
642 fet_beginchar ("Quart trianglehead (upstem)", "u2triangle");
643         draw_closed_triangle_head (1);
644
645         draw_staff (-2, 2, 0);
646 fet_endchar;
647
648
649 fet_beginchar ("Quart trianglehead (downstem)", "d2triangle");
650         draw_closed_triangle_head (-1);
651
652         draw_staff (-2, 2, 0.5);
653 fet_endchar;
654
655
656 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
657 %
658 % Slash heads are for indicating improvisation.  They are
659 % twice as high as normal heads.
660 %
661 def draw_slash (expr hwid_hash) =
662         save exact_height;
663         save ne, nw_dist;
664         pair ne, nw_dist;
665         exact_height = staff_space# + stafflinethickness# / 2;
666
667         set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
668                       exact_height, exact_height);
669
670         charwx := charwd;
671         charwy := charht;
672
673         clearxy;
674
675         d := d - feta_shift;
676
677         pickup pencircle scaled blot_diameter;
678
679         bot y1 = -d;
680         top y2 = h;
681         lft x1 = 0;
682         lft x2 = 2 h / slash_slope;
683
684         rt x3 = w;
685         y3 = y2;
686         y4 = y1;
687         x3 - x2 = x4 - x1;
688
689         ne = unitvector (z3 - z4);
690         nw_dist = (ne rotated 90) * 0.5 blot_diameter;
691
692         fill bot z1{left}
693              .. (z1 + nw_dist){ne}
694              -- (z2 + nw_dist){ne}
695              .. top z2{right}
696              -- top z3{right}
697              .. (z3 - nw_dist){-ne}
698              -- (z4 - nw_dist){-ne}
699              .. bot z4{left}
700              -- cycle;
701
702         if hwid_hash > 2 slash_thick#:
703                 save th;
704
705                 th = slash_thick - blot_diameter;
706                 y6 = y7;
707                 y5 = y8;
708                 y3 - y7 = th;
709                 y5 - y1 = th;
710                 z6 - z5 = whatever * ne;
711                 z8 - z7 = whatever * ne;
712
713                 z5 = z1 + whatever * ne + th * (ne rotated -90);
714                 z8 = z4 + whatever * ne + th * (ne rotated 90);
715
716                 unfill z5
717                        -- z6
718                        -- z7
719                        -- z8
720                        -- cycle;
721         fi
722         labels (range 1 thru 10);
723 enddef;
724
725
726 fet_beginchar ("Whole slashhead", "s0slash");
727         draw_slash (4 slash_thick# + 0.5 staff_space#);
728
729         draw_staff (-2, 2, 0);
730 fet_endchar;
731
732
733 fet_beginchar ("Half slashhead", "s1slash");
734         draw_slash (3.0 slash_thick# + 0.15 staff_space#);
735
736         draw_staff (-2, 2, 0);
737 fet_endchar;
738
739
740 fet_beginchar ("Quart slashhead", "s2slash");
741         draw_slash (1.5 slash_thick#);
742
743         draw_staff (-2, 2, 0);
744 fet_endchar;
745
746
747 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
748 %
749 % `thick' is the distance between the NE/SW parallel lines in the cross
750 % (distance between centres of lines) in multiples of stafflinethickness
751 %
752 def draw_cross (expr thick) =
753         save ne, nw;
754         save ne_dist, nw_dist, rt_dist, up_dist;
755         save crz_in, crz_out;
756         save thickness;
757         pair ne, nw;
758         pair ne_dist, nw_dist, rt_dist, up_dist;
759         path crz_in, crz_out;
760
761         pen_thick# := 1.2 stafflinethickness#;
762         thickness# := thick * stafflinethickness#;
763         define_pixels (thickness);
764         define_blacker_pixels (pen_thick);
765
766         pickup pencircle scaled pen_thick;
767
768         h := h - feta_shift;
769
770         top y3 = h;
771         ne = unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
772         rt x4 = w / 2;
773         y5 = 0;
774         z4 - z5 = whatever * ne;
775         x6 = 0;
776         z6 - z3 = whatever * ne;
777         z3 - z4 = whatever * (ne yscaled -1);
778
779         z4 - z3 = whatever * (ne) + (ne rotated -90) * thickness;
780
781
782         x1 = charwd / 2 - .5 pen_thick#;
783         z1 = whatever * ne
784              + thick / 2 * stafflinethickness# * (ne rotated -90);
785
786         % labels (1, 2, 3, 4, 5, 6);
787
788         nw = unitvector (z3 - z4);
789
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;
794
795         x4' := x4;
796         x5' := x5;
797         y6' := y6;
798
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;
802
803         crz_out = (z6 + up_dist)
804                   -- (z3 + nw_dist){ne}
805                   .. (top z3)
806                   .. (z3 + ne_dist){-nw}
807                   -- (z4 + ne_dist){-nw}
808                   .. (rt z4)
809                   .. (z4 - nw_dist){-ne}
810                   -- (z5 + rt_dist);
811         crz_out := crz_out shifted (0, feta_shift)
812                    -- reverse crz_out yscaled -1 shifted (0, -feta_eps);
813         fill crz_out
814              -- reverse crz_out xscaled -1 shifted (-feta_eps, 0)
815              -- cycle;
816
817         if (thick > 1):
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;
821
822                 crz_in = (bot z6){right}
823                          .. (z6 - nw_dist){ne}
824                          -- (z3 - up_dist)
825                          -- (z4 - rt_dist)
826                          -- (z5 + nw_dist){-ne}
827                          .. {down}(lft z5);
828                 crz_in := crz_in shifted (0, feta_shift)
829                           -- reverse crz_in yscaled -1 shifted (0, -feta_eps);
830                 unfill crz_in
831                        -- reverse crz_in xscaled -1 shifted (-feta_eps, 0)
832                        -- cycle;
833         fi
834
835         % ugh
836         currentpicture := currentpicture shifted (hround (w / 2), 0);
837
838         charwx := charwd;
839         charwy := y1 + feta_shift;
840
841         z12 = (charwx * hppp, y1 * vppp);
842
843         labels (12);
844 enddef;
845
846
847 fet_beginchar ("Whole Crossed notehead", "s0cross");
848         save wid, hei;
849
850         wid# := black_notehead_width# + 4 stafflinethickness#;
851         hei# := noteheight# + stafflinethickness#;
852
853         set_char_box (0, wid#, hei# / 2, hei# / 2);
854
855         draw_cross (3.75);
856
857         remember_pic := currentpicture;
858
859         draw_staff (-2, 2, 0);
860 fet_endchar;
861
862
863 if test > 0:
864         fet_beginchar ("Whole Crossed notehead", "s0cross");
865                 save wid, hei;
866
867                 wid# := black_notehead_width# + 4 stafflinethickness#;
868                 hei# := noteheight# + stafflinethickness#;
869
870                 set_char_box (0, wid#, hei# / 2, hei# / 2);
871
872                 currentpicture := remember_pic;
873
874                 draw_staff (-2, 2, 0.5);
875         fet_endchar;
876 fi;
877
878
879 fet_beginchar ("Half Crossed notehead", "s1cross");
880         save wid, hei;
881
882         wid# := black_notehead_width# + 2 stafflinethickness#;
883         hei# := noteheight# + stafflinethickness# / 2;
884
885         set_char_box (0, wid#, hei# / 2, hei# / 2);
886
887         draw_cross (3.0);
888
889         remember_pic := currentpicture;
890
891         draw_staff (-2, 2, 0);
892 fet_endchar;
893
894
895 if test > 0:
896         fet_beginchar ("Half Crossed notehead", "s1cross");
897                 save wid, hei;
898
899                 wid# := black_notehead_width# + 2 stafflinethickness#;
900                 hei# := noteheight# + stafflinethickness# / 2;
901
902                 set_char_box (0, wid#, hei# / 2, hei# / 2);
903
904                 currentpicture := remember_pic;
905
906                 draw_staff (-2, 2, 0.5);
907         fet_endchar;
908 fi;
909
910
911 fet_beginchar ("Crossed notehead", "s2cross");
912         wid# := black_notehead_width#;
913         hei# := noteheight#;
914         set_char_box (0, wid#, hei# / 2, hei# / 2);
915
916         draw_cross (1.0);
917
918         remember_pic := currentpicture;
919
920         draw_staff (-2, 2, 0);
921 fet_endchar;
922
923
924 if test > 0:
925         fet_beginchar ("Crossed notehead", "s2cross");
926                 wid# := black_notehead_width#;
927                 hei# := noteheight#;
928                 set_char_box (0, wid#, hei# / 2, hei# / 2);
929
930                 currentpicture := remember_pic;
931
932                 draw_staff (-2, 2, 0.5);
933         fet_endchar;
934 fi;
935
936
937 fet_beginchar ("X-Circled notehead", "s2xcircle");
938         save wid, hei;
939         save cthick, cxd, cyd, dy;
940
941         wid# := black_notehead_width# * sqrt (sqrt2);
942         hei# := noteheight# * sqrt (sqrt2);
943
944         set_char_box (0, wid#, hei# / 2, hei# / 2);
945
946         d := d - feta_space_shift;
947
948         cthick# := (1.2 + 1/4) * stafflinethickness#;
949         define_blacker_pixels (cthick);
950
951         cxd := w - cthick;
952         cyd := h + d - cthick / 2;
953
954         dy = .5 (h - d);
955
956         pickup pencircle scaled cthick;
957
958         fill fullcircle xscaled (cxd + cthick)
959                         yscaled (cyd + cthick)
960                         shifted (w / 2, dy);
961         unfill fullcircle xscaled (cxd - cthick)
962                           yscaled (cyd - cthick)
963                           shifted (w / 2, dy);
964
965         xpos := .5 cxd / sqrt2;
966         ypos := .5 cyd / sqrt2;
967
968         pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
969         draw (-xpos + w / 2, -ypos + dy)
970              -- (xpos + w / 2, ypos + dy);
971
972         pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
973         draw (-xpos + w / 2, ypos + dy)
974              -- (xpos + w / 2, -ypos + dy);
975
976         charwx := charwd;
977         charwy := 0;
978
979         z12 = (charwx * hppp, charwy * vppp);
980         labels (12);
981
982         remember_pic := currentpicture;
983
984         draw_staff (-2, 2, 0);
985 fet_endchar;
986
987
988 if test > 0:
989         fet_beginchar ("X-Circled notehead", "s2xcircle");
990                 save wid, hei;
991                 save cthick, cxr, cyr;
992
993                 wid# := black_notehead_width# * sqrt (sqrt2);
994                 hei# := noteheight# * sqrt (sqrt2);
995
996                 set_char_box (0, wid#, hei# / 2, hei# / 2);
997
998                 currentpicture := remember_pic;
999
1000                 draw_staff (-2, 2, 0.5);
1001         fet_endchar;
1002 fi;
1003
1004
1005 %%%%%%%%
1006 %
1007 % SOLFA SHAPED NOTES
1008 %
1009 %
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.
1014 %
1015 %       This means that to get a line of thick_factor * pen_thickness,
1016 %       we need to offset the inner curve by
1017 %
1018 %         (thick_factor - 0.5) * pen_thickness
1019 %
1020 %       or by
1021 %
1022 %         (2 * thick_factor - 1) * half_pen_thickness
1023 %
1024 save solfa_pen_thick;
1025 solfa_pen_thick# = 1.3 stafflinethickness#;
1026 define_blacker_pixels (solfa_pen_thick);
1027
1028 save solfa_pen_radius;
1029 solfa_pen_radius = 0.5 solfa_pen_thick;
1030
1031 save solfa_base_notewidth;
1032 solfa_base_notewidth# := black_notehead_width#;
1033
1034 solfa_whole_width := 1.0;
1035 solfa_half_width := 1.0;
1036 solfa_quarter_width := 1.0;
1037
1038
1039 %%% Do head
1040 %
1041 % Triangle with base parallel to staff lines.
1042 %
1043
1044 def draw_do_head (expr width_factor, dir, thickness_factor) =
1045         save p_in, p_out;
1046         save left_dist, right_dist, bottom_dist;
1047         path p_in, p_out;
1048         pair left_dist, right_dist, bottom_dist;
1049
1050         set_char_box (0, width_factor * solfa_base_notewidth#,
1051                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1052
1053         pickup pencircle scaled solfa_pen_thick;
1054
1055
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;
1060         else:
1061                 left_thick_factor := 0.7 * bottom_thick_factor;
1062         fi
1063
1064         bot y1 = -d;
1065         y1 = y2;
1066         lft x1 = 0;
1067         rt x2 = w;
1068         top y3 = h;
1069         x3 = .5 [x1, x2];
1070
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;
1074
1075         save pa, pb, pc;
1076         path pa, pb, pc;
1077         save point_a, point_b, point_c;
1078         pair point_a, point_b, point_c;
1079
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);
1086
1087         point_a := pa intersectionpoint pb;
1088         point_b := pb intersectionpoint pc;
1089         point_c := pc intersectionpoint pa;
1090
1091         p_in := point_a
1092                 -- point_b
1093                 -- point_c
1094                 -- cycle;
1095
1096         p_out := bot z1
1097                  -- bot z2{right}
1098                  .. rt z2{up}
1099                  .. (z2 + right_dist){z3 - z2}
1100                  -- (z3 + right_dist){z3 - z2}
1101                  .. top z3{left}
1102                  .. (z3 + left_dist){z1 - z3}
1103                  -- (z1 + left_dist){z1 - z3}
1104                  .. lft z1{down}
1105                  .. {right}cycle;
1106
1107         labels (1, 2, 3);
1108
1109         charwx := charwd;
1110         charwy := -chardp + 0.5 stafflinethickness#;
1111         if dir = -1:
1112                 charwy := -charwy;
1113         fi;
1114 enddef;
1115
1116 save do_weight;
1117 do_weight := 2;
1118
1119
1120 fet_beginchar ("Whole dohead", "s0do");
1121         draw_do_head (solfa_whole_width, 1, do_weight);
1122         fill p_out;
1123         unfill p_in;
1124 fet_endchar;
1125
1126
1127 fet_beginchar ("Half dohead", "d1do");
1128         draw_do_head (solfa_half_width, -1, do_weight);
1129         fill p_out;
1130         unfill p_in;
1131 fet_endchar;
1132
1133
1134 fet_beginchar ("Half dohead", "u1do");
1135         draw_do_head (solfa_half_width, 1, do_weight);
1136         fill p_out;
1137         unfill p_in;
1138 fet_endchar;
1139
1140
1141 fet_beginchar ("Quart dohead", "d2do");
1142         draw_do_head (solfa_quarter_width, -1, do_weight);
1143         fill p_out;
1144 fet_endchar;
1145
1146
1147 fet_beginchar ("Quart dohead", "u2do");
1148         draw_do_head (solfa_quarter_width, 1, do_weight);
1149         fill p_out;
1150 fet_endchar;
1151
1152
1153 fet_beginchar ("Whole thin dohead", "s0doThin");
1154         draw_do_head (solfa_whole_width, 1, 1);
1155         fill p_out;
1156         unfill p_in;
1157 fet_endchar;
1158
1159
1160 fet_beginchar ("Half thin dohead", "d1doThin");
1161         draw_do_head (solfa_half_width, -1, 1);
1162         fill p_out;
1163         unfill p_in;
1164 fet_endchar;
1165
1166
1167 fet_beginchar ("Half thin dohead", "u1doThin");
1168         draw_do_head (solfa_half_width, 1, 1);
1169         fill p_out;
1170         unfill p_in;
1171 fet_endchar;
1172
1173
1174 fet_beginchar ("Quart thin dohead", "d2doThin");
1175         draw_do_head (solfa_quarter_width, -1, 1);
1176         fill p_out;
1177 fet_endchar;
1178
1179
1180 fet_beginchar ("Quart thin dohead", "u2doThin");
1181         draw_do_head (solfa_quarter_width, 1, 1);
1182         fill p_out;
1183 fet_endchar;
1184
1185
1186 %
1187 % re - flat top, curved bottom:
1188 %
1189 %   (0,h/2) {dir -90}
1190 %   .. (w/2,-h/2)
1191 %   .. {dir 90} (w,h/2)
1192 %   -- cycle;
1193 %
1194 % (broader along the base and with more vertical sides for half and
1195 % whole notes)
1196 %
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.
1200 %
1201 % stem attachment: h/2
1202 %
1203 def draw_re_head (expr width_factor, dir, thickness_factor) =
1204         save p_in, p_out;
1205         path p_in, p_out;
1206
1207         set_char_box (0, width_factor * solfa_base_notewidth#,
1208                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1209
1210         pickup pencircle scaled solfa_pen_thick;
1211
1212         save curve_start;
1213         curve_start = 0.7;
1214         lft x1 = 0;
1215         y1 = y5;
1216         x1 = x2;
1217         y2 = curve_start [y3, y1];
1218         bot y3 = -d;
1219         x3 = .5 [x2, x4];
1220         rt x4 = w;
1221         y4 = y2;
1222         top y5 = h;
1223         x5 = x4;
1224
1225         save offset;
1226         offset = (2 * thickness_factor - 1);
1227
1228         labels (range 1 thru 5);
1229
1230         p_in := (z1 + solfa_pen_radius * (1, -1 * offset))
1231                 -- rt z2{down}
1232                 .. ((top z3) + (0, offset * solfa_pen_radius))
1233                 .. lft z4{up}
1234                 -- (z5 + solfa_pen_radius * (-1, -1 * offset))
1235                 -- cycle;
1236
1237         p_out := lft z1
1238                  -- lft z2{down}
1239                  .. bot z3
1240                  .. rt z4{up}
1241                  -- rt z5{up}
1242                  .. top z5{left}
1243                  -- top z1{left}
1244                  .. {down}cycle;
1245
1246         charwx := charwd;
1247         charwy := curve_start [-chardp, charht];
1248
1249         if dir = -1:
1250                 charwy := -charwy;
1251         fi;
1252 enddef;
1253
1254
1255 save re_weight;
1256 re_weight := 2;
1257
1258 fet_beginchar ("Whole rehead", "s0re");
1259         draw_re_head (solfa_whole_width, 1, re_weight);
1260         fill p_out;
1261         unfill p_in;
1262 fet_endchar;
1263
1264
1265 fet_beginchar ("Half up rehead", "u1re");
1266         draw_re_head (solfa_half_width, 1, re_weight);
1267         fill p_out;
1268         unfill p_in;
1269 fet_endchar;
1270
1271
1272 fet_beginchar ("Half down rehead", "d1re");
1273         draw_re_head (solfa_half_width, -1, re_weight);
1274         fill p_out;
1275         unfill p_in;
1276 fet_endchar;
1277
1278
1279 fet_beginchar ("Quart up rehead", "u2re");
1280         draw_re_head (solfa_quarter_width, 1, re_weight);
1281         fill p_out;
1282 fet_endchar;
1283
1284
1285 fet_beginchar ("Quart down rehead", "d2re");
1286         draw_re_head (solfa_quarter_width, -1, re_weight);
1287         fill p_out;
1288 fet_endchar;
1289
1290
1291 fet_beginchar ("Whole thin rehead", "s0reThin");
1292         draw_re_head (solfa_whole_width, 1, 1);
1293         fill p_out;
1294         unfill p_in;
1295 fet_endchar;
1296
1297
1298 fet_beginchar ("Half up thin rehead", "u1reThin");
1299         draw_re_head (solfa_half_width, 1, 1);
1300         fill p_out;
1301         unfill p_in;
1302 fet_endchar;
1303
1304
1305 fet_beginchar ("Half down thin rehead", "d1reThin");
1306         draw_re_head (solfa_half_width, -1, 1);
1307         fill p_out;
1308         unfill p_in;
1309 fet_endchar;
1310
1311
1312 fet_beginchar ("Quart thin rehead", "u2reThin");
1313         draw_re_head (solfa_quarter_width, 1, 1);
1314         fill p_out;
1315 fet_endchar;
1316
1317
1318 fet_beginchar ("Quart thin rehead", "d2reThin");
1319         draw_re_head (solfa_quarter_width, -1, 1);
1320         fill p_out;
1321 fet_endchar;
1322
1323
1324 %%%% mi head -- diamond shape
1325 %
1326 % two versions, depending on whether the `strong' lines are on the nw & se
1327 % or the ne & sw
1328 %
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;
1336         save inner_path;
1337         path inner_path;
1338
1339         set_char_box (0, width_factor * solfa_base_notewidth#,
1340                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1341
1342         pickup pencircle scaled solfa_pen_thick;
1343
1344         save offset;
1345         offset := 2 * thickness_factor - 1;
1346
1347         lft x1 = 0;
1348         y1 = 0;
1349         bot y2 = -d;
1350         x2 = .5 [x1, x3];
1351         rt x3 = w;
1352         x4 = x2;
1353         y3 = y1;
1354         top y4 = h;
1355
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);
1361
1362         ne = unitvector (z4 - z1);
1363         se = unitvector (z2 - z1);
1364
1365         ne_dist = (ne rotated 90) * solfa_pen_radius;
1366         se_dist = (se rotated 90) * solfa_pen_radius;
1367
1368         path_a := (z1 + se_dist)
1369                   -- (z2 + se_dist);
1370         path_b := (z2 + (ne_dist * offset))
1371                   -- (z3 + (ne_dist * offset));
1372         path_c := (z3 - se_dist)
1373                   -- (z4 - se_dist);
1374         path_d := (z4 - (ne_dist * offset))
1375                   -- (z1 - (ne_dist * offset));
1376
1377         z5 = path_a intersectionpoint path_d;
1378         z7 = path_b intersectionpoint path_c;
1379
1380         labels (range 1 thru 8);
1381
1382         inner_path := z5
1383                       -- z6
1384                       -- z7
1385                       -- z8
1386                       -- cycle;
1387
1388         if mirror:
1389                 path_in := inner_path;
1390         else:
1391                 path_in := inner_path reflectedabout (z2, z4);
1392         fi
1393
1394         path_out := lft z1 {down}
1395                     .. (z1 - se_dist){se}
1396                     -- (z2 - se_dist){se}
1397                     .. bot z2 {right}
1398                     .. (z2 - ne_dist){ne}
1399                     -- (z3 - ne_dist){ne}
1400                     .. rt z3 {up}
1401                     .. (z3 + se_dist){-se}
1402                     -- (z4 + se_dist){-se}
1403                     .. top z4 {left}
1404                     .. (z4 + ne_dist){-ne}
1405                     -- (z1 + ne_dist){-ne}
1406                     .. cycle;
1407 enddef;
1408
1409
1410 save mi_weight, mi_width;
1411 mi_weight := 2;
1412 mi_width := 1.2;
1413
1414 fet_beginchar ("Whole mihead", "s0mi");
1415         draw_mi_head (mi_width * solfa_whole_width, mi_weight, false);
1416         fill path_out;
1417         unfill path_in;
1418 fet_endchar;
1419
1420
1421 fet_beginchar ("Half mihead", "s1mi");
1422         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1423         fill path_out;
1424         unfill path_in;
1425 fet_endchar;
1426
1427
1428 fet_beginchar ("Quart mihead", "s2mi");
1429         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, false);
1430         fill path_out;
1431 fet_endchar;
1432
1433
1434 fet_beginchar ("Whole mirror mihead", "s0miMirror");
1435         draw_mi_head (mi_width * solfa_whole_width, mi_weight, true);
1436         fill path_out;
1437         unfill path_in;
1438 fet_endchar;
1439
1440
1441 fet_beginchar ("Half  mirror mihead", "s1miMirror");
1442         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1443         fill path_out;
1444         unfill path_in;
1445 fet_endchar;
1446
1447
1448 fet_beginchar ("Quart mirror mihead", "s2miMirror");
1449         draw_mi_head (mi_width * solfa_quarter_width, mi_weight, true);
1450         fill path_out;
1451 fet_endchar;
1452
1453
1454 fet_beginchar ("Whole thin mihead", "s0miThin");
1455         draw_mi_head (mi_width * solfa_whole_width, 1, false);
1456         fill path_out;
1457         unfill path_in;
1458 fet_endchar;
1459
1460
1461 fet_beginchar ("Half thin mihead", "s1miThin");
1462         draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1463         fill path_out;
1464         unfill path_in;
1465 fet_endchar;
1466
1467
1468 fet_beginchar ("Quart thin mihead", "s2miThin");
1469         draw_mi_head (mi_width * solfa_quarter_width, 1, false);
1470         fill path_out;
1471 fet_endchar;
1472
1473
1474 %%%% fa head
1475 %
1476 % Right triangle, hypotenuse from nw to se corner.  Stem attaches on
1477 % vertical side in direction of horizontal side.
1478 %
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#);
1482
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;
1487         pair nw_dist, nw;
1488
1489         save offset;
1490         offset := 2 * thickness_factor - 0.5;
1491
1492         pickup pencircle scaled solfa_pen_thick;
1493
1494         lft x1 = 0;
1495         top y1 = h;
1496
1497         rt x2 = w;
1498         y2 = y1;
1499         bot y3 = -d;
1500         x3 = x2;
1501
1502         y4 = y3;
1503         x4 = x1;
1504
1505         labels (1, 2, 3, 4);
1506
1507         nw = unitvector (z1 - z3);
1508         nw_dist = (nw rotated 90) * solfa_pen_radius;
1509
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)
1515                   -- (z1 - nw_dist);
1516
1517         p_up_in := (path_a intersectionpoint path_b)
1518                    -- (path_b intersectionpoint path_c)
1519                    -- (path_c intersectionpoint path_a)
1520                    -- cycle;
1521
1522         p_up_out := lft z1{down}
1523                     .. (z1 + nw_dist){-nw}
1524                     -- (z3 + nw_dist){-nw}
1525                     .. bot z3{right}
1526                     .. rt z3{up}
1527                     -- rt z2{up}
1528                     .. top z2{left}
1529                     -- top z1{left}
1530                     .. cycle;
1531
1532         p_down_in := p_up_in rotated 180 shifted (w, 0);
1533         p_down_out := p_up_out rotated 180 shifted (w, 0);
1534
1535         charwy := 0.0;
1536         charwx := charwd;
1537 enddef;
1538
1539 save fa_weight;
1540 fa_weight := 2;
1541
1542 fet_beginchar ("Whole fa up head", "u0fa");
1543         draw_fa_head (solfa_whole_width, fa_weight);
1544         fill p_up_out;
1545         unfill p_up_in;
1546 fet_endchar;
1547
1548
1549 fet_beginchar ("Whole fa down head", "d0fa");
1550         draw_fa_head (solfa_whole_width, fa_weight);
1551         fill p_down_out;
1552         unfill p_down_in;
1553 fet_endchar;
1554
1555
1556 fet_beginchar ("half fa up head", "u1fa");
1557         draw_fa_head (solfa_half_width, fa_weight);
1558         fill p_up_out;
1559         unfill p_up_in;
1560 fet_endchar;
1561
1562
1563 fet_beginchar ("Half fa down head", "d1fa");
1564         draw_fa_head (solfa_half_width, fa_weight);
1565         fill p_down_out;
1566         unfill p_down_in;
1567 fet_endchar;
1568
1569
1570 fet_beginchar ("Quarter fa up head", "u2fa");
1571         draw_fa_head (solfa_quarter_width, fa_weight);
1572         fill p_up_out;
1573 fet_endchar;
1574
1575
1576 fet_beginchar ("Quarter fa down head", "d2fa");
1577         draw_fa_head (solfa_quarter_width, fa_weight);
1578         fill p_down_out;
1579 fet_endchar;
1580
1581
1582 fet_beginchar ("Whole thin fa up head", "u0faThin");
1583         draw_fa_head (solfa_whole_width, 1);
1584         fill p_up_out;
1585         unfill p_up_in;
1586 fet_endchar;
1587
1588
1589 fet_beginchar ("Whole thin fa down head", "d0faThin");
1590         draw_fa_head (solfa_whole_width, 1);
1591         fill p_down_out;
1592         unfill p_down_in;
1593 fet_endchar;
1594
1595
1596 fet_beginchar ("half thin fa up head", "u1faThin");
1597         draw_fa_head (solfa_half_width, 1);
1598         fill p_up_out;
1599         unfill p_up_in;
1600 fet_endchar;
1601
1602
1603 fet_beginchar ("Half thin fa down head", "d1faThin");
1604         draw_fa_head (solfa_half_width, 1);
1605         fill p_down_out;
1606         unfill p_down_in;
1607 fet_endchar;
1608
1609
1610 fet_beginchar ("Quarter thin fa up head", "u2faThin");
1611         draw_fa_head (solfa_quarter_width, 1);
1612         fill p_up_out;
1613 fet_endchar;
1614
1615
1616 fet_beginchar ("Quarter thin fa down head", "d2faThin");
1617         draw_fa_head (solfa_quarter_width, 1);
1618         fill p_down_out;
1619 fet_endchar;
1620
1621
1622
1623 %%%% sol head
1624 %
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.
1628 %
1629 def draw_sol_head (expr filled) =
1630         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
1631         if not filled:
1632           undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
1633         fi
1634         draw_staff (-2, 2, 0);
1635 enddef;
1636
1637 fet_beginchar ("Whole solhead", "s0sol");
1638         draw_sol_head ( false);
1639 fet_endchar;
1640
1641
1642 fet_beginchar ("Half solhead", "s1sol");
1643         draw_sol_head ( false);
1644 fet_endchar;
1645
1646
1647 fet_beginchar ("Quart solhead", "s2sol");
1648         draw_sol_head ( true);
1649 fet_endchar;
1650
1651
1652 %%%% la head
1653 %
1654 %   Rectangle head
1655 %
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#);
1659         save p_in, p_out;
1660         path p_in, p_out;
1661
1662         pickup pencircle scaled solfa_pen_thick;
1663
1664         save offset;
1665         offset := 2 * thickness_factor - 1;
1666
1667         lft x1 = 0;
1668         top y1 = h;
1669
1670         rt x2 = w;
1671         y2 = y1;
1672         bot y3 = -d;
1673         x3 = x2;
1674
1675         y4 = y3;
1676         x4 = x1;
1677
1678         labels (range 1 thru 4);
1679
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))
1684                 -- cycle;
1685
1686         p_out := top z1
1687                  -- top z2{right}
1688                  .. rt z2{down}
1689                  -- rt z3{down}
1690                  .. bot z3{left}
1691                  -- bot z4{left}
1692                  .. lft z4{up}
1693                  -- lft z1{up}
1694                  .. cycle;
1695 enddef;
1696
1697
1698 save la_weight;
1699 la_weight := 2;
1700
1701 fet_beginchar ("Whole lahead", "s0la");
1702         draw_la_head (solfa_whole_width, la_weight);
1703         fill p_out;
1704         unfill p_in;
1705 fet_endchar;
1706
1707
1708 fet_beginchar ("Half lahead", "s1la");
1709         draw_la_head (solfa_half_width, la_weight);
1710         fill p_out;
1711         unfill p_in;
1712 fet_endchar;
1713
1714
1715 fet_beginchar ("Quart lahead", "s2la");
1716         draw_la_head (solfa_quarter_width, la_weight);
1717         fill p_out;
1718 fet_endchar;
1719
1720
1721 fet_beginchar ("Whole thin lahead", "s0laThin");
1722         draw_la_head (solfa_whole_width, 1);
1723         fill p_out;
1724         unfill p_in;
1725 fet_endchar;
1726
1727
1728 fet_beginchar ("Half thin lahead", "s1laThin");
1729         draw_la_head (solfa_half_width, 1);
1730         fill p_out;
1731         unfill p_in;
1732 fet_endchar;
1733
1734
1735 fet_beginchar ("Quart lahead", "s2laThin");
1736         draw_la_head (solfa_quarter_width, 1);
1737         fill p_out;
1738 fet_endchar;
1739
1740
1741 %%%% ti head
1742 %
1743 %   `Snow-cone', V with rounded top.
1744 %
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;
1750         save cone_height;
1751         cone_height = 0.64;
1752
1753         save offset;
1754         offset := 2 * thickness_factor - 1;
1755
1756         pickup pencircle scaled solfa_pen_thick;
1757
1758         x1 = .5 [x2, x4];
1759         bot y1 = -d;
1760         lft x2 = 0;
1761         y2 = cone_height [y1, y3];
1762         rt x4 = w;
1763         y4 = y2;
1764         x3 = x1;
1765         top y3 = h;
1766         x5 = x1;
1767         y5 = y1 + offset * solfa_pen_radius;
1768
1769         labels (range 1 thru 4);
1770
1771         save nw_dist, sw_dist, nw, sw;
1772         pair nw_dist, sw_dist, nw, sw;
1773
1774         nw = unitvector (z2 - z1);
1775         sw = unitvector (z1 - z4);
1776
1777         nw_dist = (nw rotated 90) * solfa_pen_radius;
1778         sw_dist = (sw rotated 90) * solfa_pen_radius;
1779
1780         p_top := (z2 + nw * solfa_pen_radius)
1781                  .. (top z3){right}
1782                  .. (z4 - sw * solfa_pen_radius);
1783
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);
1787
1788         save path_a, path_b;
1789         path path_a, path_b;
1790         path_a := z2
1791                   -- z5;
1792         path_b := z5
1793                   -- z4;
1794
1795         z6 = path_a intersectionpoint p_top_in;
1796         z7 = path_b intersectionpoint p_top_in;
1797
1798         p_in := z5
1799                 -- z6
1800                 .. bot z3
1801                 .. z7
1802                 -- cycle;
1803
1804         p_out := bot z1
1805                  .. (z1 + nw_dist)
1806                  -- (z2 + nw_dist)
1807                  .. lft z2
1808                  .. (z2 + nw * solfa_pen_radius){direction 0 of p_top}
1809                  & p_top
1810                  & {direction infinity of p_top}(z4 - sw * solfa_pen_radius)
1811                  .. rt z4
1812                  .. (z4 + sw_dist)
1813                  -- (z1 + sw_dist)
1814                  .. cycle;
1815
1816         charwx := charwd;
1817         charwy := cone_height [-chardp, charht];
1818         if dir = -1:
1819                 charwy := -charwy;
1820         fi;
1821 enddef;
1822
1823
1824 save ti_weight;
1825 ti_weight := 2;
1826
1827 fet_beginchar ("Whole up tihead", "s0ti");
1828         draw_ti_head (solfa_whole_width, 1, ti_weight);
1829         fill p_out;
1830         unfill p_in;
1831 fet_endchar;
1832
1833
1834 fet_beginchar ("Half up tihead", "u1ti");
1835         draw_ti_head (solfa_half_width, 1, ti_weight);
1836         fill p_out;
1837         unfill p_in;
1838 fet_endchar;
1839
1840
1841 fet_beginchar ("Half down tihead", "d1ti");
1842         draw_ti_head (solfa_half_width, -1, ti_weight);
1843         fill p_out;
1844         unfill p_in;
1845 fet_endchar;
1846
1847
1848 fet_beginchar ("Quart up tihead", "u2ti");
1849         draw_ti_head (solfa_quarter_width, 1, ti_weight);
1850         fill p_out;
1851 fet_endchar;
1852
1853
1854 fet_beginchar ("Quart down tihead", "d2ti");
1855         draw_ti_head (solfa_quarter_width, -1, ti_weight);
1856         fill p_out;
1857 fet_endchar;
1858
1859
1860 fet_beginchar ("Whole thin up tihead", "s0tiThin");
1861         draw_ti_head (solfa_whole_width, 1, 1);
1862         fill p_out;
1863         unfill p_in;
1864 fet_endchar;
1865
1866
1867 fet_beginchar ("Half thin up tihead", "u1tiThin");
1868         draw_ti_head (solfa_half_width, 1, 1);
1869         fill p_out;
1870         unfill p_in;
1871 fet_endchar;
1872
1873
1874 fet_beginchar ("Half thin down tihead", "d1tiThin");
1875         draw_ti_head (solfa_half_width, -1, 1);
1876         fill p_out;
1877         unfill p_in;
1878 fet_endchar;
1879
1880
1881 fet_beginchar ("Quart thin up tihead", "u2tiThin");
1882         draw_ti_head (solfa_quarter_width, 1, 1);
1883         fill p_out;
1884 fet_endchar;
1885
1886
1887 fet_beginchar ("Quart thin down tihead", "d2tiThin");
1888         draw_ti_head (solfa_quarter_width, -1, 1);
1889         fill p_out;
1890 fet_endchar;
1891
1892
1893 %%%%%%   Funk shape note heads
1894 %
1895 %  Funk heads are narrower than Aiken and Sacred Harp, so we need a new
1896 %  width.
1897 %
1898 funk_notehead_width := 0.75;
1899
1900
1901 %%%%%%   Funk do head
1902 %          Parabolic on one side, vertical line on other
1903 %          Has up and down shapes for *all* notes
1904 %
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#);
1908
1909         pickup pencircle scaled solfa_pen_thick;
1910         save offset;
1911         offset := 2 * thickness_factor - 1;
1912
1913         rt x1 = w;
1914         bot y1 = -d;
1915
1916         lft x2 = 0;
1917         y2 = 0.5 [y1, y3];
1918
1919         x3 = x1;
1920         top y3 = h;
1921
1922         x4 = x1 - solfa_pen_radius;
1923         y4 = y1 + offset * solfa_pen_radius;
1924
1925         y5 = y2;
1926         x5 = x2 + solfa_pen_radius;
1927
1928         x6 = x4;
1929         y6 = y3 - offset * solfa_pen_radius;
1930
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;
1933
1934         p_down_in := z4{left}
1935                      .. z5{up}
1936                      .. z6{right}
1937                      -- cycle;
1938
1939         p_down_out := bot z1{left}
1940                       .. lft z2{up}
1941                       .. top z3{right}
1942                       .. rt z3{down}
1943                       -- rt z1{down}
1944                       .. cycle;
1945
1946         p_up_in := p_down_in rotated 180 shifted (w,0);
1947         p_up_out := p_down_out rotated 180 shifted (w,0);
1948
1949 enddef;
1950
1951
1952 save funk_do_weight;
1953 funk_do_weight := 1.7;
1954
1955 fet_beginchar ("Whole up Funk dohead", "u0doFunk");
1956         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1957         fill p_up_out;
1958         unfill p_up_in;
1959 fet_endchar;
1960
1961
1962 fet_beginchar ("Whole down Funk dohead", "d0doFunk");
1963         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1964         fill p_down_out;
1965         unfill p_down_in;
1966 fet_endchar;
1967
1968
1969 fet_beginchar ("Half up Funk dohead", "u1doFunk");
1970         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1971         fill p_up_out;
1972         unfill p_up_in;
1973 fet_endchar;
1974
1975
1976 fet_beginchar ("Half down Funk dohead", "d1doFunk");
1977         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1978         fill p_down_out;
1979         unfill p_down_in;
1980 fet_endchar;
1981
1982
1983 fet_beginchar ("Quarter up Funk dohead", "u2doFunk");
1984         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1985         fill p_up_out;
1986 fet_endchar;
1987
1988
1989 fet_beginchar ("Quarter down Funk dohead", "d2doFunk");
1990         draw_Funk_do_head (funk_notehead_width, funk_do_weight);
1991         fill p_down_out;
1992 fet_endchar;
1993
1994
1995 %%%%%%  Funk re head
1996 %       Arrowhead shape.
1997 %       Has up and down shapes for *all* notes
1998 %
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#);
2002
2003         pickup pencircle scaled solfa_pen_thick;
2004         save offset;
2005         offset := 2 * thickness_factor - 1;
2006
2007         save curve_in;
2008         curve_in := 0.9;
2009
2010         lft x1 = 0;
2011         y1 := 0.5 [y2, y4];
2012
2013         rt x2 = w;
2014         top y2 = h;
2015
2016         x3 := curve_in [x1, x2];
2017         y3 := y1;
2018
2019         x4 = x2;
2020         bot y4 = -d;
2021
2022         z6 = lft z3;
2023
2024         save ne, se, ne_perp, se_perp;
2025         pair ne, se, ne_perp, se_perp;
2026
2027         ne := unitvector (z2 - z1);
2028         se := unitvector (z4 - z1);
2029         ne_perp := ne rotated 90;
2030         se_perp := se rotated 90;
2031
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;
2036
2037
2038         path_d := z2 .. z3{down} .. z4;
2039         arrow_a_perp = unitvector (direction 0 of path_d rotated 90)
2040                        * solfa_pen_radius;
2041         arrow_b_perp = unitvector (direction 1 of path_d rotated 90)
2042                        * solfa_pen_radius;
2043
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
2049                   .. z6{down}
2050                   .. z4 - arrow_b_perp;
2051
2052         z5 = path_a intersectionpoint path_b;
2053         z7 = path_a intersectionpoint path_c;
2054         z8 = path_b intersectionpoint path_c;
2055
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;
2058
2059         p_down_in := z5
2060                      -- z7
2061                      .. z6{down}
2062                      .. z8
2063                      -- cycle;
2064
2065         p_down_out := lft z1{up}
2066                       .. (z1 + ne_perp * solfa_pen_radius){ne}
2067                       -- (z2 + ne_perp * solfa_pen_radius){ne}
2068                       .. top z2 {right}
2069                       .. rt z2{down}
2070                       .. (z2 + arrow_a_perp)
2071                       .. rt z3{down}
2072                       .. (z4 + arrow_b_perp)
2073                       .. rt z4{down}
2074                       .. bot z4 {left}
2075                       .. z4 - se_perp * solfa_pen_radius
2076                       -- z1 - se_perp * solfa_pen_radius
2077                       .. cycle;
2078
2079         p_up_in := p_down_in rotated 180 shifted (w, 0);
2080         p_up_out := p_down_out rotated 180 shifted (w, 0);
2081
2082 enddef;
2083
2084
2085 save funk_re_weight;
2086 funk_re_weight = 1.7;
2087
2088 fet_beginchar ("Whole up Funk rehead", "u0reFunk");
2089         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2090         fill p_up_out;
2091         unfill p_up_in;
2092 fet_endchar;
2093
2094
2095 fet_beginchar ("Whole down Funk rehead", "d0reFunk");
2096         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2097         fill p_down_out;
2098         unfill p_down_in;
2099 fet_endchar;
2100
2101
2102 fet_beginchar ("Half up Funk rehead", "u1reFunk");
2103         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2104         fill p_up_out;
2105         unfill p_up_in;
2106 fet_endchar;
2107
2108
2109 fet_beginchar ("Half down Funk rehead", "d1reFunk");
2110         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2111         fill p_down_out;
2112         unfill p_down_in;
2113 fet_endchar;
2114
2115
2116 fet_beginchar ("Quarter up Funk rehead", "u2reFunk");
2117         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2118         fill p_up_out;
2119 fet_endchar;
2120
2121
2122 fet_beginchar ("Quarter down Funk rehead", "d2reFunk");
2123         draw_Funk_re_head (funk_notehead_width, funk_re_weight);
2124         fill p_down_out;
2125 fet_endchar;
2126
2127
2128 %%%%%%  Funk mi head
2129 %       Diamond shape
2130 %       Has up and down shapes for all hollow notes
2131 %
2132 save funk_mi_width, funk_mi_weight;
2133 funk_mi_width := 1.2;
2134 funk_mi_weight := 1.9;
2135
2136 fet_beginchar ("Whole up Funk mihead", "u0miFunk");
2137         draw_mi_head (funk_mi_width * funk_notehead_width,
2138                       funk_mi_weight, false);
2139         fill path_out;
2140         unfill path_in;
2141 fet_endchar;
2142
2143
2144 fet_beginchar ("Whole down Funk mihead", "d0miFunk");
2145         draw_mi_head (funk_mi_width * funk_notehead_width,
2146                       funk_mi_weight, true);
2147         fill path_out;
2148         unfill path_in;
2149 fet_endchar;
2150
2151
2152 fet_beginchar ("Half up Funk mihead", "u1miFunk");
2153         draw_mi_head (funk_mi_width * funk_notehead_width,
2154                       funk_mi_weight, false);
2155         fill path_out;
2156         unfill path_in;
2157 fet_endchar;
2158
2159
2160 fet_beginchar ("Half down Funk mihead", "d1miFunk");
2161         draw_mi_head (funk_mi_width * funk_notehead_width,
2162                       funk_mi_weight, true);
2163         fill path_out;
2164         unfill path_in;
2165 fet_endchar;
2166
2167
2168 fet_beginchar ("Quarter Funk mihead", "s2miFunk");
2169         draw_mi_head (funk_mi_width * funk_notehead_width,
2170                       funk_mi_weight, false);
2171         fill path_out;
2172 fet_endchar;
2173
2174
2175 %%%%%%  Funk fa
2176 %       Triangle shape
2177 %       Does it rotate for whole notes?
2178 %       Same as other shape note systems
2179 %       Need special notes because of special width
2180 %
2181 save funk_fa_weight;
2182 funk_fa_weight := 1.9;
2183
2184 fet_beginchar ("Whole up Funk fahead", "u0faFunk");
2185         draw_fa_head (funk_notehead_width, funk_fa_weight);
2186         fill p_up_out;
2187         unfill p_up_in;
2188 fet_endchar;
2189
2190
2191 fet_beginchar ("Whole down Funk fahead", "d0faFunk");
2192         draw_fa_head (funk_notehead_width, funk_fa_weight);
2193         fill p_down_out;
2194         unfill p_down_in;
2195 fet_endchar;
2196
2197
2198 fet_beginchar ("Half up Funk fahead", "u1faFunk");
2199         draw_fa_head (funk_notehead_width, funk_fa_weight);
2200         fill p_up_out;
2201         unfill p_up_in;
2202 fet_endchar;
2203
2204
2205 fet_beginchar ("Half down Funk fahead", "d1faFunk");
2206         draw_fa_head (funk_notehead_width, funk_fa_weight);
2207         fill p_down_out;
2208         unfill p_down_in;
2209 fet_endchar;
2210
2211
2212 fet_beginchar ("Quarter up Funk fahead", "u2faFunk");
2213         draw_fa_head (funk_notehead_width, funk_fa_weight);
2214         fill p_up_out;
2215 fet_endchar;
2216
2217
2218 fet_beginchar ("Quarter down Funk fahead", "d2faFunk");
2219         draw_fa_head (funk_notehead_width, funk_fa_weight);
2220         fill p_down_out;
2221 fet_endchar;
2222
2223
2224 %%%%%%  Funk sol head is the same as the others
2225 %       Need special character because of skinnier head
2226 %
2227 def draw_Funk_sol_head (expr filled) =
2228 begingroup
2229         save noteheight;
2230         noteheight# := solfa_noteheight#;
2231         draw_outside_ellipse (1.2, 34, 0.71, 0.);
2232         if not filled:
2233           undraw_inside_ellipse (1.9, 33, 0.74, 5.5 stafflinethickness#);
2234         fi
2235         draw_staff (-2, 2, 0);
2236 endgroup
2237 enddef;
2238
2239
2240 fet_beginchar ("Whole Funk solhead", "s0solFunk");
2241         draw_Funk_sol_head ( false);
2242 fet_endchar;
2243
2244
2245 fet_beginchar ("Half Funk solhead", "s1solFunk");
2246         draw_Funk_sol_head ( false);
2247 fet_endchar;
2248
2249
2250 fet_beginchar ("Quarter Funk solhead", "s2solFunk");
2251         draw_Funk_sol_head ( true);
2252 fet_endchar;
2253
2254
2255 %%%%%%  Funk la head
2256 %       Rectangle head
2257 %       Same as for other shape notes
2258 %       Smaller width requires special characters
2259 %
2260 save funk_la_weight;
2261 funk_la_weight := 1.9;
2262
2263 fet_beginchar ("Whole Funk lahead", "s0laFunk");
2264         draw_la_head (funk_notehead_width, funk_notehead_width);
2265         fill p_out;
2266         unfill p_in;
2267 fet_endchar;
2268
2269
2270 fet_beginchar ("Half Funk lahead", "s1laFunk");
2271         draw_la_head (funk_notehead_width, funk_notehead_width);
2272         fill p_out;
2273         unfill p_in;
2274 fet_endchar;
2275
2276
2277 fet_beginchar ("Quart Funk lahead", "s2laFunk");
2278         draw_la_head (funk_notehead_width, funk_notehead_width);
2279         fill p_out;
2280 fet_endchar;
2281
2282
2283 %%%%%%  Funk ti head
2284 %       `Sideways snow cone'.
2285 %       Rotates for all notes.
2286 %
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#);
2290         save cone_width;
2291         cone_width = 0.8;
2292
2293         save offset;
2294         offset := 2 * thickness_factor - 1;
2295
2296         pickup pencircle scaled solfa_pen_thick;
2297
2298         lft x1 = 0;
2299         y1 = .5 [y2, y4];
2300
2301         x2 = cone_width [x1, x3];
2302         top y2 = h;
2303
2304         rt x3 = w;
2305         y3 = y1;
2306
2307         x4 = x2;
2308         bot y4 = -d;
2309
2310         save nw_dist, sw_dist, ne, se;
2311         pair nw_dist, sw_dist, ne, se;
2312
2313         ne = unitvector (z2 - z1);
2314         se = unitvector (z4 - z1);
2315
2316         nw_dist = (ne rotated 90) * solfa_pen_radius ;
2317         sw_dist = (se rotated -90) * solfa_pen_radius;
2318
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;
2325
2326         save path_right, path_right_in;
2327         path path_right, path_right_in;
2328         path_right := (z2 + ne * solfa_pen_radius)
2329                       .. (rt z3){down}
2330                       .. (z4 + se * solfa_pen_radius);
2331
2332         path_right_in := (z2 - ne * solfa_pen_radius)
2333                          .. lft z3{down}
2334                          .. (z4 - se * solfa_pen_radius);
2335
2336         z5 = path_a intersectionpoint path_b;
2337         z6 = path_a intersectionpoint path_right_in;
2338         z7 = path_b intersectionpoint path_right_in;
2339
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;
2342
2343         p_down_in := z5
2344                      -- z6
2345                      .. lft z3
2346                      .. z7
2347                      -- cycle;
2348
2349         p_down_out := lft z1
2350                       .. (z1 + nw_dist)
2351                       -- (z2 + nw_dist)
2352                       .. top z2
2353                       .. (z2 + ne * solfa_pen_radius){direction 0 of path_right}
2354                       & path_right
2355                       & {direction infinity of path_right}(z4 + se * solfa_pen_radius)
2356                       .. bot z4
2357                       .. (z4 + sw_dist)
2358                       -- (z1 + sw_dist)
2359                       .. cycle;
2360
2361         p_up_in := p_down_in rotated 180 shifted (w, 0);
2362         p_up_out := p_down_out rotated 180 shifted (w, 0);
2363 enddef;
2364
2365
2366 save funk_ti_weight;
2367 funk_ti_weight := 1.6;
2368
2369 fet_beginchar ("Whole up Funk tihead", "u0tiFunk");
2370         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2371         fill p_up_out;
2372         unfill p_up_in;
2373 fet_endchar;
2374
2375
2376 fet_beginchar ("Whole down Funk tihead", "d0tiFunk");
2377         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2378         fill p_down_out;
2379         unfill p_down_in;
2380 fet_endchar;
2381
2382
2383 fet_beginchar ("Half up Funk tihead", "u1tiFunk");
2384         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2385         fill p_up_out;
2386         unfill p_up_in;
2387 fet_endchar;
2388
2389
2390 fet_beginchar ("Half down Funk tihead", "d1tiFunk");
2391         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2392         fill p_down_out;
2393         unfill p_down_in;
2394 fet_endchar;
2395
2396
2397 fet_beginchar ("Quarter up Funk tihead", "u2tiFunk");
2398         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2399         fill p_up_out;
2400 fet_endchar;
2401
2402
2403 fet_beginchar ("Quarter down Funk tihead", "d2tiFunk");
2404         draw_Funk_ti_head (funk_notehead_width, funk_ti_weight);
2405         fill p_down_out;
2406 fet_endchar;
2407
2408
2409 %%%%%%   Walker shape note heads
2410 %
2411 % Walker heads are narrow like Funk heads, so use funk_notehead_width.
2412 %
2413
2414 %%%%%%   Walker do head
2415 %
2416 % Trapezoid, with largest side on stem side
2417 %
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#);
2421
2422         pickup pencircle scaled solfa_pen_thick;
2423
2424         save offset;
2425         offset := 2 * thickness_factor - 1;
2426
2427         % adjust width so stem can be centered
2428         if .5w <> good.x .5w: change_width; fi
2429
2430         save scaling;
2431
2432         scaling# = charwd / w;
2433
2434         save inset;
2435         inset := 0.25;
2436
2437         x1 = inset [x4, x3];
2438         top y1 = h;
2439
2440         x2 = inset [x3, x4];
2441         y2 = y1;
2442
2443         bot y3 = -d;
2444         rt x3 = w;
2445
2446         y4 = y3;
2447         lft x4 = 0;
2448
2449         labels (range 1 thru 4);
2450
2451         save left_dir, left_perp, right_dir, right_perp;
2452         pair left_dir, left_perp, right_dir, right_perp;
2453
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;
2458
2459         save path_a, path_b, path_c, path_d;
2460         path path_a, path_b, path_c, path_d;
2461
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));
2470
2471         save p_in, p_out;
2472         path p_in, p_out;
2473
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)
2478                 -- cycle;
2479
2480         p_out := top z1{right}
2481                  -- top z2{right}
2482                  .. z2 + right_perp {right_dir}
2483                  -- z3 + right_perp {right_dir}
2484                  .. bot z3{left}
2485                  -- bot z4{left}
2486                  .. z4 + left_perp {left_dir}
2487                  .. z1 + left_perp {left_dir}
2488                  .. cycle;
2489
2490         charwx := scaling# * (w/2 + solfa_pen_radius);
2491         charwy := scaling# * y2 ;
2492
2493         if dir = 1:
2494                 p_in := p_in rotated 180 shifted (w,0);
2495                 p_out := p_out rotated 180 shifted (w,0);
2496         fi;
2497 enddef;
2498
2499
2500 save walker_do_weight;
2501 walker_do_weight := 1.5;
2502
2503 fet_beginchar ("Whole Walker dohead", "s0doWalker");
2504         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2505         fill p_out;
2506         unfill p_in;
2507 fet_endchar;
2508
2509
2510 fet_beginchar ("Half up Walker dohead", "u1doWalker");
2511         draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2512         fill p_out;
2513         unfill p_in;
2514 fet_endchar;
2515
2516
2517 fet_beginchar ("Half down Walker dohead", "d1doWalker");
2518         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2519         fill p_out;
2520         unfill p_in;
2521 fet_endchar;
2522
2523
2524 fet_beginchar ("Quarter up Walker dohead", "u2doWalker");
2525         draw_Walker_do_head (funk_notehead_width, 1, walker_do_weight);
2526         fill p_out;
2527 fet_endchar;
2528
2529
2530 fet_beginchar ("Quarter down Walker dohead", "d2doWalker");
2531         draw_Walker_do_head (funk_notehead_width, 0, walker_do_weight);
2532         fill p_out;
2533 fet_endchar;
2534
2535
2536 %%%%%%   Walker re head
2537 %          Parabolic on one side, shallow parabola on other
2538 %          Has up and down shapes for *all* notes
2539 %
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#);
2543
2544         pickup pencircle scaled solfa_pen_thick;
2545         save offset;
2546         offset := 2 * thickness_factor - 1;
2547
2548         save dish_factor;
2549         dish_factor := 0.20;
2550
2551         rt x1 = w;
2552         bot y1 = -d;
2553
2554         lft x2 = 0;
2555         y2 = 0.5 [y1, y3];
2556
2557         top y3 = h;
2558         x3 = x1;
2559
2560         x4 = dish_factor [x1, x2];
2561         y4 = y2;
2562
2563         x5 = x1;
2564         y5 = y1 + offset * solfa_pen_radius;
2565
2566         y6 = y2;
2567         x6 = x2 + solfa_pen_radius;
2568
2569         x7 = x3;
2570         y7 = y3 - offset * solfa_pen_radius;
2571
2572         y8 = y4;
2573         x8 = x4 - solfa_pen_radius;
2574
2575         save path_a, path_d;
2576         path path_a, path_d;
2577
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;
2580
2581         path_a := z3 .. z4{down} .. z1;
2582
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;
2587
2588         path_d := (z3 - p_a_start_perp){p_a_start_dir}
2589                   .. z4 {down}
2590                   ..(z1 - p_a_end_perp){p_a_end_dir};
2591
2592         save path_b, path_c;
2593         path path_b, path_c;
2594
2595         path_b := z5 {left} .. z6{up};
2596         path_c := z7 {left} .. z6{down};
2597
2598         z9 = path_d intersectionpoint path_b;
2599         z10 = path_d intersectionpoint path_c;
2600
2601         labels (range 1 thru 4);
2602
2603         save p_in_dir_b, p_in_dir_c;
2604         pair p_in_dir_b, p_in_dir_c;
2605
2606         p_in_dir_b := unitvector (direction 0.4 of path_b);
2607         p_in_dir_c := unitvector (direction 0.4 of path_c);
2608
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;
2611
2612         p_down_in := z6{up} .. tension 1 and 1.5
2613                      .. {- p_in_dir_c} z10 {p_a_start_dir}
2614                      .. z8{down}
2615                      .. {p_a_end_dir} z9 {p_in_dir_b} .. tension 1.5 and 1
2616                      .. cycle;
2617
2618         p_down_out := lft z2{up}
2619                       .. top z3{right}
2620                       .. rt z3
2621                       .. (z3 + p_a_start_perp){p_a_start_dir}
2622                       .. rt z4{down}
2623                       .. (z1 + p_a_end_perp) {p_a_end_dir}
2624                       .. rt z1
2625                       .. bot z1 {left}
2626                       .. cycle;
2627
2628         p_up_in := p_down_in rotated 180 shifted (w,0);
2629         p_up_out := p_down_out rotated 180 shifted (w,0);
2630 enddef;
2631
2632
2633 save walker_re_weight;
2634 walker_re_weight := 1.5;
2635
2636 fet_beginchar ("Whole Walker rehead", "s0reWalker");
2637         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2638         fill p_down_out;
2639         unfill p_down_in;
2640 fet_endchar;
2641
2642
2643 fet_beginchar ("Half up Walker rehead", "u1reWalker");
2644         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2645         fill p_up_out;
2646         unfill p_up_in;
2647 fet_endchar;
2648
2649
2650 fet_beginchar ("Half down Walker rehead", "d1reWalker");
2651         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2652         fill p_down_out;
2653         unfill p_down_in;
2654 fet_endchar;
2655
2656
2657 fet_beginchar ("Quarter up Walker rehead", "u2reWalker");
2658         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2659         fill p_up_out;
2660 fet_endchar;
2661
2662
2663 fet_beginchar ("Quarter down Walker rehead", "d2reWalker");
2664         draw_Walker_re_head (funk_notehead_width, walker_re_weight);
2665         fill p_down_out;
2666 fet_endchar;
2667
2668
2669 %%%%%%  Walker mi head
2670 %       Diamond shape
2671 %       Symmetric for all hollow notes
2672 %
2673 save walker_mi_width, walker_mi_weight;
2674 walker_mi_width := 1.2;
2675 walker_mi_weight := 1.5;
2676
2677 fet_beginchar ("Whole Walker mihead", "s0miWalker");
2678         draw_mi_head (walker_mi_width * funk_notehead_width,
2679                       walker_mi_weight, true);
2680         fill path_out;
2681         unfill path_in;
2682 fet_endchar;
2683
2684
2685 fet_beginchar ("Half Walker mihead", "s1miWalker");
2686         draw_mi_head (walker_mi_width * funk_notehead_width,
2687                       walker_mi_weight, true);
2688         fill path_out;
2689         unfill path_in;
2690 fet_endchar;
2691
2692
2693 fet_beginchar ("Quarter Walker mihead", "s2miWalker");
2694         draw_mi_head (walker_mi_width * funk_notehead_width,
2695                       walker_mi_weight, true);
2696         fill path_out;
2697 fet_endchar;
2698
2699
2700 %%%%%%  Walker fa
2701 %       Triangle shape
2702 %       Does not rotate for whole notes
2703 %       Whole rotation is different from Funk, so special notes
2704
2705 %%%%%%  Funk sol head is the same as the others
2706 %       Need special character because of skinnier head
2707 %
2708 save walker_fa_weight;
2709 walker_fa_weight := 1.5;
2710
2711 fet_beginchar ("Whole Walker fahead", "s0faWalker");
2712         draw_fa_head (funk_notehead_width, walker_fa_weight);
2713         fill p_down_out;
2714         unfill p_down_in;
2715 fet_endchar;
2716
2717
2718 fet_beginchar ("Half up Walker fahead", "u1faWalker");
2719         draw_fa_head (funk_notehead_width, walker_fa_weight);
2720         fill p_up_out;
2721         unfill p_up_in;
2722 fet_endchar;
2723
2724
2725 fet_beginchar ("Half down Walker fahead", "d1faWalker");
2726         draw_fa_head (funk_notehead_width, walker_fa_weight);
2727         fill p_down_out;
2728         unfill p_down_in;
2729 fet_endchar;
2730
2731
2732 fet_beginchar ("Quarter up Walker fahead", "u2faWalker");
2733         draw_fa_head (funk_notehead_width, walker_fa_weight);
2734         fill p_up_out;
2735 fet_endchar;
2736
2737
2738 fet_beginchar ("Quarter down Walker fahead", "d2faWalker");
2739         draw_fa_head (funk_notehead_width, walker_fa_weight);
2740         fill p_down_out;
2741 fet_endchar;
2742
2743
2744 %%%%%%  Walker sol
2745 %       Same as Funk, no special notes
2746 %
2747
2748 %%%%%%  Walker la head
2749 %       Rectcangle head
2750 %       Lighter weight requires separate notes
2751 %
2752 save walker_la_weight;
2753 walker_la_weight := 1.5;
2754
2755 fet_beginchar ("Whole Walker lahead", "s0laWalker");
2756         draw_la_head (funk_notehead_width, walker_la_weight);
2757         fill p_out;
2758         unfill p_in;
2759 fet_endchar;
2760
2761
2762 fet_beginchar ("Half Funk lahead", "s1laWalker");
2763         draw_la_head (funk_notehead_width, walker_la_weight);
2764         fill p_out;
2765         unfill p_in;
2766 fet_endchar;
2767
2768
2769 fet_beginchar ("Quart Funk lahead", "s2laWalker");
2770         draw_la_head (funk_notehead_width, walker_la_weight);
2771         fill p_out;
2772 fet_endchar;
2773
2774
2775 %%%%%%  Walker ti head
2776 %       Triangular arrowhead
2777 %       Rotates for all but whole notes
2778 %
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#);
2782
2783         save offset;
2784         offset := 2 * thickness_factor - 1;
2785
2786         pickup pencircle scaled solfa_pen_thick;
2787
2788         lft x1 = 0;
2789         y1 = .5 [y2, y3];
2790
2791         rt x2 = w;
2792         top y2 = h;
2793
2794         x3 = x2;
2795         bot y3 = -d;
2796
2797
2798         labels (range 1 thru 4);
2799
2800         save nw_dist, sw_dist, ne, se;
2801         pair nw_dist, sw_dist, ne, se;
2802
2803         ne = unitvector (z2 - z1);
2804         se = unitvector (z3 - z1);
2805
2806         nw_dist = (ne rotated 90) * solfa_pen_radius ;
2807         sw_dist = (se rotated -90) * solfa_pen_radius;
2808
2809
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;
2818
2819         z4 = path_a intersectionpoint path_b;
2820         z5 = path_a intersectionpoint path_c;
2821         z6 = path_b intersectionpoint path_c;
2822
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;
2825
2826         p_down_in := z4
2827                      -- z5
2828                      -- z6
2829                      -- cycle;
2830
2831         p_down_out := lft z1{up}
2832                       .. (z1 + nw_dist){ne}
2833                       -- (z2 + nw_dist){ne}
2834                       .. top z2{right}
2835                       .. rt z2 {down}
2836                       -- rt z3 {down}
2837                       .. bot z3 {left}
2838                       .. (z3 + sw_dist){- se}
2839                       .. (z1 + sw_dist){- se}
2840                       .. cycle;
2841
2842         p_up_in := p_down_in rotated 180 shifted (w, 0);
2843         p_up_out := p_down_out rotated 180 shifted (w, 0);
2844 enddef;
2845
2846
2847 save walker_ti_weight;
2848 walker_ti_weight := 1.4;
2849
2850 fet_beginchar ("Whole Walker tihead", "s0tiWalker");
2851         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2852         fill p_down_out;
2853         unfill p_down_in;
2854 fet_endchar;
2855
2856
2857 fet_beginchar ("Half up Walker tihead", "u1tiWalker");
2858         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2859         fill p_up_out;
2860         unfill p_up_in;
2861 fet_endchar;
2862
2863
2864 fet_beginchar ("Half down Walker tihead", "d1tiWalker");
2865         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2866         fill p_down_out;
2867         unfill p_down_in;
2868 fet_endchar;
2869
2870
2871 fet_beginchar ("Quarter up Walker tihead", "u2tiWalker");
2872         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2873         fill p_up_out;
2874 fet_endchar;
2875
2876
2877 fet_beginchar ("Quarter down Walker tihead", "d2tiWalker");
2878         draw_Walker_ti_head (funk_notehead_width, walker_ti_weight);
2879         fill p_down_out;
2880 fet_endchar;
2881
2882 fet_endgroup ("noteheads");
2883
2884
2885 %
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.
2889 %
2890 % Let's keep it outside the group as well.
2891 %
2892
2893 define_pixels (black_notehead_width);