]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-bolletjes.mf
(overdone_heads): typos.
[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--2004 Jan Nieuwenhuizen <janneke@gnu.org>
7 % & Han-Wen Nienhuys <hanwen@cs.uu.nl>
8 % & Juergen Reuter <reuter@ipd.uka.de>
9
10
11 test_outlines := 0;
12
13
14 % most beautiful noteheads are pronounced, not circular, 
15 % and not even symmetric.
16 % These examples are inspired by [Wanske], see literature list
17
18
19
20 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
21 % NOTE HEAD VARIABLES
22 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
23 save black_notehead_width, noteheight,
24         slash_thick, slash_slope, overdone_heads;
25 numeric black_notehead_width, noteheight, slash_thick;
26
27
28 fet_begingroup("noteheads");
29
30
31
32 % slope of slash. From scm/grob-description.scm. How to auto-copy?
33 slash_slope := 1.7; 
34
35 % thickness of slash lines. quarter notes get 1.5slt width.
36 slash_thick# := 2/3*0.48staff_space#;
37
38
39 %
40 % Hand-engraved music often has balls extending above and below
41 % the lines.  If you like that, modify overdone heads (unit:
42 % stafflinethickness)
43 %
44 overdone_heads = 0.0;
45 noteheight#:=staff_space#+ (1 + overdone_heads) *stafflinethickness#;
46
47 define_pixels(slash_thick, noteheight);
48
49
50 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
51 %
52 % SLANT moves both extremes on the long axis (by SLANT * ELLIPTICITY,
53 % so SLANT = -1, puts the extreme on the long axis next to the short axis one.)
54 %
55
56 def draw_outside_ellipse (expr ellipticity, tilt, superness,
57                           slant) =
58         save attachment_y;
59         save p;
60         path p;
61
62         p := superellipse ((ellipticity, 0), (-slant * ellipticity, 1.0),
63                         (- ellipticity, 0), (slant * ellipticity, -1.0), superness);
64
65         p := p rotated tilt;
66
67         save top_point, right_point;
68         pair top_point, right_point;
69
70         top_point := directionpoint left of p;
71         right_point := directionpoint up of p;
72
73         save scaling, width, height;
74
75         scaling# = noteheight# /(2 ypart (top_point));
76         width# := 2 xpart (right_point) * scaling#;
77
78         define_pixels (width, scaling);
79         
80         set_char_box (0, width#, noteheight#/2, noteheight#/2);
81
82         % attachment Y
83         charwy := ypart (right_point) * scaling#;
84         charwx := width# ;
85
86         p := p scaled scaling shifted (width/2, 0) ;
87         if test_outlines = 1:
88                 pickup pencircle scaled 1 ; draw p;
89         else:
90                 fill p;
91         fi;
92 enddef;
93
94
95 def undraw_inside_ellipse (expr ellipticity, tilt, superness, clearance,
96                         center) =
97 begingroup
98         save p;
99         path p;
100
101         p := superellipse ((ellipticity, 0), (0, 1.0),
102                         (- ellipticity, 0), (0, -1.0), superness);
103
104         p := p rotated tilt;
105
106         save top_point, right_point;
107         pair top_point, right_point;
108
109         top_point := directionpoint left of p;
110         right_point := directionpoint up of p;
111
112         save height, scaling;
113
114         height# = staff_space# + stafflinethickness# - clearance;
115         scaling# = height# /(2 ypart (top_point));
116
117         define_pixels (scaling);
118         p := (p scaled scaling) shifted center;
119
120         if test_outlines = 1:
121                 pickup pencircle scaled 1; draw p;
122         else:
123                 unfill p;
124         fi
125 endgroup;
126 enddef;
127
128
129
130
131
132 %
133 % dimensions aren't entirely right.
134 %
135 fet_beginchar ("Brevis notehead", "s-1", "brevishead");
136         save stemthick, fudge;
137         define_pixels (stemthick);
138         fudge = blot_diameter / 2;
139         stemthick# = 2 stafflinethickness#;
140
141         draw_outside_ellipse (1.80, 0, 0.707, 0);
142         undraw_inside_ellipse (1.30, 125, 0.68, 2 stafflinethickness#,
143                                 (w /2, 0));
144
145         pickup pencircle scaled stemthick;
146
147         bot y1 = -d;
148         top y2 = h;
149         rt x1 - fudge = 0;
150         x1 = x2;
151
152         fudge + lft x3 = w;
153         x4 = x3;
154         y4 = y2;
155         y3 = y1;
156
157         draw_gridline(z1,z2,stemthick);
158         draw_gridline(z3,z4,stemthick);
159
160 fet_endchar;
161
162
163
164 fet_beginchar("Whole notehead", "s0", "wholehead")
165         draw_outside_ellipse (1.80 - puff_up_factor / 3.0, 0, 0.707, 0);
166         undraw_inside_ellipse (1.30, 125 - puff_up_factor *10,
167                         0.68, 2 stafflinethickness#,
168                         (w /2, 0));
169
170 %       draw_staff_outline (-2, 2, 0.5);
171
172 fet_endchar;
173
174
175 fet_beginchar("Half notehead", "s1", "halfhead")
176         draw_outside_ellipse (1.53 - puff_up_factor / 3.0, 34, 0.66, 0.17);
177         undraw_inside_ellipse (3.25, 33, 0.81,
178                 2.5 stafflinethickness#, (w/2, 0));
179
180 fet_endchar;
181         
182 fet_beginchar("Quart notehead", "s2", "quarthead")
183
184         % used to have 32. With 31, they are slightly bolder.
185         draw_outside_ellipse (1.49 - puff_up_factor / 3.0, 31, 0.707, 0);
186         black_notehead_width# := charwd;
187 fet_endchar;
188
189 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
190
191
192 fet_beginchar("Whole diamondhead", "s0diamond", "wholediamondhead")
193         draw_outside_ellipse (1.80, 0, 0.495, 0);
194         undraw_inside_ellipse (1.30, 125, 0.6,
195                         .4 staff_space# +  stafflinethickness#,
196                                 (w /2, 0));
197
198 fet_endchar;
199
200 fet_beginchar("Half diamondhead", "s1diamond", 
201         "halfdiamondhead")
202
203         draw_outside_ellipse (1.50, 34, 0.49, 0.17);
204         undraw_inside_ellipse (3.5, 33, 0.80,
205                 .3 staff_space# + 1.5 stafflinethickness#, (w/2, 0));
206
207 fet_endchar;
208
209 fet_beginchar("Quart diamondhead", "s2diamond", "diamondhead")
210         draw_outside_ellipse (1.80, 35, 0.495, -0.25);
211 fet_endchar;
212
213 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
214
215
216
217
218
219 def define_triangle_shape(expr stemdir) =
220         save triangle,kern; path triangle;
221         save width, depth, height;
222         save left_point, height, width, origin;
223         save left_up_dir, exact_right_point, exact_down_point;
224         pair exact_down_point, exact_left_point, origin, left_up_dir, exact_right_point;
225         save pen_thick;
226
227         pen_thick# = stafflinethickness#  + .1 staff_space#;
228         define_pixels(pen_thick, llap);
229
230         left_up_dir = llap# * dir (90 + tilt);
231
232         xpart (left_up_dir) * xs - (pen_thick# * xs)/2 + xpart origin = 0;
233         ypart origin = 0;
234
235         exact_left_point := origin + (left_up_dir xscaled xs);
236         exact_down_point := origin + (left_up_dir rotated 120 xscaled xs);
237         exact_right_point := origin + (left_up_dir rotated 240 xscaled xs);
238
239         height# = ypart (exact_left_point + origin) + pen_thick#/2;
240         depth# = -ypart (exact_down_point + origin) + pen_thick#/2;
241         width# = xpart (exact_right_point - exact_left_point) + pen_thick# * xs;
242
243         set_char_box(0, width#, depth#, height#);
244         
245         z0 = (hround_pixels (xpart origin), 0);
246         z1 = z0 + llap * dir(90+tilt) xscaled xs;  
247         z2 = z0 + (llap * dir(90+tilt + 120) xscaled xs);
248         z3 = z0 + (llap * dir(90+tilt + 240) xscaled xs);
249
250         z12 = caveness[.5[z1,z2],z3];
251         z23 = caveness[.5[z2,z3],z1];
252         z31 = caveness[.5[z3,z1],z2];
253
254         triangle = z1 .. z12 .. z2 ..
255                     z2 .. z23 .. z3 ..
256                     z3 .. z31 .. z1 ..
257                     cycle;
258         pickup pencircle scaled pen_thick xscaled xs;
259         labels(1,2,12,23,31,3);
260
261
262         % attachment Y
263         if stemdir = 1:
264                 charwy := ypart exact_right_point;
265                 charwx := xpart exact_right_point;
266         else:
267                 charwy := - ypart exact_down_point;
268                 charwx := (width# - xpart exact_down_point);
269         fi
270 enddef;
271
272 fet_beginchar("Whole trianglehead", "0triangle", "wholetrianglehead")
273         save hei,xs;
274         save llap;
275         save tilt;
276
277         tilt = 40;
278         llap# = 3/4noteheight#;
279
280         xs = 1.5;
281         caveness:=0.1;
282         define_triangle_shape(1);
283         draw triangle;
284 fet_endchar;
285
286
287 def draw_closed_triangle_head(expr dir) =
288         save hei,xs;
289         save llap;
290         save tilt;
291
292         tilt = 40;
293         llap# = 2/3noteheight#;
294         xs = 1.2;
295         caveness:=0.1;
296         define_triangle_shape(dir);
297         draw triangle;
298 enddef;
299
300 fet_beginchar("Half trianglehead", "d1triangle", "dhalftrianglehead")
301         draw_closed_triangle_head(-1);
302 fet_endchar;
303
304 fet_beginchar("Half trianglehead", "u1triangle", "uhalftrianglehead")
305         draw_closed_triangle_head(1);
306 fet_endchar;
307
308 def draw_closed_triangle_head(expr dir) = 
309         save hei,xs;
310         save llap;
311         save tilt;
312         tilt = 40;
313         llap# = 2/3noteheight#;
314         xs = 1.0;
315         caveness:=0.1;
316         define_triangle_shape(dir);
317         filldraw triangle;
318 enddef;
319
320 fet_beginchar("Quart trianglehead", "u2triangle", "utrianglehead")
321         draw_closed_triangle_head(1);
322 fet_endchar;
323
324 fet_beginchar("Quart trianglehead", "d2triangle", "dtrianglehead")
325         draw_closed_triangle_head(-1);
326 fet_endchar;
327
328 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
329 %
330 % slash heads are for indicating improvisation. They are  
331 % twice as high as normal heads.
332 %
333 def draw_slash(expr hwid_hash) =
334         save exact_height;
335         save ne_dir;
336         pair ne_dir;
337         exact_height =  staff_space# + stafflinethickness#/2;
338
339         set_char_box (0, 2 exact_height / slash_slope + hwid_hash,
340                         exact_height, exact_height);
341
342         charwx := charwd;
343         charwy := charht;
344
345         clearxy;
346         pickup pencircle scaled blot_diameter;
347
348         bot y1 = - d;
349         top y2 = h;
350         lft x1 = 0;
351         lft x2 = 2 h / slash_slope;
352         
353         rt x3 = w;
354         y3 = y2;
355         y4 = y1;
356         x3- x2 = x4 - x1;
357
358         ne_dir := unitvector( z3  - z4);
359         filldraw z1 --- z2 --- z3 --- z4 --- cycle;
360
361         if hwid_hash > 2 slash_thick#:
362                 save th;
363
364                 th = slash_thick - blot_diameter;
365                 y6 = y7;
366                 y5 = y8;
367                 y3 - y7 = th;
368                 y5 - y1 = th;
369                 z6 - z5 = whatever * ne_dir;
370                 z8 - z7 = whatever * ne_dir;
371
372                 z5  = z1 + whatever * ne_dir + th * (ne_dir rotated -90);
373                 z8  = z4 + whatever * ne_dir + th * (ne_dir rotated 90);
374
375                 unfill
376                         z5 -- z6 -- z7 -- z8 -- cycle;
377         fi
378         labels (range 1 thru 10);
379 enddef;
380
381 fet_beginchar("Whole slashhead","s0slash","wholeslashhead")
382         draw_slash(4 slash_thick# + 0.5 staff_space#);
383 fet_endchar;
384
385 fet_beginchar("Half slashhead","s1slash","halfslashhead")
386         draw_slash(3.0 slash_thick# + 0.15 staff_space#);
387 fet_endchar;
388
389 fet_beginchar("Quart slashhead","s2slash","quartslashhead")
390         draw_slash(1.5 slash_thick#);
391 fet_endchar;
392
393 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
394 % thick is the distance between the NE/SW parallel lines in the cross
395 % (distance between centres of lines)
396 % in stafflinethickness def
397 %
398 def draw_cross(expr thick) =
399         save pent, slant, ne_dir;
400         pair ne_dir;
401         save crz; path crz;
402
403         pen_thick# := 1.2 stafflinethickness#;
404         define_pixels (pen_thick);
405         pickup pencircle scaled pen_thick;
406
407         top y3 = h;
408         ne_dir := unitvector ((1, (2 h -pen_thick)/(w - pen_thick)));
409         rt x4 = w/2;
410         y5 = 0;
411         z4 - z5 = whatever * ne_dir;
412         x6 = 0;
413         z6 - z3 = whatever * ne_dir;
414         z3 - z4 = whatever * (ne_dir yscaled -1);
415
416         z4 - z3 = whatever * (ne_dir) + (ne_dir rotated -90) * thick * stafflinethickness;
417
418         x1 = charwd/2 - .5 pen_thick#;
419         z1 = whatever * ne_dir + thick/2 * stafflinethickness# * (ne_dir rotated -90);
420
421         
422         labels (1,2,3,4,5,6);
423
424         crz = (z6 -- z3 -- z4 -- z5) ;
425
426         draw crz shifted(w/2,0);
427         draw crz xscaled -1 shifted(w/2,0);
428         draw crz yscaled -1 shifted(w/2,0);
429         draw crz scaled -1 shifted(w/2,0);
430
431         charwx := charwd;
432         charwy := y1;
433         z12 = (charwx * hppp, y1 * vppp);
434         labels (12);
435 enddef;
436
437 fet_beginchar("Whole Crossed notehead", "s0cross", "wholecrossedhead")
438         wid# := black_notehead_width#+4stafflinethickness#;
439         hei# := noteheight#+stafflinethickness#;
440         set_char_box(0, wid#,hei#/2,hei#/2);
441         
442         draw_cross (3.75);
443 fet_endchar;
444
445 fet_beginchar("Half Crossed notehead", "s1cross", "halfcrossedhead")
446         wid# := black_notehead_width#+2 stafflinethickness#;
447         hei# := noteheight#+stafflinethickness#/2;
448         set_char_box(0, wid#,hei#/2,hei#/2);
449         draw_cross(3.0);
450 fet_endchar;
451
452 fet_beginchar("Crossed notehead", "s2cross", "crossedhead")
453         wid# := black_notehead_width#;
454         hei# := noteheight#;
455         set_char_box(0, wid#,hei#/2,hei#/2);
456         draw_cross(1.0);
457 fet_endchar;
458
459 fet_beginchar("X-Circled notehead", "s2xcircle", "xcircledhead")
460         wid# := black_notehead_width#*sqrt(sqrt2);
461         hei# := noteheight#*sqrt(sqrt2);
462         set_char_box(0, wid#,hei#/2,hei#/2);
463         cthick := (1.2+1/4)*stafflinethickness;
464         cxr := w/2-cthick/2;
465         cyr := h-cthick/2;
466         pickup pencircle scaled cthick;
467         draw fullcircle xscaled 2cxr yscaled 2cyr shifted (w/2,0);
468         xpos := cxr/sqrt2;
469         ypos := cyr/sqrt2;
470         draw (-xpos+w/2,-ypos) -- (xpos+w/2,ypos);
471         draw (-xpos+w/2,ypos) -- (xpos+w/2,-ypos);
472
473         charwx := charwd ; 
474         charwy := 0 ;
475
476         z12 = (charwx * hppp , charwy * vppp );
477         labels (12);
478 fet_endchar;
479
480
481
482
483 %%%%%%%%
484 %
485 %
486 % SOLFA SHAPED NOTES
487 %
488 %
489
490
491 def generic_draw_solfa_note_shape =
492   save a,beta,black,white;
493   path black, white;
494
495   pickup pencircle scaled stafflinethickness;
496   2 beta# = noteheight#;
497   a# = a_b*beta#;
498   wid# := 2a#+stafflinethickness#;
499   hei# := noteheight#+stafflinethickness#;
500   set_char_box(0, wid#,0.5 hei#, 0.5 hei#);
501
502   define_pixels(a,beta);
503
504   black = noteshape xscaled a yscaled beta shifted (a+stafflinethickness/2,0);
505   filldraw black;
506
507   if (solid=false):
508     white = noteishape xscaled (a*ai_a) yscaled (beta*bi_b)
509                        shifted ((dx+1)*(a+stafflinethickness/2),
510                                 dy*(beta+stafflinethickness/2));
511     unfill white;
512   fi;
513 enddef;  
514
515 def draw_solfa_note_shape =
516   save solid; boolean solid;
517   solid=false;
518   generic_draw_solfa_note_shape;
519 enddef;
520 def draw_solfa_quarter_note_shape =
521   save solid; boolean solid;
522   solid=true;
523   generic_draw_solfa_note_shape;
524 enddef;
525
526 % do - equilateral triangle: (0,-h/2) -- (w/2,h/2) -- (w,-h/2) -- cycle;
527 % stem attachment: -h/2
528
529 save triangle; path triangle;
530 triangle := (-1,-1) -- (0,1) -- (1,-1) -- cycle;
531
532
533
534
535 save solfa_pen_thick;
536 solfa_pen_thick# = 2 stafflinethickness#;
537 define_pixels (solfa_pen_thick);
538
539 def draw_do_head (expr width_factor, dir) =
540         save p ;
541         path p;
542         set_char_box(0, width_factor * noteheight#, 0.5 noteheight#, 0.5 noteheight#);
543         
544         pickup pencircle scaled solfa_pen_thick;
545
546         bot y1 =  -d ;
547         y1 = y2;
548         lft x1 = 0;
549         rt x2 = w;
550         top y3 = h;
551         x3 =.5[x1,x2];
552
553         p := z1 -- z2 -- z3 -- cycle;
554
555         charwx := charwd;
556         charwy := - chardp + 0.5 stafflinethickness#;
557         if dir = -1:
558                 charwy := - charwy;
559         fi;
560 enddef;
561
562 fet_beginchar("Whole dohead", "s0do", "wholedohead")
563         draw_do_head (1.8, 1);
564         draw p;
565 fet_endchar;
566
567
568 fet_beginchar("Half dohead", "d1do", "downhalfdohead")
569         draw_do_head (1.5, -1);
570         draw p;
571 fet_endchar;
572
573 fet_beginchar("Half dohead", "s1do", "halfdohead")
574         draw_do_head (1.5, 1);
575         draw p;
576 fet_endchar;
577
578 fet_beginchar("Quart dohead", "d2do", "downdohead")
579         draw_do_head (1.55, -1);
580         filldraw p;
581 fet_endchar;
582
583
584 fet_beginchar("Quart dohead", "s2do", "dohead")
585         draw_do_head (1.55, 1);
586         filldraw p;
587 fet_endchar;
588
589   
590 % re - flat top, curved bottom:
591 %                (0,h/2) {dir -90} .. (w/2,-h/2) .. {dir 90} (w,h/2) -- cycle;
592 % (broader along the base and with more vertical sides for half and
593 % whole notes)
594 % stem attachment: h/2
595
596
597
598 def draw_re_head (expr width_factor, dir) =
599         save p ;
600         path p;
601         set_char_box(0, width_factor * noteheight#, 0.5 noteheight#, 0.5 noteheight#);
602         
603         pickup pencircle scaled solfa_pen_thick;
604
605         save curve_start;
606         curve_start = 0.7;
607         lft x1 = 0;
608         y1 = y5;
609         x1 = x2;
610         y2 = curve_start [y3,y1];
611         bot y3 = - d;
612         x3 = .5 [x2,x4];
613         rt x4 = w;
614         y4 = y2;
615         top y5 = h;
616         x5 = x4;
617         labels (range 1 thru 5);
618         p := z1 --- z2 .. z3{right} .. z4 --- z5 --- cycle;
619
620         charwx := charwd;
621         charwy := curve_start [-chardp, charht];
622         if dir = -1:
623                 charwy := - charwy;
624         fi;
625 enddef;
626
627 fet_beginchar("Whole rehead", "s0re", "wholerehead")
628         draw_re_head (1.8,1);
629         draw p;
630 fet_endchar;
631
632
633 fet_beginchar("Half up rehead", "u1re", "uphalfrehead")
634         draw_re_head (1.5, 1);
635         draw p;
636 fet_endchar;
637
638 fet_beginchar("Half down rehead", "d1re", "downhalfrehead")
639         draw_re_head (1.5, -1);
640         draw p;
641 fet_endchar;
642
643
644 fet_beginchar("Quart rehead", "u2re", "uprehead")
645         draw_re_head (1.55, 1);
646         filldraw p;
647 fet_endchar;
648
649 fet_beginchar("Quart rehead", "d2re", "downrehead")
650         draw_re_head (1.55, -1);
651         filldraw p;
652 fet_endchar;
653
654
655
656
657 def draw_mi_head (expr width_factor) =
658         save path_out, path_in;
659         path path_out, path_in;
660         set_char_box(0, width_factor * noteheight#, 0.5 noteheight#, 0.5 noteheight#);
661         
662         pickup pencircle scaled solfa_pen_thick;
663
664
665         lft x1 = 0;
666         y1 = 0;
667         bot y2 = -d;
668         x2 = .5 [x1, x3];
669         rt x3 = w;
670         x4 = x2;
671         y3 = y1;
672         top y4 = h;
673
674         z6 - z5 = whatever * (z2 - z1);
675         z8 - z7 = whatever * (z2 - z1);
676         z8 - z5 = whatever * (z4 - z1);
677         z6 - z7 = whatever * (z4 - z1);
678
679         z5 = whatever [z1, z4] + (unitvector (z4 - z1) rotated -90 scaled 0.5 solfa_pen_thick);
680         z5 = whatever [z1, z2] + (unitvector (z2 - z1) rotated 90 scaled 0.75 solfa_pen_thick);
681
682         z5 - z1 = -(z7 - z3);
683         
684         labels (range 1 thru 8);
685         path_out := z1 -- z2 -- z3 -- z4 -- cycle;
686         path_in := z5 -- z6 -- z7 -- z8 -- cycle;
687 %       path_in := z5 -- z1 --cycle;
688 enddef;
689
690 fet_beginchar("Whole mihead", "s0mi", "wholemihead")
691         draw_mi_head (1.8);
692         filldraw path_out;
693         unfill path_in;
694 fet_endchar;
695
696
697 fet_beginchar("Half mihead", "s1mi", "halfmihead")
698         draw_mi_head (1.6);
699         filldraw path_out;
700         unfill path_in;
701 fet_endchar;
702
703
704 fet_beginchar("Quart mihead", "s2mi", "mihead")
705         draw_mi_head (1.65);
706         filldraw path_out;
707 fet_endchar;
708
709
710
711
712 def draw_fa_head (expr width_factor) =
713         set_char_box(0, width_factor * noteheight#, 0.5 noteheight#, 0.5 noteheight#);
714         save p_down, p_up;
715         path p_up, p_down;
716         
717         pickup pencircle scaled solfa_pen_thick;
718
719         lft x1 = 0;
720         top y1 = h;
721
722         rt x2 = w;
723         y2 = y1;
724         bot y3 = -d;
725         x3 = x2;
726
727         y4 = y3;
728         x4 = x1;
729
730         labels(range 1 thru 4);
731
732         p_up := z1 -- z2 -- z3 --cycle;
733         p_down := z1 -- z4 -- z3 --cycle;
734
735         charwy := 0.0;
736         charwx := charwd;
737 enddef;
738
739
740 fet_beginchar("Whole fa up head", "d0fa", "wholefadownhead")
741         draw_fa_head (1.8);
742         draw p_up;
743 fet_endchar;
744
745 fet_beginchar("Whole fa down head", "u0fa", "wholefauphead")
746         draw_fa_head (1.8);
747         draw p_down;
748 fet_endchar;
749
750 fet_beginchar("half fa up head", "d1fa", "halffadownhead")
751         draw_fa_head (1.5);
752         draw p_up;
753 fet_endchar;
754
755 fet_beginchar("Half fa down head", "u1fa", "halffauphead")
756         draw_fa_head (1.5);
757         draw p_down;
758 fet_endchar;
759
760 fet_beginchar("Quarter fa up head", "u2fa", "quarterfadownhead")
761         draw_fa_head (1.55);
762         filldraw p_up;
763 fet_endchar;
764
765 fet_beginchar("Quarter fa down head", "d2fa", "quarterfauphead")
766         draw_fa_head (1.55);
767         filldraw p_down;
768 fet_endchar;
769
770
771 def draw_la_head (expr width_factor) =
772         set_char_box(0, width_factor * noteheight#, 0.5 noteheight#, 0.5 noteheight#);
773         save p;
774         path p;
775         
776         pickup pencircle scaled solfa_pen_thick;
777
778         lft x1 = 0;
779         top y1 = h;
780
781         rt x2 = w;
782         y2 = y1;
783         bot y3 = -d;
784         x3 = x2;
785
786         y4 = y3;
787         x4 = x1;
788
789         labels(range 1 thru 4);
790
791         p := z1 -- z2 -- z3 -- z4 -- cycle;
792 enddef;
793
794 fet_beginchar("Whole lahead", "s0la", "wholelahead")
795         draw_la_head (1.8);
796         draw p;
797 fet_endchar;
798
799
800 fet_beginchar("Half lahead", "s1la", "halflahead")
801         draw_la_head (1.5);
802         draw p;
803 fet_endchar;
804
805
806 fet_beginchar("Quart lahead", "s2la", "lahead")
807         draw_la_head (1.55);
808         filldraw p;
809 fet_endchar;
810
811
812
813 def draw_ti_head (expr width_factor, dir) =
814         set_char_box(0, width_factor * noteheight#, 0.5 noteheight#, 0.5 noteheight#);
815         save p;
816         path p;
817         save cone_height;
818         cone_height = 0.64;
819
820         pickup pencircle scaled solfa_pen_thick;
821
822         x1 = .5 [x2, x4];
823         bot y1 = -d;
824         lft x2 = 0;
825         y2 = cone_height [y1,y3];
826         rt x4 = w;
827         y4 = y2;
828         x3 = x1;
829         top y3 = h;
830         
831         labels(range 1 thru 4);
832
833         p := z1 -- z2  .. z3{right} .. z4 -- cycle;
834         charwx := charwd;
835         charwy := cone_height [-chardp, charht];
836         if dir = - 1:
837                 charwy := - charwy;
838         fi;
839 enddef;
840
841 fet_beginchar("Whole up tihead", "s0ti", "wholetihead")
842         draw_ti_head (1.8, 1);
843         draw p;
844 fet_endchar;
845
846
847 fet_beginchar("Half up tihead", "u1ti", "uphalftihead")
848         draw_ti_head (1.5, 1);
849         draw p;
850 fet_endchar;
851
852 fet_beginchar("Half down tihead", "d1ti", "dnhalftihead")
853         draw_ti_head (1.5, -1);
854         draw p;
855 fet_endchar;
856
857
858
859 fet_beginchar("Quart up tihead", "u2ti", "utihead")
860         draw_ti_head (1.55, 1);
861         filldraw p;
862 fet_endchar;
863
864
865 fet_beginchar("Quart down tihead", "d2ti", "dtihead")
866         draw_ti_head (1.55, -1);
867         filldraw p;
868 fet_endchar;
869
870
871
872 fet_endgroup("noteheads");
873
874
875 %
876 % we derive black_notehead_width# from the quarter head,
877 % so we have to define black_notehead_width (pixel qty)  
878 % after the black_notehead_width# itself. Let's keep it outside the group as well.
879
880 define_pixels(black_notehead_width);
881
882
883
884