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