]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-bolletjes.mf
* mf/feta-bolletjes.mf (overdone_heads): add small style (ugly)
[lilypond.git] / mf / feta-bolletjes.mf
1 %  -*-Fundamental-*-
2 % feta-bolletjes.mf --  implement noteheads
3 %
4 % source file of LilyPond's pretty-but-neat music font
5 %
6 % (c) 1997--2006 Jan Nieuwenhuizen <janneke@gnu.org>
7 % & Han-Wen Nienhuys <hanwen@xs4all.nl>
8 % & Juergen Reuter <reuter@ipd.uka.de>
9 %
10
11 test_outlines := 0;
12
13
14 save remember_pic;
15 picture remember_pic;
16
17
18 % Most beautiful noteheads are pronounced, not circular,
19 % and not even symmetric.
20 % These examples are inspired by [Wanske]; see literature list.
21
22
23
24 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
25 % NOTE HEAD VARIABLES
26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
27
28 save black_notehead_width, noteheight;
29 save slash_thick, slash_slope, overdone_heads, solfa_noteheight;
30 numeric black_notehead_width, noteheight, slash_thick;
31
32
33 fet_begingroup ("noteheads");
34
35
36 % Slope of slash.  From scm/grob-description.scm.  How to auto-copy?
37 slash_slope := 1.7;
38
39 % Thickness of slash lines.  Quarter notes get 1.5slt width.
40 slash_thick# := 2/3 * 0.48 staff_space#;
41
42
43 %
44 % Hand-engraved music often has balls extending above and below
45 % the lines.  If you like that, modify overdone heads (unit:
46 % stafflinethickness).
47 %
48 overdone_heads = 0.0;
49 noteheight# := staff_space# + (1 + overdone_heads) * stafflinethickness#;
50
51
52 %
53 % solfa heads should not overlap on chords.
54 %
55 solfa_noteheight# := staff_space# - stafflinethickness#;
56
57 define_pixels (slash_thick);
58 define_whole_vertical_pixels (noteheight);
59
60
61 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
62 %
63 % SLANT moves both extrema on the long axis (by SLANT * ELLIPTICITY,
64 % so SLANT = -1, puts the extreme on the long axis next to the short
65 % axis one).
66 %
67
68 def draw_outside_ellipse (expr ellipticity, tilt, superness, slant) =
69         save attachment_y;
70         save pat;
71         path pat;
72
73         pat := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
74                              (-ellipticity, 0), (slant * ellipticity, -1.0),
75                              superness);
76         pat := pat rotated tilt;
77
78         save top_point, right_point;
79         pair top_point, right_point;
80
81         top_point := directionpoint left of pat;
82         right_point := directionpoint up of pat;
83
84         save scaling, width;
85
86         scaling# = noteheight# / (2 ypart (top_point));
87         width# := 2 xpart (right_point) * scaling#;
88         define_pixels (scaling, width);
89
90         set_char_box (0, width#, noteheight# / 2, noteheight# / 2);
91
92         d := d - feta_space_shift;
93
94         % attachment Y
95         charwy := ypart (right_point) * scaling#;
96         charwx := width#;
97
98         pat := pat scaled scaling shifted (w / 2, .5 (h - d));
99
100         width := hround width;
101
102         if test_outlines = 1:
103                 draw pat;
104         else:
105                 fill pat;
106         fi;
107 enddef;
108
109
110 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance) =
111 begingroup
112         save pat;
113         path pat;
114
115         pat := superellipse ((ellipticity, 0), (0, 1.0),
116                              (-ellipticity, 0), (0, -1.0),
117                              superness);
118         pat := pat rotated tilt;
119
120         save top_point, right_point;
121         pair top_point, right_point;
122
123         top_point := directionpoint left of pat;
124         right_point := directionpoint up of pat;
125
126         save height, scaling;
127
128         height# = staff_space# + stafflinethickness# - clearance;
129         scaling# = height# / (2 ypart (top_point));
130         define_pixels (scaling);
131         pat := pat scaled scaling shifted (w / 2, .5 (h - d));
132
133         if test_outlines = 1:
134                 draw pat;
135         else:
136                 unfill pat;
137         fi
138 endgroup;
139 enddef;
140
141
142 %
143 % dimensions aren't entirely right.
144 %
145 def draw_brevis =
146         save stemthick, fudge;
147
148         stemthick# = 2 stafflinethickness#;
149         define_whole_blacker_pixels (stemthick);
150
151         fudge = hround (blot_diameter / 2);
152
153         draw_outside_ellipse (1.80, 0, 0.707, 0);
154         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#);
155
156         pickup pencircle scaled stemthick;
157
158         bot y1 = -d;
159         top y2 = h;
160         rt x1 - fudge = 0;
161         x1 = x2;
162
163         fudge + lft x3 = w;
164         x4 = x3;
165         y4 = y2;
166         y3 = y1;
167
168         draw_gridline (z1, z2, stemthick);
169         draw_gridline (z3, z4, stemthick);
170 enddef;
171
172
173 fet_beginchar ("Brevis notehead", "s-1");
174         draw_brevis;
175
176         draw_staff (-2, 2, 0);
177 fet_endchar;
178
179
180 if test > 0:
181         fet_beginchar ("Brevis notehead", "s-1");
182                 draw_brevis;
183
184                 draw_staff (-2, 2, 0.5);
185         fet_endchar;
186 fi;
187
188
189 fet_beginchar ("Whole notehead", "s0");
190         draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0);
191         undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
192                                0.68, 2 stafflinethickness#);
193
194         draw_staff (-2, 2, 0);
195 fet_endchar;
196
197
198 if test > 0:
199         fet_beginchar ("Whole notehead", "s0");
200                 draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0,
201                                       0.707, 0);
202                 undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
203                                        0.68, 2 stafflinethickness#);
204
205                 draw_staff (-2, 2, 0.5);
206         fet_endchar;
207 fi;
208
209
210
211
212 fet_beginchar ("Half notehead", "s1");
213         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
214         undraw_inside_ellipse (3.25, 33, 0.81, 2.5 stafflinethickness#);
215
216         draw_staff (-2, 2, 0);
217 fet_endchar;
218
219
220 if test > 0:
221         fet_beginchar ("Half notehead", "s1");
222                 draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34,
223                                       0.66, 0.17);
224                 undraw_inside_ellipse (3.25, 33, 0.81,
225                                        2.5 stafflinethickness#);
226
227                 draw_staff (-2, 2, 0.5);
228         fet_endchar;
229 fi;
230
231
232 fet_beginchar ("Quart notehead", "s2");
233         % used to have 32. With 31, they are slightly bolder.
234         draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0);
235         black_notehead_width# := charwd;
236
237         draw_staff (-2, 2, 0);
238 fet_endchar;
239
240 if test > 0:
241         fet_beginchar ("Quart notehead", "s2");
242                 draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31,
243                                       0.707, 0);
244
245                 draw_staff (-2, 2, 0.5);
246         fet_endchar;
247 fi;
248
249 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
250
251 %%
252 %% fonts for "small style"
253 %% 
254
255 fet_beginchar ("Half notehead (quarter size)", "s1small");
256         draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0.0);
257         undraw_inside_ellipse (3.25, 33, 0.81, 2.8 stafflinethickness#);
258
259         draw_staff (-2, 2, 0);
260 fet_endchar;
261
262
263 %% copy of normal.
264 fet_beginchar ("Quart notehead (quarter size)", "s2small");
265         % used to have 32. With 31, they are slightly bolder.
266         draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0);
267         black_notehead_width# := charwd;
268
269         draw_staff (-2, 2, 0);
270 fet_endchar;
271
272 %% smaller.
273 fet_beginchar ("Whole notehead (quarter size)", "s0small");
274         draw_outside_ellipse (1.60 - puff_up_factor / 3.0, 0, 0.707, 0);
275         undraw_inside_ellipse (1.30, 125 - puff_up_factor * 10,
276                                0.68, 2 stafflinethickness#);
277
278         draw_staff (-2, 2, 0);
279 fet_endchar;
280
281
282 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
283
284
285 fet_beginchar ("Whole diamondhead", "s0diamond");
286         draw_outside_ellipse (1.80, 0, 0.495, 0);
287         undraw_inside_ellipse (1.30, 125, 0.6,
288                                .4 staff_space# + stafflinethickness#);
289
290         draw_staff (-2, 2, 0);
291 fet_endchar;
292
293
294 if test > 0:
295         fet_beginchar ("Whole diamondhead", "s0diamond");
296                 draw_outside_ellipse (1.80, 0, 0.495, 0);
297                 undraw_inside_ellipse (1.30, 125, 0.6,
298                                        .4 staff_space# + stafflinethickness#);
299
300                 draw_staff (-2, 2, 0.5);
301         fet_endchar;
302 fi;
303
304
305 fet_beginchar ("Half diamondhead", "s1diamond");
306         draw_outside_ellipse (1.50, 34, 0.49, 0.17);
307         undraw_inside_ellipse (3.5, 33, 0.80,
308                                .3 staff_space# + 1.5 stafflinethickness#);
309
310         draw_staff (-2, 2, 0);
311 fet_endchar;
312
313
314 if test > 0:
315         fet_beginchar ("Half diamondhead", "s1diamond");
316                 draw_outside_ellipse (1.50, 34, 0.49, 0.17);
317                 undraw_inside_ellipse (3.5, 33, 0.80,
318                                        .3 staff_space#
319                                        + 1.5 stafflinethickness#);
320
321                 draw_staff (-2, 2, 0.5);
322         fet_endchar;
323 fi;
324
325
326 fet_beginchar ("Quart diamondhead", "s2diamond");
327         draw_outside_ellipse (1.80, 35, 0.495, -0.25);
328
329         draw_staff (-2, 2, 0);
330 fet_endchar;
331
332
333 if test > 0:
334         fet_beginchar ("Quart diamondhead", "s2diamond");
335                 draw_outside_ellipse (1.80, 35, 0.495, -0.25);
336
337                 draw_staff (-2, 2, 0.5);
338         fet_endchar;
339 fi;
340
341
342 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
343
344
345 vardef penposx@# (expr d) = 
346 begingroup;
347         save pat;
348         path pat;
349
350         pat = top z@#
351               .. lft z@#
352               .. bot z@#
353               .. rt z@#
354               .. cycle;
355         z@#l = pat intersectionpoint (z@# -- infinity * dir (d + 180));
356         z@#r = pat intersectionpoint (z@# -- infinity * dir (d));
357 endgroup
358 enddef;
359
360
361 def define_triangle_shape (expr stemdir) =
362         save triangle_a, triangle_b, triangle_c;
363         save triangle_out_a, triangle_out_b, triangle_out_c;
364         save triangle_in, triangle_out;
365         save width, depth, height;
366         save origin, left_up_dir;
367         save exact_left_point, exact_right_point, exact_down_point;
368
369         path triangle_a, triangle_b, triangle_c;
370         path triangle_out_a, triangle_out_b, triangle_out_c;
371         path triangle_in, triangle_out;
372         pair origin, left_up_dir;
373         pair exact_down_point, exact_left_point, exact_right_point;
374
375         save pen_thick;
376         pen_thick# = stafflinethickness# + .1 staff_space#;
377         define_pixels (llap);
378         define_blacker_pixels (pen_thick);
379
380         left_up_dir = llap# * dir (90 + tilt);
381
382         xpart (left_up_dir) * xs - (pen_thick# * xs) / 2 + xpart origin = 0;
383         ypart origin = 0;
384
385         exact_left_point := origin + (left_up_dir xscaled xs);
386         exact_down_point := origin + (left_up_dir rotated 120 xscaled xs);
387         exact_right_point := origin + (left_up_dir rotated 240 xscaled xs);
388
389         height# = ypart (exact_left_point + origin) + pen_thick# / 2;
390         depth# = -ypart (exact_down_point + origin) + pen_thick# / 2;
391         width# = xpart (exact_right_point - exact_left_point)
392                  + pen_thick# * xs;
393
394         set_char_box (0, width#, depth#, height#);
395
396         % Formerly, the shape has simply been drawn with an elliptical pen
397         % (`scaled pen_thick xsaled xs'), but the envelope of such a curve
398         % is of 6th degree.  For the sake of mf2pt1, we approximate it.
399
400         pickup pencircle scaled pen_thick xscaled xs;
401
402         z0 = (hround_pixels (xpart origin), 0);
403
404         z1 = z1' = z0 + llap * dir (90 + tilt) xscaled xs;
405         z2 = z2' = z0 + llap * dir (90 + tilt + 120) xscaled xs;
406         z3 = z3' = z0 + llap * dir (90 + tilt + 240) xscaled xs;
407
408         z12 = caveness [.5[z1, z2], z3];
409         z23 = caveness [.5[z2, z3], z1];
410         z31 = caveness [.5[z3, z1], z2];
411
412         triangle_a = z1 .. z12 .. z2;
413         triangle_b = z2 .. z23 .. z3;
414         triangle_c = z3 .. z31 .. z1;
415
416         penposx1 (angle (direction 0 of triangle_a) - 90);
417         penposx2 (angle (direction 0 of triangle_b) - 90);
418         penposx3 (angle (direction 0 of triangle_c) - 90);
419
420         penposx1' (angle (direction infinity of triangle_c) + 90);
421         penposx2' (angle (direction infinity of triangle_a) + 90);
422         penposx3' (angle (direction infinity of triangle_b) + 90);
423
424         penposx12 (angle (z12 - z0));
425         penposx23 (angle (z23 - z0));
426         penposx31 (angle (z31 - z0));
427
428         z10 = (z0 -- z1) intersectionpoint (z1l .. z12l .. z2'r);
429         z20 = (z0 -- z2) intersectionpoint (z2l .. z23l .. z3'r);
430         z30 = (z0 -- z3) intersectionpoint (z3l .. z31l .. z1'r);
431
432         triangle_in = z10
433                       .. z12l
434                       .. z20
435                       & z20
436                       .. z23l
437                       .. z30
438                       & z30
439                       .. z31l
440                       .. z10
441                       & cycle;
442
443         triangle_out_a = z1r .. z12r .. z2'l;
444         triangle_out_b = z2r .. z23r .. z3'l;
445         triangle_out_c = z3r .. z31r .. z1'l;
446
447         triangle_out = top z1
448                        .. lft z1
449                        .. z1r{direction 0 of triangle_out_a}
450                        & triangle_out_a
451                        & {direction infinity of triangle_out_a}z2'l
452                        .. lft z2
453                        .. bot z2
454                        .. z2r{direction 0 of triangle_out_b}
455                        & triangle_out_b
456                        & {direction infinity of triangle_out_b}z3'l
457                        .. rt z3
458                        .. top z3
459                        .. z3r{direction 0 of triangle_out_c}
460                        & triangle_out_c
461                        & {direction infinity of triangle_out_c}z1'l
462                        .. cycle;
463
464         labels (0, 10, 20, 30);
465         penlabels (1, 1', 2, 2', 3, 3', 12, 23, 31);
466
467         % attachment Y
468         if stemdir = 1:
469                 charwy := ypart exact_right_point;
470                 charwx := xpart exact_right_point;
471         else:
472                 charwy := -ypart exact_down_point;
473                 charwx := (width# - xpart exact_down_point);
474         fi
475 enddef;
476
477
478 def draw_whole_triangle_head =
479         save hei, xs;
480         save llap;
481         save tilt;
482
483         tilt = 40;
484         llap# = 3/4 noteheight#;
485
486         xs = 1.5;
487         caveness := 0.1;
488         define_triangle_shape (1);
489         fill triangle_out;
490         unfill triangle_in;
491 enddef;
492
493
494 fet_beginchar ("Whole trianglehead", "s0triangle");
495         draw_whole_triangle_head;
496
497         draw_staff (-2, 2, 0);
498 fet_endchar;
499
500
501 if test > 0:
502         fet_beginchar ("Whole trianglehead", "s0triangle");
503                 draw_whole_triangle_head;
504
505                 draw_staff (-2, 2, 0.5);
506         fet_endchar;
507 fi;
508
509
510 def draw_small_triangle_head (expr dir) =
511         save hei, xs;
512         save llap;
513         save tilt;
514
515         tilt = 40;
516         llap# = 2/3 noteheight#;
517         xs = 1.2;
518         caveness := 0.1;
519         define_triangle_shape (dir);
520
521         pickup feta_fillpen;
522
523         filldraw triangle_out;
524         unfilldraw triangle_in;
525 enddef;
526
527
528 fet_beginchar ("Half trianglehead", "d1triangle");
529         draw_small_triangle_head (-1);
530
531         draw_staff (-2, 2, 0);
532 fet_endchar;
533
534
535 fet_beginchar ("Half trianglehead", "u1triangle");
536         draw_small_triangle_head (1);
537
538         draw_staff (-2, 2, 0.5);
539 fet_endchar;
540
541
542 def draw_closed_triangle_head (expr dir) =
543         save hei, xs;
544         save llap;
545         save tilt;
546
547         tilt = 40;
548         llap# = 2/3 noteheight#;
549         xs = 1.0;
550         caveness := 0.1;
551         define_triangle_shape (dir);
552         fill triangle_out;
553 enddef;
554
555
556 fet_beginchar ("Quart trianglehead", "u2triangle");
557         draw_closed_triangle_head (1);
558
559         draw_staff (-2, 2, 0);
560 fet_endchar;
561
562
563 fet_beginchar ("Quart trianglehead", "d2triangle");
564         draw_closed_triangle_head (-1);
565
566         draw_staff (-2, 2, 0.5);
567 fet_endchar;
568
569
570 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
571 %
572 % Slash heads are for indicating improvisation.  They are
573 % twice as high as normal heads.
574 %
575 def draw_slash (expr hwid_hash) =
576         save exact_height;
577         save ne, nw_dist;
578         pair ne, nw_dist;
579         exact_height = staff_space# + stafflinethickness# / 2;
580
581         set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
582                       exact_height, exact_height);
583
584         charwx := charwd;
585         charwy := charht;
586
587         clearxy;
588
589         d := d - feta_shift;
590
591         pickup pencircle scaled blot_diameter;
592
593         bot y1 = -d;
594         top y2 = h;
595         lft x1 = 0;
596         lft x2 = 2 h / slash_slope;
597
598         rt x3 = w;
599         y3 = y2;
600         y4 = y1;
601         x3 - x2 = x4 - x1;
602
603         ne = unitvector (z3 - z4);
604         nw_dist = (ne rotated 90) * 0.5 blot_diameter;
605
606         fill bot z1{left}
607              .. (z1 + nw_dist){ne}
608              -- (z2 + nw_dist){ne}
609              .. top z2{right}
610              -- top z3{right}
611              .. (z3 - nw_dist){-ne}
612              -- (z4 - nw_dist){-ne}
613              .. bot z4{left}
614              -- cycle;
615
616         if hwid_hash > 2 slash_thick#:
617                 save th;
618
619                 th = slash_thick - blot_diameter;
620                 y6 = y7;
621                 y5 = y8;
622                 y3 - y7 = th;
623                 y5 - y1 = th;
624                 z6 - z5 = whatever * ne;
625                 z8 - z7 = whatever * ne;
626
627                 z5 = z1 + whatever * ne + th * (ne rotated -90);
628                 z8 = z4 + whatever * ne + th * (ne rotated 90);
629
630                 unfill z5
631                        -- z6
632                        -- z7
633                        -- z8
634                        -- cycle;
635         fi
636         labels (range 1 thru 10);
637 enddef;
638
639
640 fet_beginchar ("Whole slashhead", "s0slash");
641         draw_slash (4 slash_thick# + 0.5 staff_space#);
642
643         draw_staff (-2, 2, 0);
644 fet_endchar;
645
646
647 fet_beginchar ("Half slashhead", "s1slash");
648         draw_slash (3.0 slash_thick# + 0.15 staff_space#);
649
650         draw_staff (-2, 2, 0);
651 fet_endchar;
652
653
654 fet_beginchar ("Quart slashhead", "s2slash");
655         draw_slash (1.5 slash_thick#);
656
657         draw_staff (-2, 2, 0);
658 fet_endchar;
659
660
661 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
662 %
663 % `thick' is the distance between the NE/SW parallel lines in the cross
664 % (distance between centres of lines) in multiples of stafflinethickness
665 %
666 def draw_cross (expr thick) =
667         save ne, nw;
668         save ne_dist, nw_dist, rt_dist, up_dist;
669         save crz_in, crz_out;
670         save thickness;
671         pair ne, nw;
672         pair ne_dist, nw_dist, rt_dist, up_dist;
673         path crz_in, crz_out;
674
675         pen_thick# := 1.2 stafflinethickness#;
676         thickness# := thick * stafflinethickness#;
677         define_pixels (thickness);
678         define_blacker_pixels (pen_thick);
679
680         pickup pencircle scaled pen_thick;
681
682         h := h - feta_shift;
683
684         top y3 = h;
685         ne = unitvector ((1, (2 h - pen_thick) / (w - pen_thick)));
686         rt x4 = w / 2;
687         y5 = 0;
688         z4 - z5 = whatever * ne;
689         x6 = 0;
690         z6 - z3 = whatever * ne;
691         z3 - z4 = whatever * (ne yscaled -1);
692
693         z4 - z3 = whatever * (ne) + (ne rotated -90) * thickness;
694
695
696         x1 = charwd / 2 - .5 pen_thick#;
697         z1 = whatever * ne
698              + thick / 2 * stafflinethickness# * (ne rotated -90);
699
700         % labels (1, 2, 3, 4, 5, 6);
701
702         nw = unitvector (z3 - z4);
703
704         up_dist = up * 0.5 pen_thick / cosd (angle (ne));
705         rt_dist = right * 0.5 pen_thick / sind (angle (ne));
706         nw_dist = (ne rotated 90) * 0.5 pen_thick;
707         ne_dist = (nw rotated -90) * 0.5 pen_thick;
708
709         x4' := x4;
710         x5' := x5;
711         y6' := y6;
712
713         x4 := hround (x4' + .5 pen_thick) - .5 pen_thick;
714         x5 := hfloor (x5' + xpart rt_dist) - xpart rt_dist;
715         y6 := vfloor (y6' + ypart up_dist) - ypart up_dist;
716
717         crz_out = (z6 + up_dist)
718                   -- (z3 + nw_dist){ne}
719                   .. (top z3)
720                   .. (z3 + ne_dist){-nw}
721                   -- (z4 + ne_dist){-nw}
722                   .. (rt z4)
723                   .. (z4 - nw_dist){-ne}
724                   -- (z5 + rt_dist);
725         crz_out := crz_out shifted (0, feta_shift)
726                    -- reverse crz_out yscaled -1 shifted (0, -feta_eps);
727         fill crz_out
728              -- reverse crz_out xscaled -1 shifted (-feta_eps, 0)
729              -- cycle;
730
731         if (thick > 1):
732                 x4 := hround (x4' - xpart rt_dist) + xpart rt_dist;
733                 x5 := hceiling (x5' - .5 pen_thick) + .5 pen_thick;
734                 y6 := vfloor (y6' - .5 pen_thick) + .5 pen_thick;
735
736                 crz_in = (bot z6){right}
737                          .. (z6 - nw_dist){ne}
738                          -- (z3 - up_dist)
739                          -- (z4 - rt_dist)
740                          -- (z5 + nw_dist){-ne}
741                          .. {down}(lft z5);
742                 crz_in := crz_in shifted (0, feta_shift)
743                           -- reverse crz_in yscaled -1 shifted (0, -feta_eps);
744                 unfill crz_in
745                        -- reverse crz_in xscaled -1 shifted (-feta_eps, 0)
746                        -- cycle;
747         fi
748
749         % ugh
750         currentpicture := currentpicture shifted (hround (w / 2), 0);
751
752         charwx := charwd;
753         charwy := y1 + feta_shift;
754
755         z12 = (charwx * hppp, y1 * vppp);
756
757         labels (12);
758 enddef;
759
760
761 fet_beginchar ("Whole Crossed notehead", "s0cross");
762         save wid, hei;
763
764         wid# := black_notehead_width# + 4 stafflinethickness#;
765         hei# := noteheight# + stafflinethickness#;
766
767         set_char_box (0, wid#, hei# / 2, hei# / 2);
768
769         draw_cross (3.75);
770
771         remember_pic := currentpicture;
772
773         draw_staff (-2, 2, 0);
774 fet_endchar;
775
776
777 if test > 0:
778         fet_beginchar ("Whole Crossed notehead", "s0cross");
779                 save wid, hei;
780
781                 wid# := black_notehead_width# + 4 stafflinethickness#;
782                 hei# := noteheight# + stafflinethickness#;
783
784                 set_char_box (0, wid#, hei# / 2, hei# / 2);
785
786                 currentpicture := remember_pic;
787
788                 draw_staff (-2, 2, 0.5);
789         fet_endchar;
790 fi;
791
792
793 fet_beginchar ("Half Crossed notehead", "s1cross");
794         save wid, hei;
795
796         wid# := black_notehead_width# + 2 stafflinethickness#;
797         hei# := noteheight# + stafflinethickness# / 2;
798
799         set_char_box (0, wid#, hei# / 2, hei# / 2);
800
801         draw_cross (3.0);
802
803         remember_pic := currentpicture;
804
805         draw_staff (-2, 2, 0);
806 fet_endchar;
807
808
809 if test > 0:
810         fet_beginchar ("Half Crossed notehead", "s1cross");
811                 save wid, hei;
812
813                 wid# := black_notehead_width# + 2 stafflinethickness#;
814                 hei# := noteheight# + stafflinethickness# / 2;
815
816                 set_char_box (0, wid#, hei# / 2, hei# / 2);
817
818                 currentpicture := remember_pic;
819
820                 draw_staff (-2, 2, 0.5);
821         fet_endchar;
822 fi;
823
824
825 fet_beginchar ("Crossed notehead", "s2cross");
826         wid# := black_notehead_width#;
827         hei# := noteheight#;
828         set_char_box (0, wid#, hei# / 2, hei# / 2);
829
830         draw_cross (1.0);
831
832         remember_pic := currentpicture;
833
834         draw_staff (-2, 2, 0);
835 fet_endchar;
836
837
838 if test > 0:
839         fet_beginchar ("Crossed notehead", "s2cross");
840                 wid# := black_notehead_width#;
841                 hei# := noteheight#;
842                 set_char_box (0, wid#, hei# / 2, hei# / 2);
843
844                 currentpicture := remember_pic;
845
846                 draw_staff (-2, 2, 0.5);
847         fet_endchar;
848 fi;
849
850
851 fet_beginchar ("X-Circled notehead", "s2xcircle");
852         save wid, hei;
853         save cthick, cxd, cyd, dy;
854
855         wid# := black_notehead_width# * sqrt (sqrt2);
856         hei# := noteheight# * sqrt (sqrt2);
857
858         set_char_box (0, wid#, hei# / 2, hei# / 2);
859
860         d := d - feta_space_shift;
861
862         cthick# := (1.2 + 1/4) * stafflinethickness#;
863         define_blacker_pixels (cthick);
864
865         cxd := w - cthick;
866         cyd := h + d - cthick / 2;
867
868         dy = .5 (h - d);
869
870         pickup pencircle scaled cthick;
871
872         fill fullcircle xscaled (cxd + cthick)
873                         yscaled (cyd + cthick)
874                         shifted (w / 2, dy);
875         unfill fullcircle xscaled (cxd - cthick)
876                           yscaled (cyd - cthick)
877                           shifted (w / 2, dy);
878
879         xpos := .5 cxd / sqrt2;
880         ypos := .5 cyd / sqrt2;
881
882         pickup penrazor scaled cthick rotated (angle (xpos, ypos) + 90);
883         draw (-xpos + w / 2, -ypos + dy) -- (xpos + w / 2, ypos + dy);
884
885         pickup penrazor scaled cthick rotated (angle (xpos, -ypos) + 90);
886         draw (-xpos + w / 2, ypos + dy) -- (xpos + w / 2, -ypos + dy);
887
888         charwx := charwd;
889         charwy := 0;
890
891         z12 = (charwx * hppp, charwy * vppp);
892         labels (12);
893
894         remember_pic := currentpicture;
895
896         draw_staff (-2, 2, 0);
897 fet_endchar;
898
899
900 if test > 0:
901         fet_beginchar ("X-Circled notehead", "s2xcircle");
902                 save wid, hei;
903                 save cthick, cxr, cyr;
904
905                 wid# := black_notehead_width# * sqrt (sqrt2);
906                 hei# := noteheight# * sqrt (sqrt2);
907
908                 set_char_box (0, wid#, hei# / 2, hei# / 2);
909
910                 currentpicture := remember_pic;
911
912                 draw_staff (-2, 2, 0.5);
913         fet_endchar;
914 fi;
915
916
917 %%%%%%%%
918 %
919 % SOLFA SHAPED NOTES
920 %
921
922 save solfa_pen_thick;
923 solfa_pen_thick# = 2 stafflinethickness#;
924 define_blacker_pixels (solfa_pen_thick);
925
926
927 solfa_whole_width := 1.8;
928 solfa_half_width := 1.35;
929 solfa_quarter_width := 1.35;
930
931
932 def draw_do_head (expr width_factor, dir) =
933         save p_in, p_out;
934         save left_dist, right_dist;
935         path p_in, p_out;
936         pair left_dist, right_dist;
937
938         set_char_box (0, width_factor * solfa_noteheight#,
939                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
940
941         pickup pencircle scaled solfa_pen_thick;
942
943         bot y1 = -d;
944         y1 = y2;
945         lft x1 = 0;
946         rt x2 = w;
947         top y3 = h;
948         x3 =.5 [x1, x2];
949
950         left_dist = (unitvector (z3 - z1) rotated 90) * 0.5 solfa_pen_thick;
951         right_dist = (unitvector (z2 - z3) rotated 90) * 0.5 solfa_pen_thick;
952
953         p_in := (((z1 - left_dist) -- (z3 - left_dist)) intersectionpoint
954                   (top z1 -- top z2))
955                 -- ((top z1 -- top z2) intersectionpoint
956                     ((z2 - right_dist) -- (z3 - right_dist)))
957                 -- (((z2 - right_dist) -- (z3 - right_dist)) intersectionpoint
958                     ((z1 - left_dist) -- (z3 - left_dist)))
959                 -- cycle;
960
961         p_out := bot z1
962                  -- bot z2{right}
963                  .. rt z2{up}
964                  .. (z2 + right_dist){z3 - z2}
965                  -- (z3 + right_dist){z3 - z2}
966                  .. top z3{left}
967                  .. (z3 + left_dist){z1 - z3}
968                  -- (z1 + left_dist){z1 - z3}
969                  .. lft z1{down}
970                  .. {right}cycle;
971                  
972
973         labels (1, 2, 3);
974
975         charwx := charwd;
976         charwy := -chardp + 0.5 stafflinethickness#;
977         if dir = -1:
978                 charwy := -charwy;
979         fi;
980 enddef;
981
982
983 fet_beginchar ("Whole dohead", "s0do");
984         draw_do_head (solfa_whole_width, 1);
985         fill p_out;
986         unfill p_in;
987 fet_endchar;
988
989
990 fet_beginchar ("Half dohead", "d1do");
991         draw_do_head (solfa_half_width, -1);
992         fill p_out;
993         unfill p_in;
994 fet_endchar;
995
996
997 fet_beginchar ("Half dohead", "u1do");
998         draw_do_head (solfa_half_width, 1);
999         fill p_out;
1000         unfill p_in;
1001 fet_endchar;
1002
1003
1004 fet_beginchar ("Quart dohead", "d2do");
1005         draw_do_head (solfa_quarter_width, -1);
1006         fill p_out;
1007 fet_endchar;
1008
1009
1010 fet_beginchar ("Quart dohead", "u2do");
1011         draw_do_head (solfa_quarter_width, 1);
1012         fill p_out;
1013 fet_endchar;
1014
1015
1016 %
1017 % re - flat top, curved bottom:
1018 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
1019 % (broader along the base and with more vertical sides for half and
1020 % whole notes)
1021 % stem attachment: h/2
1022 %
1023
1024 def draw_re_head (expr width_factor, dir) =
1025         save p_in, p_out;
1026         path p_in, p_out;
1027
1028         set_char_box (0, width_factor * solfa_noteheight#,
1029                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1030
1031         pickup pencircle scaled solfa_pen_thick;
1032
1033         save curve_start;
1034         curve_start = 0.7;
1035         lft x1 = 0;
1036         y1 = y5;
1037         x1 = x2;
1038         y2 = curve_start [y3, y1];
1039         bot y3 = -d;
1040         x3 = .5 [x2, x4];
1041         rt x4 = w;
1042         y4 = y2;
1043         top y5 = h;
1044         x5 = x4;
1045
1046         labels (range 1 thru 5);
1047
1048         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1049                 -- rt z2{down}
1050                 .. top z3
1051                 .. lft z4{up}
1052                 -- (z5 + 0.5 solfa_pen_thick * (-1, -1))
1053                 -- cycle;
1054
1055         p_out := lft z1
1056                  -- lft z2{down}
1057                  .. bot z3
1058                  .. rt z4{up}
1059                  -- rt z5{up}
1060                  .. top z5{left}
1061                  -- top z1{left}
1062                  .. {down}cycle;
1063
1064         charwx := charwd;
1065         charwy := curve_start [-chardp, charht];
1066
1067         if dir = -1:
1068                 charwy := -charwy;
1069         fi;
1070 enddef;
1071
1072
1073 fet_beginchar ("Whole rehead", "s0re");
1074         draw_re_head (solfa_whole_width, 1);
1075         fill p_out;
1076         unfill p_in;
1077 fet_endchar;
1078
1079
1080 fet_beginchar ("Half up rehead", "u1re");
1081         draw_re_head (solfa_half_width, 1);
1082         fill p_out;
1083         unfill p_in;
1084 fet_endchar;
1085
1086
1087 fet_beginchar ("Half down rehead", "d1re");
1088         draw_re_head (solfa_half_width, -1);
1089         fill p_out;
1090         unfill p_in;
1091 fet_endchar;
1092
1093
1094 fet_beginchar ("Quart rehead", "u2re");
1095         draw_re_head (solfa_quarter_width, 1);
1096         fill p_out;
1097 fet_endchar;
1098
1099
1100 fet_beginchar ("Quart rehead", "d2re");
1101         draw_re_head (solfa_quarter_width, -1);
1102         fill p_out;
1103 fet_endchar;
1104
1105
1106 def draw_mi_head (expr width_factor) =
1107         save path_out, path_in;
1108         save ne_dist, se_dist, ne, se;
1109         path path_out, path_in;
1110         pair ne_dist, se_dist, ne, se;
1111
1112         set_char_box (0, width_factor * solfa_noteheight#,
1113                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1114
1115         pickup pencircle scaled solfa_pen_thick;
1116
1117         lft x1 = 0;
1118         y1 = 0;
1119         bot y2 = -d;
1120         x2 = .5 [x1, x3];
1121         rt x3 = w;
1122         x4 = x2;
1123         y3 = y1;
1124         top y4 = h;
1125
1126         z6 - z5 = whatever * (z2 - z1);
1127         z8 - z7 = whatever * (z2 - z1);
1128         z8 - z5 = whatever * (z4 - z1);
1129         z6 - z7 = whatever * (z4 - z1);
1130
1131         ne = unitvector (z4 - z1);
1132         se = unitvector (z1 - z2);
1133
1134         ne_dist = (ne rotated 90) * 0.5 solfa_pen_thick;
1135         se_dist = (se rotated 90) * 0.5 solfa_pen_thick;
1136
1137         z5 = whatever [z1, z4] - ne_dist;
1138         z5 = whatever [z1, z2] - 1.5 se_dist;
1139
1140         z5 - z1 = -(z7 - z3);
1141
1142         labels (range 1 thru 8);
1143
1144         path_in := z5
1145                    -- z6
1146                    -- z7
1147                    -- z8
1148                    -- cycle;
1149
1150         path_out := lft z1
1151                     .. (z1 + se_dist){-se}
1152                     -- (z2 + se_dist){-se}
1153                     .. bot z2
1154                     .. (z2 - ne_dist){ne}
1155                     -- (z3 - ne_dist){ne}
1156                     .. rt z3
1157                     .. (z3 - se_dist){se}
1158                     -- (z4 - se_dist){se}
1159                     .. top z4
1160                     .. (z4 + ne_dist){-ne}
1161                     -- (z1 + ne_dist){-ne}
1162                     .. cycle;
1163 enddef;
1164
1165
1166 fet_beginchar ("Whole mihead", "s0mi");
1167         draw_mi_head (solfa_whole_width);
1168         fill path_out;
1169         unfill path_in;
1170 fet_endchar;
1171
1172
1173 fet_beginchar ("Half mihead", "s1mi");
1174         draw_mi_head (solfa_quarter_width);
1175         fill path_out;
1176         unfill path_in;
1177 fet_endchar;
1178
1179
1180 fet_beginchar ("Quart mihead", "s2mi");
1181         draw_mi_head (solfa_quarter_width);
1182         fill path_out;
1183 fet_endchar;
1184
1185
1186 def draw_fa_head (expr width_factor) =
1187         set_char_box (0, width_factor * solfa_noteheight#,
1188                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1189
1190         save p_down_in, p_down_out, p_up_in, p_up_out, nw_dist, nw;
1191         path p_down_in, p_down_out, p_up_in, p_up_out;
1192         pair nw_dist, nw;
1193
1194         pickup pencircle scaled solfa_pen_thick;
1195
1196         lft x1 = 0;
1197         top y1 = h;
1198
1199         rt x2 = w;
1200         y2 = y1;
1201         bot y3 = -d;
1202         x3 = x2;
1203
1204         y4 = y3;
1205         x4 = x1;
1206
1207         labels (1, 2, 3, 4);
1208
1209         nw = unitvector (z1 - z3);
1210         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1211
1212         p_up_in := (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1213                      (bot z1 -- bot z2))
1214                    -- (((z1 - nw_dist) -- (z3 - nw_dist)) intersectionpoint
1215                         (lft z3 -- lft z2))
1216                    -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1217                    -- cycle;
1218
1219         p_up_out := lft z1{down}
1220                     .. (z1 + nw_dist){-nw}
1221                     -- (z3 + nw_dist){-nw}
1222                     .. bot z3{right}
1223                     .. rt z3{up}
1224                     -- rt z2{up}
1225                     .. top z2{left}
1226                     -- top z1{left}
1227                     .. {down}cycle;
1228
1229         p_down_in := p_up_in rotated 180 shifted (w, 0);
1230         p_down_out := p_up_out rotated 180 shifted (w, 0);
1231
1232         charwy := 0.0;
1233         charwx := charwd;
1234 enddef;
1235
1236
1237 fet_beginchar ("Whole fa up head", "u0fa");
1238         draw_fa_head (solfa_whole_width);
1239         fill p_up_out;
1240         unfill p_up_in;
1241 fet_endchar;
1242
1243
1244 fet_beginchar ("Whole fa down head", "d0fa");
1245         draw_fa_head (solfa_whole_width);
1246         fill p_down_out;
1247         unfill p_down_in;
1248 fet_endchar;
1249
1250
1251 fet_beginchar ("half fa up head", "u1fa");
1252         draw_fa_head (solfa_half_width);
1253         fill p_up_out;
1254         unfill p_up_in;
1255 fet_endchar;
1256
1257
1258 fet_beginchar ("Half fa down head", "d1fa");
1259         draw_fa_head (solfa_half_width);
1260         fill p_down_out;
1261         unfill p_down_in;
1262 fet_endchar;
1263
1264
1265 fet_beginchar ("Quarter fa up head", "u2fa");
1266         draw_fa_head (solfa_quarter_width);
1267         fill p_up_out;
1268 fet_endchar;
1269
1270
1271 fet_beginchar ("Quarter fa down head", "d2fa");
1272         draw_fa_head (solfa_quarter_width);
1273         fill p_down_out;
1274 fet_endchar;
1275
1276
1277 def draw_la_head (expr width_factor) =
1278         set_char_box (0, width_factor * solfa_noteheight#,
1279                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1280         save p_in, p_out;
1281         path p_in, p_out;
1282
1283         pickup pencircle scaled solfa_pen_thick;
1284
1285         lft x1 = 0;
1286         top y1 = h;
1287
1288         rt x2 = w;
1289         y2 = y1;
1290         bot y3 = -d;
1291         x3 = x2;
1292
1293         y4 = y3;
1294         x4 = x1;
1295
1296         labels (range 1 thru 4);
1297
1298         p_in := (z1 + 0.5 solfa_pen_thick * (1, -1))
1299                 -- (z2 + 0.5 solfa_pen_thick * (-1, -1))
1300                 -- (z3 + 0.5 solfa_pen_thick * (-1, 1))
1301                 -- (z4 + 0.5 solfa_pen_thick * (1, 1))
1302                 -- cycle;
1303
1304         p_out := top z1
1305                  -- top z2{right}
1306                  .. rt z2{down}
1307                  -- rt z3{down}
1308                  .. bot z3{left}
1309                  -- bot z4{left}
1310                  .. lft z4{up}
1311                  -- lft z1{up}
1312                  .. cycle;
1313 enddef;
1314
1315
1316 fet_beginchar ("Whole lahead", "s0la");
1317         draw_la_head (solfa_whole_width);
1318         fill p_out;
1319         unfill p_in;
1320 fet_endchar;
1321
1322
1323 fet_beginchar ("Half lahead", "s1la");
1324         draw_la_head (solfa_half_width);
1325         fill p_out;
1326         unfill p_in;
1327 fet_endchar;
1328
1329
1330 fet_beginchar ("Quart lahead", "s2la");
1331         draw_la_head (solfa_quarter_width);
1332         fill p_out;
1333 fet_endchar;
1334
1335
1336 def draw_ti_head (expr width_factor, dir) =
1337         set_char_box (0, width_factor * solfa_noteheight#,
1338                       0.5 solfa_noteheight#, 0.5 solfa_noteheight#);
1339         save p_in, p_out, p_top;
1340         save nw_dist, sw_dist, nw, sw;
1341         path p_in, p_out, p_top;
1342         pair nw_dist, sw_dist, nw, sw;
1343         save cone_height;
1344         cone_height = 0.64;
1345
1346         pickup pencircle scaled solfa_pen_thick;
1347
1348         x1 = .5 [x2, x4];
1349         bot y1 = -d;
1350         lft x2 = 0;
1351         y2 = cone_height [y1, y3];
1352         rt x4 = w;
1353         y4 = y2;
1354         x3 = x1;
1355         top y3 = h;
1356
1357         labels (range 1 thru 4);
1358
1359         nw = unitvector (z2 - z1);
1360         sw = unitvector (z1 - z4);
1361
1362         nw_dist = (nw rotated 90) * 0.5 solfa_pen_thick;
1363         sw_dist = (sw rotated 90) * 0.5 solfa_pen_thick;
1364
1365         p_top := (z2 - sw_dist)
1366                  .. (top z3){right}
1367                  .. (z4 - nw_dist);
1368
1369         p_in := (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1370                   ((z1 - sw_dist) -- (z4 - sw_dist)))
1371                 -- (((z1 - nw_dist) -- (z2 - nw_dist)) intersectionpoint
1372                      ((z2 + sw_dist) .. {right}(bot z3)))
1373                 .. bot z3
1374                 .. (((bot z3){right} .. (z4 + nw_dist)) intersectionpoint
1375                      ((z1 - sw_dist) -- (z4 - sw_dist)))
1376                 -- cycle;
1377
1378         p_out := bot z1
1379                  .. (z1 + nw_dist)
1380                  -- (z2 + nw_dist)
1381                  .. lft z2
1382                  .. (z2 - sw_dist){direction 0 of p_top}
1383                  & p_top
1384                  & {direction infinity of p_top}(z4 - nw_dist)
1385                  .. rt z4
1386                  .. (z4 + sw_dist)
1387                  -- (z1 + sw_dist)
1388                  .. cycle;
1389
1390         charwx := charwd;
1391         charwy := cone_height [-chardp, charht];
1392         if dir = -1:
1393                 charwy := -charwy;
1394         fi;
1395 enddef;
1396
1397
1398 fet_beginchar ("Whole up tihead", "s0ti");
1399         draw_ti_head (solfa_whole_width, 1);
1400         fill p_out;
1401         unfill p_in;
1402 fet_endchar;
1403
1404
1405 fet_beginchar ("Half up tihead", "u1ti");
1406         draw_ti_head (solfa_half_width, 1);
1407         fill p_out;
1408         unfill p_in;
1409 fet_endchar;
1410
1411
1412 fet_beginchar ("Half down tihead", "d1ti");
1413         draw_ti_head (solfa_half_width, -1);
1414         fill p_out;
1415         unfill p_in;
1416 fet_endchar;
1417
1418
1419 fet_beginchar ("Quart up tihead", "u2ti");
1420         draw_ti_head (solfa_quarter_width, 1);
1421         fill p_out;
1422 fet_endchar;
1423
1424
1425 fet_beginchar ("Quart down tihead", "d2ti");
1426         draw_ti_head (solfa_quarter_width, -1);
1427         fill p_out;
1428 fet_endchar;
1429
1430
1431 fet_endgroup ("noteheads");
1432
1433
1434 %
1435 % we derive black_notehead_width# from the quarter head,
1436 % so we have to define black_notehead_width (pixel qty)
1437 % after the black_notehead_width# itself.
1438 %
1439 % Let's keep it outside the group as well.
1440 %
1441
1442 define_pixels (black_notehead_width);