]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-toevallig.mf
Add accidentals with arrows in *both* directions
[lilypond.git] / mf / feta-toevallig.mf
1 %
2 % feta-toevallig.mf -- implement Accidentals
3 %
4 % (c) 1997--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
5 %
6
7
8 %
9 % also show in other configuration wrt staff lines.
10 %
11 def draw_shifted_too =
12 if test > 0:
13         fet_beginchar ("shifted too", "");
14                 set_char_box (0, 0, 0, 0);
15                 currentpicture := remember_pic;
16
17                 draw_staff (-2, 2, 0.5);
18         fet_endchar;
19 fi;
20 enddef;
21
22
23 %
24 % Accidentals from various sources, notably
25 %
26 %   Baerenreiter edition of Schuberts `Auf dem Strom' (sharp, natural)
27 %   F Hofmeister edition of Muellers `Etueden fuer Horn' (double sharp, flat)
28 %
29
30
31 %
32 % Naming for accidentals (including microtonal variants):
33 %
34 %   SHARPBASE[.SLASHES.STEMS]
35 %   FLATBASE[.MODIFIER]
36 %  
37 % Examples:
38 %
39 %   sharp.slashslash.stem
40 %   mirroredflat.flat
41 %
42 %
43
44
45 fet_begingroup ("accidentals");
46
47 %
48 % Draw an arrow
49 %
50 % * "stemslant" gives the direction of the stem's left boundary
51 %   (needed for brushed stems, equals "up" for straight stems)
52 % * "extend" is used to make the stem longer or shorter (if negative);
53 %   different kinds of accidentals need different values here
54 %
55 def draw_arrow (expr attach, stemwidth, stemslant, extend, pointingdown) =
56 begingroup;
57         save htip;  % tip height
58         save wwing; % wing "radius"
59         save angle_wing_bot, angle_wing_top, angle_tip;
60         save upshift;
61         clearxy;
62
63         wwing:=0.26 stemwidth;
64         htip:=staff_space*0.85 + stafflinethickness - wwing;
65
66         % "flip" is used to reflect the arrow vertically if arrow points downward
67         transform flip;
68         if pointingdown:
69                 flip=identity reflectedabout (origin, right);
70         else:
71                 flip=identity;
72         fi;
73
74         z1=attach shifted ((-stemwidth/2),0);
75         upshift:=max(0, wwing + 0.1 staff_space + extend);
76         z2=z1 shifted (((unitvector stemslant) scaled upshift) transformed flip);
77
78         z7=attach shifted ((stemwidth/2),0);
79         z6=z7 shifted (((unitvector (-xpart stemslant, ypart stemslant))
80                         scaled upshift) transformed flip);
81         (z2-z3)= (0.38 staff_space, 0.05 htip) transformed flip;
82         (z6-z5)=(-0.38 staff_space, 0.05 htip) transformed flip;
83
84         z4 =attach shifted ((-0.2 stemwidth, upshift+htip) transformed flip);
85         z4'=attach shifted (( 0.2 stemwidth, upshift+htip) transformed flip);
86
87         % angle_wing_bot is the angle at which the arc from z2 to z3a enters z3a
88         % angle_wing_top is the angle at which the arc from z3b to z4 leaves z3b
89         % angle_tip is the angle at which the arc from z4 to z4' leaves z4
90         angle_wing_bot=30;
91         angle_wing_top=55;
92         angle_tip=68;
93
94         z3a=z3 shifted ((((dir angle_wing_bot) rotated (-90))
95                          scaled wwing) transformed flip);
96         z3b=z3 shifted ((((dir angle_wing_top) rotated 90)
97                          scaled wwing) transformed flip);
98
99         z5a=z5 shifted ((((dir (180-angle_wing_bot)) rotated 90)
100                          scaled wwing) transformed flip);
101         z5b=z5 shifted ((((dir (180-angle_wing_top)) rotated (-90))
102                          scaled wwing) transformed flip);
103
104         % Draw the arrow
105         pickup pencircle scaled 1;
106         fill z1
107              -- z2{stemslant transformed flip}
108              .. {(-dir angle_wing_bot) transformed flip}z3a
109              .. z3b{(dir angle_wing_top) transformed flip}
110              .. z4{(dir angle_tip) transformed flip}
111              .. z4'{(dir (-angle_tip)) transformed flip}
112              ..{(dir (-angle_wing_top)) transformed flip}z5b
113              ..z5a{(-dir (-angle_wing_bot)) transformed flip}
114              ..z6{((-stemslant) reflectedabout (origin, up)) transformed flip}
115              -- z7
116              --cycle;
117
118         labels(range 0 thru 7,4',3a,3b,5a,5b);
119 endgroup;
120 enddef;
121
122 save remember_pic;
123 picture remember_pic;
124
125 save sharp_beamheight;
126 sharp_beamheight# := 0.3 staff_space# + stafflinethickness#;
127
128 %
129 % The beams of most sharps have horizontal endings (as if drawn with
130 % a square pen).  [Wanske] does not mention this, so we'll just ignore
131 % this fact.
132 %
133
134 def draw_meta_sharp (expr width, offset) =
135         save beamwidth, beamslope;
136         save ne, nw_dist;
137         pair ne, nw_dist;
138
139         beamwidth := width;
140
141         define_whole_vertical_blacker_pixels (sharp_beamheight);
142
143         clearxy;
144
145         beamslope = sharp_beamheight / beamwidth;
146
147         pickup pencircle scaled 2 blot_diameter;
148
149         rt x2 - lft x1 = beamwidth;
150         z2 = z1 + whatever * (beamwidth, sharp_beamheight);
151         .5 [z1, z3] = (.5 w, offset);
152         x3 = x2;
153         top y2 - bot y3 = sharp_beamheight;
154         x4 = x1;
155         top y1 - bot y4 = sharp_beamheight;
156
157         ne = unitvector (z2 - z1);
158         nw_dist = (ne rotated 90) * blot_diameter;
159
160         fill lft z1{up}
161              ... (z1 + nw_dist){ne}
162              -- (z2 + nw_dist){ne}
163              ... rt z2{down}
164              -- rt z3{down}
165              ... (z3 - nw_dist){-ne}
166              -- (z4 - nw_dist){-ne}
167              ... lft z4{up}
168              -- cycle;
169
170         labels (1, 2, 3, 4);
171 enddef;
172
173
174 def draw_sharp(expr arrowup, arrowdown) =
175         save stem, stemx, stemwidth;
176         save outer_space, interbeam;
177         save stemlength, extendleft, extendright, height, depth;
178
179         stemwidth# := stafflinethickness# + .05 staff_space#;
180         define_whole_blacker_pixels (stemwidth);
181
182         interbeam := 1.05 staff_space_rounded;
183
184         stemlength# := 1.5 staff_space#;
185         define_pixels (stemlength);
186
187         height# = stemlength#;
188         depth#  = stemlength#;
189         extendright# = 0;
190         extendleft# = 0;
191         if arrowup:
192                 height# := height# + 1.2 staff_space#;
193                 extendright# := extendright# + 1.5 stafflinethickness#;
194         fi;
195         if arrowdown:
196                 depth# := depth# + 1.2 staff_space#;
197                 extendleft# := extendleft# + 1.5 stafflinethickness#;
198         fi;
199         define_pixels(extendleft, extendright);
200         set_char_box (extendleft#, 1.1 staff_space#, depth#, height#);
201
202         stem := 7 / 16 * w;
203         stemx := hround stem;
204         outer_space := hround ((w - stemx - stemwidth) / 2);
205
206         w := 2 outer_space + stemx + stemwidth;
207         d := d - feta_space_shift;
208
209         draw_meta_sharp (w, -.5 interbeam);
210         draw_meta_sharp (w, -.5 interbeam + vround interbeam);
211
212         % expand the charbox so that it encloses the whole arrow; this mustn't
213         % happen earlier because some commands above still rely on the old width
214         w := w + extendright;
215
216         pickup pencircle scaled stemwidth;
217
218         lft x5 = lft x6 = outer_space;
219         lft x7 = lft x8 = outer_space + stemx;
220         bot y5 = -stemlength;
221         top y6 = vround (1.5 staff_space - stem * beamslope);
222         bot y7 = -top y6 + feta_space_shift;
223         top y8 = stemlength;
224
225         labels (5, 6, 7, 8);
226
227         draw_gridline (z5, z6, stemwidth);
228         draw_gridline (z7, z8, stemwidth);
229
230         if arrowup:
231                 draw_arrow (z8, stemwidth, up,
232                             +(stafflinethickness/2 + stemwidth/2), false);
233         fi;
234         if arrowdown:
235                 draw_arrow (z5, stemwidth, up,
236                             +(stafflinethickness/2 + stemwidth/2), true);
237         fi;
238
239         remember_pic := currentpicture;
240
241         draw_staff (-2, 2, 0);
242 enddef;
243
244
245 fet_beginchar ("Sharp", "sharp");
246         draw_sharp (false, false);
247 fet_endchar;
248
249
250 draw_shifted_too;
251
252
253 fet_beginchar ("Arrowed Sharp (arrow up)", "sharp.arrowup");
254         draw_sharp (true, false);
255 fet_endchar;
256
257
258 draw_shifted_too;
259
260
261 fet_beginchar ("Arrowed Sharp (arrow down)", "sharp.arrowdown");
262         draw_sharp (false, true);
263 fet_endchar;
264
265
266 draw_shifted_too;
267
268
269 fet_beginchar ("Arrowed Sharp (arrow down)", "sharp.arrowboth");
270         draw_sharp (true, true);
271 fet_endchar;
272
273
274 draw_shifted_too;
275
276
277 fet_beginchar ("1/2 Sharp", "sharp.slashslash.stem");
278         save stem, stemwidth;
279         save outer_space, interbeam;
280
281         stemwidth# := stafflinethickness# + .05 staff_space#;
282         define_whole_blacker_pixels (stemwidth);
283
284         interbeam := 1.05 staff_space_rounded;
285
286         set_char_box (0, 0.7 staff_space#,
287                       1.5 staff_space#, 1.5 staff_space#);
288
289         stem := 7 / 16 * w;
290         outer_space := hround ((w - stemwidth) / 2);
291
292         w := 2 outer_space + stemwidth;
293         d := d - feta_space_shift;
294
295         draw_meta_sharp (w, -.5 interbeam);
296         draw_meta_sharp (w, -.5 interbeam + vround interbeam);
297
298         pickup pencircle scaled stemwidth;
299
300         lft x5 = lft x6 = outer_space;
301         top y6 = vround (1.5 staff_space - .5 stem);
302         bot y5 = -top y6 + feta_space_shift;
303
304         labels (5, 6);
305
306         draw_gridline (z5, z6, stemwidth);
307
308         remember_pic := currentpicture;
309
310         draw_staff (-2, 2, 0);
311 fet_endchar;
312
313
314 draw_shifted_too;
315
316
317 fet_beginchar ("Sharp (3 beams)", "sharp.slashslashslash.stemstem");
318         save stem, stemx, stemwidth;
319         save outer_space, interbeam;
320         save sharp_beamheight;
321
322         sharp_beamheight# := 0.22 staff_space# + stafflinethickness#;
323
324         stemwidth# := stafflinethickness# + .05 staff_space#;
325         define_whole_blacker_pixels (stemwidth);
326
327         interbeam := 1.2 staff_space_rounded;
328
329         set_char_box (0, 1.1 staff_space#,
330                       1.5 staff_space#, 1.5 staff_space#);
331
332         stem := 7 / 16 * w;
333         stemx := hround stem;
334         outer_space := hround ((w - stemx - stemwidth) / 2);
335
336         w := 2 outer_space + stemx + stemwidth;
337         d := d - feta_space_shift;
338
339         draw_meta_sharp (.88 w, -.5 interbeam);
340         draw_meta_sharp (.88 w, -.5 interbeam + vround interbeam);
341         sharp_beamheight# := 1/.88 sharp_beamheight#;
342         draw_meta_sharp (w, 0);
343
344         pickup pencircle scaled stemwidth;
345
346         lft x5 = lft x6 = outer_space;
347         lft x7 = lft x8 = outer_space + stemx;
348         bot y5 = -d;
349         top y6 = vround (1.5 staff_space - stem * beamslope);
350         bot y7 = -top y6 + feta_space_shift;
351         top y8 = h;
352
353         labels (5, 6, 7, 8);    
354
355         draw_gridline (z5, z6, stemwidth);
356         draw_gridline (z7, z8, stemwidth);
357
358         remember_pic := currentpicture;
359
360         draw_staff (-2, 2, 0);
361 fet_endchar;
362
363
364 draw_shifted_too;
365
366
367 fet_beginchar ("1/2 Sharp (3 beams)", "sharp.slashslashslash.stem");
368         save stem, stemx, stemwidth;
369         save outer_space, interbeam;
370         save sharp_beamheight;
371
372         sharp_beamheight# := 0.22 staff_space# + stafflinethickness#;
373
374         stemwidth# := stafflinethickness# + .05 staff_space#;
375         define_whole_blacker_pixels (stemwidth);
376
377         interbeam := 1.2 staff_space_rounded;
378
379         set_char_box (0, 0.95 staff_space#,
380                       1.3 staff_space#, 1.3 staff_space#);
381
382         stem := 7 / 16 * w;
383         outer_space := hround ((w - stemwidth) / 2);
384
385         w := 2 outer_space + stemwidth;
386         d := d - feta_space_shift;
387
388         draw_meta_sharp (.8 w, -.5 interbeam);
389         draw_meta_sharp (.8 w, -.5 interbeam + vround interbeam);
390         sharp_beamheight# := 1/.8 sharp_beamheight#;
391         draw_meta_sharp (w, 0);
392
393         pickup pencircle scaled stemwidth;
394
395         lft x5 = lft x6 = outer_space;
396         top y6 = vround (1.5 staff_space - .5 stem);
397         bot y5 = -top y6 + feta_space_shift;
398         labels (5, 6);
399
400         draw_gridline (z5, z6, stemwidth);
401
402         remember_pic := currentpicture;
403
404         draw_staff (-2, 2, 0);
405 fet_endchar;
406
407
408 draw_shifted_too;
409
410
411 fet_beginchar ("3/4 Sharp", "sharp.slashslash.stemstemstem");
412         save stem, stemx, stemwidth;
413         save outer_space, interbeam;
414
415         stemwidth# := stafflinethickness# + .05 staff_space#;
416         define_whole_blacker_pixels (stemwidth);
417
418         interbeam := 1.05 staff_space_rounded;
419
420         set_char_box (0, 1.6 staff_space#,
421                       1.5 staff_space#, 1.5 staff_space#);
422
423         stem := 9 / 32 * w;
424         stemx := hround stem;
425         outer_space := hround ((w - 2 stemx - stemwidth) / 2);
426
427         w := 2 outer_space + 2 stemx + stemwidth;
428         d := d - feta_space_shift;
429
430         draw_meta_sharp (w, -.5 interbeam);
431         draw_meta_sharp (w, -.5 interbeam + vround interbeam);
432
433         pickup pencircle scaled stemwidth;
434
435         lft x5 = lft x6 = outer_space;
436         lft x7 = lft x8 = outer_space + stemx;
437         lft x9 = lft x10 = outer_space + 2 stemx;
438         bot y5 = -d;
439         top y6 = vround (1.5 staff_space - 2 stem * beamslope);
440         bot y9 = -top y6 + feta_space_shift;
441         top y10 = h;
442         y7 = .5 [y5, y9];
443         y8 = .5 [y6, y10];
444
445         labels (5, 6, 7, 8, 9, 10);
446
447         draw_gridline (z5, z6, stemwidth);
448         draw_gridline (z7, z8, stemwidth);
449         draw_gridline (z9, z10, stemwidth);
450
451         remember_pic := currentpicture;
452
453         draw_staff (-2, 2, 0);
454 fet_endchar;
455
456
457 draw_shifted_too;
458
459
460 %
461 % The stems of the natural are brushed (at least, in Barenreiter SCS)
462 %
463
464 def draw_natural (expr arrowup, arrowdown) =
465         save stemwidth, top_stem_thick;
466         save ne, pat_top, pat_bottom;
467         save depth, height, extendleft, extendright, stemlength;
468         save brush_scale_up, brush_scale_down;
469         pair ne;
470         path pat_top, pat_bottom;
471
472         top_stem_thick# = stafflinethickness# + .10 staff_space#;
473         stemwidth# = 0.09 staff_space# + .5 stafflinethickness#;
474         define_whole_blacker_pixels (top_stem_thick, stemwidth);
475
476         stemlength# = 1.5 staff_space#;
477         define_pixels (stemlength);
478
479         height# = stemlength#;
480         depth# = stemlength#;
481         extendleft# = 0;
482         extendright# = 0;
483         if arrowup:
484                 extendleft# := 3 stafflinethickness#;
485                 height# := height# + 1.2 staff_space#;
486         fi;
487         if arrowdown:
488                 extendright# := 3.15 stafflinethickness#;
489                 depth# := depth# + 1.2 staff_space#;
490         fi;
491         define_pixels (extendright);
492
493         set_char_box (extendleft#, 2/3 staff_space#, depth#, height#);
494
495         d := d - feta_space_shift;
496
497         pickup pencircle scaled stemwidth;
498
499         brush_scale_up   := 1.0;
500         brush_scale_down := 1.0;
501         % to look nice, arrowed stems must be less brushed
502         if arrowup:
503                 brush_scale_up := 0.85;
504         fi;
505         if arrowdown:
506                 brush_scale_down := 0.85;
507         fi;
508
509         penpos1 (top_stem_thick, 0);
510         penpos3 (top_stem_thick, 0);
511         penpos2 (stemwidth, 0);
512         penpos4 (stemwidth, 0);
513         % z1' and z3' are needed for the arrowed accidentals
514         penpos1' (top_stem_thick * brush_scale_up, 0);
515         penpos3' (top_stem_thick * brush_scale_down, 0);
516
517         x2r = w;
518         x4l = 0;
519         x3 = x3' = x2;
520         x1 = x1' = x4;
521
522         y1 = y1' = stemlength;
523         y3 = y3' = -stemlength;
524         top y2 = vround (staff_space - 3/2 stafflinethickness);
525         y4 = -y2 + feta_space_shift;
526
527         pat_bottom := z4r{z4r - z1r}
528                       .. bot z4
529                       .. z4l{z1l - z4l};
530         fill simple_serif (z1'l, z1'r, -30)
531              -- pat_bottom
532              -- cycle;
533
534         pat_top := z2r{z2r - z3r}
535                    .. top z2
536                    .. z2l{z3l - z2l};
537         fill simple_serif (z3'l, z3'r, 30)
538              -- pat_top
539              -- cycle;
540
541         ne = (x2 - x4, stafflinethickness);
542
543         z11' = z3l + whatever * (z2l - z3l);
544         y11' = vround (.5 (staff_space - stafflinethickness));
545         z11 = z11' + whatever * ne;
546         x11 = x12;
547         z12 = directionpoint -ne of pat_top;
548         z13 = z12 + whatever * ne;
549         x13 = x1;
550         z14 = z11 + whatever * ne;
551         x14 = x1;
552
553         z21' = z4r + whatever * (z1r - z4r);
554         y21' = -y11' + feta_space_shift;
555         z21 = z21' + whatever * ne;
556         x21 = x22;
557         z22 = directionpoint -ne of pat_bottom;
558         z23 = z22 + whatever * ne;
559         x23 = x3;
560         z24 = z21 + whatever * ne;
561         x24 = x3;
562
563         fill z11
564              -- z12
565              -- z13
566              -- z14
567              -- cycle;
568         fill z21
569              -- z22
570              -- z23
571              -- z24
572              -- cycle;
573
574         penlabels (1, 1', 2, 3, 3', 4);
575         labels (11, 11', 12, 13, 14, 21, 21', 22, 23, 24);
576
577         if arrowup:
578                 draw_arrow (z1, top_stem_thick * brush_scale_up,
579                             z1'l-z4l, stafflinethickness/2, false);
580         fi;
581         if arrowdown:
582                 draw_arrow (z3, top_stem_thick * brush_scale_down,
583                             z2r-z3'r, stafflinethickness/2, true);
584                 w := w + extendright;
585         fi;
586
587         remember_pic := currentpicture;
588
589         draw_staff (-2, 2, 0);
590 enddef;
591
592 fet_beginchar ("Natural", "natural");
593         draw_natural (false, false);
594 fet_endchar;
595
596
597 draw_shifted_too;
598
599
600 fet_beginchar ("Natural", "natural.arrowup");
601         draw_natural (true, false);
602 fet_endchar;
603
604
605 draw_shifted_too;
606
607
608 fet_beginchar ("Natural", "natural.arrowdown");
609         draw_natural (false, true);
610 fet_endchar;
611
612
613 draw_shifted_too;
614
615
616 fet_beginchar ("Natural", "natural.arrowboth");
617         draw_natural (true, true);
618 fet_endchar;
619
620
621 draw_shifted_too;
622
623
624 %
625 % Dedicated to my mom.    (3/10/97)
626 %
627 % Mamma, ik hou van je; kom je alsjeblieft terug?
628 %    -- HW
629 %
630 %
631 % TODO: remove crook_fatness
632 % TODO: document, simplify!
633 %
634
635 def draw_meta_flat (expr xcenter, w, crook_fatness, arrowup, arrowdown) =
636         save crook_thinness;
637         save bottom_overshoot, bot_crook_dir;
638         save top_stem_thick, top_stem_thick_orig, bottom_stem_thick, hair, smaller_hole;
639         save top_crook_thinness;
640         save zwiep;
641         save center;
642         pair center, bot_crook_dir;
643         save clearing, clearing_orig;
644
645         clearxy;
646
647         % the stem shouldn't reach the top staff line.
648         %% TODO: should take from height.
649         %
650         % TODO: parameterize this
651         %
652         if w >= 0.75 staff_space:
653                 smaller_hole = 0.35 stafflinethickness;
654         else:
655                 smaller_hole = 0;
656         fi;
657         crook_thinness = .7 stafflinethickness + .06 staff_space;
658         top_crook_thinness = 1 stafflinethickness + .065 staff_space;
659         clearing = 1.7 stafflinethickness;
660         clearing_orig = clearing;
661         if arrowup:
662                 clearing := 0.5 staff_space;
663         fi;
664         bottom_overshoot = stafflinethickness;
665
666         bottom_stem_thick# = 0.06 staff_space# + 0.6 stafflinethickness#;
667         top_stem_thick# = 0.1 staff_space# + 1.2 stafflinethickness#;
668         top_stem_thick_orig# = top_stem_thick#;
669         if arrowup:
670                 % to look nice, arrowed stems should be less brushed
671                 top_stem_thick# := top_stem_thick#*0.80;
672         fi;
673         define_whole_blacker_pixels (bottom_stem_thick, top_stem_thick,
674                                      top_stem_thick_orig);
675
676         if odd (top_stem_thick - bottom_stem_thick):
677                 top_stem_thick := top_stem_thick - 1;
678         fi;
679         if odd (top_stem_thick_orig - bottom_stem_thick):
680                 top_stem_thick_orig := top_stem_thick_orig - 1;
681         fi;
682
683         center = (xcenter, 0);
684
685         x1l = hround (xcenter - .5 top_stem_thick);
686         y1 = vround (2 staff_space - clearing);
687         x2l = hround (xcenter - .5 bottom_stem_thick);
688         y2 = -.5 staff_space - .5 stafflinethickness;
689         % z16 and the _orig variables are needed for arrowed accidentals because
690         % their inner part should be unchanged from plain ones but the points z3l,
691         % z3r and z10 depend on values that are different for arrowed accidentals
692         x16l = hround (xcenter - .5 top_stem_thick_orig);
693         y16 = vround (2 staff_space - clearing_orig);
694
695         penpos1 (top_stem_thick, 0);
696         penpos16 (top_stem_thick_orig, 0);
697         penpos2 (bottom_stem_thick, 0);
698
699         y3l = vfloor ((staff_space - stafflinethickness) / 2);
700         z3l = whatever [z2r, z1r];
701         z3r = .3 [z2r, (z16r shifted (0, clearing_orig - 1.7 stafflinethickness))]
702               + (smaller_hole, 0);
703         x3r := hceiling x3r;
704
705         % we insert z3l to get better conversion with mf2pt1
706         fill simple_serif (z1r, z1l, 30)
707              -- z2l
708              -- z2r
709              -- z3l
710              -- cycle;
711
712         z10 = whatever [z2r, z16r] + (smaller_hole, 0);
713         y10 = -1/10 staff_space;
714         x10 := hceiling x10;
715
716         x11 = xcenter + bottom_overshoot / 3;
717         y11 = -vround (.5 (staff_space + stafflinethickness)
718                        + bottom_overshoot);
719
720         x2a = 0.2[x2r,x7];
721         y2a = 1.5[y2,y11];
722
723         penpos4 (whatever, 53);
724
725         y4l - y4r = top_crook_thinness;
726         y5r = .15 staff_space;
727         x5l = hround (w + xcenter);
728         y4 = staff_space / 2;
729         x4r = .45 [x5r, x3r];
730         y4l := vround y4l;
731
732         penpos5 (crook_fatness, -175);
733
734         bot_crook_dir = unitvector ((x5l, 0) - z11);
735         z8 = z11 + whatever * bot_crook_dir;
736         y8 = -staff_space / 2;
737
738         z7 = z8
739              + whatever * bot_crook_dir
740              + crook_thinness * (bot_crook_dir rotated 90);
741         x7 = .1 [x3r, x8];
742
743         unfill z3r{z3r - z10}
744                .. z4r{right}
745                .. z5r{down}
746                .. z7{-bot_crook_dir}
747                & z7
748                .. z10{z3r - z10}
749                -- cycle;
750
751         if arrowdown:
752                 fill z2l{down}
753                      .. z2a{up}
754                      .. z8{bot_crook_dir}
755                      .. z5l{up}
756                      .. z4l{left}
757                      .. z3l
758                      -- cycle;
759         else:
760                 fill z2l{down}
761                      .. z11{right}
762                      .. z8{bot_crook_dir}
763                      .. z5l{up}
764                      .. z4l{left}
765                      .. z3l
766                      -- cycle;
767         fi;
768
769         if arrowup:
770                 draw_arrow (z1, top_stem_thick, z1l-z2l,
771                             0.5stafflinethickness, false);
772         fi;
773         if arrowdown:
774                 draw_arrow ((0.5[x2l,x2a],y2), x2a-x2l, up,
775                             staff_space/2, true);
776         fi;
777 enddef;
778
779
780 def draw_arrowed_meta_flat (expr xcenter, width, crook_fatness, arrowup, arrowdown) =
781         save depth, height, extendleft;
782
783         depth# = 0.6 staff_space#;
784         height# = 1.9 staff_space#;
785         extendleft# := 1.2 stafflinethickness#;
786         if arrowup:
787                 extendleft# := 3.45 stafflinethickness#;
788                 height# := height# + 0.8 staff_space#;
789         fi;
790         if arrowdown:
791                 extendleft# := 3.45 stafflinethickness#;
792                 depth# := depth# + 1.6 staff_space#;
793         fi;
794
795         set_char_box (extendleft#, width, depth#, height#);
796         draw_meta_flat(xcenter, w, crook_fatness, arrowup, arrowdown);
797 enddef;
798
799 %
800 % unfortunately, 600dpi is not enough to show the brush of the stem.
801 %
802
803 fet_beginchar ("Flat", "flat");
804         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, false, false);
805         penlabels (range 0 thru 11);
806
807         remember_pic := currentpicture;
808
809         draw_staff (-2, 2, 0);
810 fet_endchar;
811
812
813 draw_shifted_too;
814
815
816 fet_beginchar ("Arrowed Flat (up-arrow)", "flat.arrowup");
817         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, true, false);
818         penlabels (range 0 thru 23);
819
820         remember_pic := currentpicture;
821
822         draw_staff (-2, 2, 0.0);
823 fet_endchar;
824
825
826 draw_shifted_too;
827
828
829 fet_beginchar ("Arrowed Flat (down-arrow)", "flat.arrowdown");
830         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, false, true);
831         penlabels (range 0 thru 23);
832
833         remember_pic := currentpicture;
834
835         draw_staff (-2, 2, 0.0);
836 fet_endchar;
837
838
839 draw_shifted_too;
840
841
842 fet_beginchar ("Arrowed Flat (down-arrow)", "flat.arrowboth");
843         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, true, true);
844         penlabels (range 0 thru 23);
845
846         remember_pic := currentpicture;
847
848         draw_staff (-2, 2, 0.0);
849 fet_endchar;
850
851
852 draw_shifted_too;
853
854
855 fet_beginchar ("Flat (slashed)", "flat.slash");
856         set_char_box (.4 staff_space#, .8 staff_space#,
857                       0.6 staff_space#, 1.9 staff_space#);
858
859         draw_meta_flat (0, w, 0.31 staff_space, false, false);
860
861         clearxy;
862
863         save slope, slash_width;
864         slope = 0.5;
865         slash_width = w;
866
867         z11 = (0, h / 2);
868         z12 = z11 - (slash_width, slash_width * slope) / 2;
869         z13 = z11 + (slash_width, slash_width * slope) / 2;
870         penpos12 (1.5 stafflinethickness, angle (z13 - z12) - 90);
871         penpos13 (1.5 stafflinethickness, angle (z13 - z12) - 90);
872
873         z14 = z12 - .75 stafflinethickness * unitvector (z13 - z12);
874         z15 = z13 + .75 stafflinethickness * unitvector (z13 - z12);
875
876         fill z13r
877              .. z15
878              .. z13l
879              -- z12l
880              .. z14
881              .. z12r
882              -- z13r
883              .. cycle;
884
885         penlabels (12, 13);
886         labels (14, 15);
887
888         remember_pic := currentpicture;
889
890         draw_staff (-2, 2, 0);
891 fet_endchar;
892
893
894 fet_beginchar ("Flat (slashed twice)", "flat.slashslash");
895         set_char_box (.4 staff_space#, .8 staff_space#,
896                       0.6 staff_space#, 1.9 staff_space#);
897
898         draw_meta_flat (0, w, 0.31 staff_space, false, false);
899
900         clearxy;
901
902         save slope, slash_width;
903         slope = 0.5;
904         slash_width = w;
905
906         z11 = (0, 5/12 h);
907         z12 = z11 - (slash_width, slash_width * slope) / 2;
908         z13 = z11 + (slash_width, slash_width * slope) / 2;
909         penpos12 (1.5 stafflinethickness, angle (z13 - z12) - 90);
910         penpos13 (1.5 stafflinethickness, angle (z13 - z12) - 90);
911
912         z14 = z12 - .75 stafflinethickness * unitvector (z13 - z12);
913         z15 = z13 + .75 stafflinethickness * unitvector (z13 - z12);
914
915         fill z13r
916              .. z15
917              .. z13l
918              -- z12l
919              .. z14
920              .. z12r
921              -- z13r
922              .. cycle;
923
924         penlabels (12, 13);
925         labels (14, 15);
926
927         z21 = (0, 2/3 h);
928         z22 = z21 - (slash_width, slash_width * slope) / 2;
929         z23 = z21 + (slash_width, slash_width * slope) / 2;
930         penpos22 (1.5 stafflinethickness, angle (z23 - z22) - 90);
931         penpos23 (1.5 stafflinethickness, angle (z23 - z22) - 90);
932
933         z24 = z22 - .75 stafflinethickness * unitvector (z23 - z22);
934         z25 = z23 + .75 stafflinethickness * unitvector (z23 - z22);
935
936         fill z23r
937              .. z25
938              .. z23l
939              -- z22l
940              .. z24
941              .. z22r
942              -- z23r
943              .. cycle;
944
945         penlabels (22, 23);
946         labels (24, 25);
947
948         remember_pic := currentpicture;
949
950         draw_staff (-2, 2, 0);
951 fet_endchar;
952
953
954 fet_beginchar ("Flatflat (mirrored)", "mirroredflat.flat");
955         set_char_box (0, 1.6 staff_space#, 
956                       0.6 staff_space#, 1.9 staff_space#);
957
958         % This is a modified version of `draw_meta_flat'.
959
960         save crook_thinness, crook_fatness;
961         save bottom_overshoot, bot_crook_dir;
962         save top_stem_thick, bottom_stem_thick, hair, smaller_hole;
963         save top_crook_thinness;
964         save zwiep;
965         save center;
966         pair center, bot_crook_dir;
967         save clearing, wid;
968         save pat;
969         path pat;
970
971         clearxy;
972
973         wid = w / 2;
974
975         % the stem shouldn't reach the top staff line.
976         %% TODO: should take from height.
977         %
978         % TODO: parameterize this
979         %
980         if wid >= 0.75 staff_space:
981                 smaller_hole = 0.35 stafflinethickness;
982         else:
983                 smaller_hole = 0;
984         fi;
985         clearing = 1.7 stafflinethickness;
986         crook_thinness = .7 stafflinethickness + .06 staff_space;
987         crook_fatness = 0.31 staff_space;
988         top_crook_thinness = 1 stafflinethickness + .065 staff_space;
989         bottom_overshoot = stafflinethickness;
990
991         bottom_stem_thick# = 0.06 staff_space# + 0.6 stafflinethickness#;
992         top_stem_thick# = 0.1 staff_space# + 1.2 stafflinethickness#;
993         define_whole_blacker_pixels (bottom_stem_thick, top_stem_thick);
994
995         if odd (top_stem_thick - bottom_stem_thick):
996                 top_stem_thick := top_stem_thick - 1;
997         fi;
998
999         center = (0, 0);
1000
1001         x1l = hround (-.5 top_stem_thick);
1002         y1 = vround (2 staff_space - clearing);
1003         x2l = hround (-.5 bottom_stem_thick);
1004         y2 = -.5 staff_space - .5 stafflinethickness;
1005
1006         penpos1 (top_stem_thick, 0);
1007         penpos2 (bottom_stem_thick, 0);
1008
1009         y3l = vfloor ((staff_space - stafflinethickness) / 2);
1010         z3l = whatever [z2r, z1r];
1011         z3r = .3 [z2r, z1r] + (smaller_hole, 0);
1012         x3r := hceiling x3r;
1013
1014         z10 = whatever [z2r, z1r] + (smaller_hole, 0);
1015         y10 = -1/10 staff_space;
1016         x10 := hceiling x10;
1017
1018         x11 = bottom_overshoot / 3;
1019         y11 = -vround (.5 (staff_space + stafflinethickness)
1020                        + bottom_overshoot);
1021
1022         penpos4 (whatever, 53);
1023
1024         y4l - y4r = top_crook_thinness;
1025         y5r = .15 staff_space;
1026         x5l = hround (wid);
1027         y4 = staff_space / 2;
1028         x4r = .45 [x5r, x3r];
1029         y4l := vround y4l;
1030
1031         penpos5 (crook_fatness, -175);
1032
1033         bot_crook_dir = unitvector ((x5l, 0) - z11);
1034         z8 = z11 + whatever * bot_crook_dir;
1035         y8 = -staff_space / 2;
1036
1037         z7 = z8
1038              + whatever * bot_crook_dir
1039              + crook_thinness * (bot_crook_dir rotated 90);
1040         x7 = .1 [x3r, x8];
1041
1042         pat := z3r{z3r - z10}
1043                .. z4r{right}
1044                .. z5r{down}
1045                .. z7{-bot_crook_dir}
1046                & z7
1047                .. z10{z3r - z10}
1048                -- cycle;
1049         unfill pat;
1050         unfill pat xscaled -1;
1051
1052         pat := z11{right}
1053                .. z8{bot_crook_dir}
1054                .. z5l{up}
1055                .. z4l{left}
1056                .. z3l;
1057         fill pat
1058              -- simple_serif (z1r, z1l, 30)
1059              -- reverse pat xscaled -1 shifted (-feta_eps, 0)
1060              -- cycle;
1061
1062         currentpicture := currentpicture shifted (w/2, 0);
1063
1064         remember_pic := currentpicture;
1065
1066         draw_staff (-2, 2, 0);
1067 fet_endchar;
1068
1069
1070 draw_shifted_too;
1071
1072
1073 fet_beginchar ("Semi flat", "mirroredflat");
1074         set_char_box (1.2 stafflinethickness#, .8 staff_space#,
1075                       0.6 staff_space#, 1.9 staff_space#);
1076
1077         draw_meta_flat (0, w, 0.31 staff_space, false, false);
1078         currentpicture := currentpicture xscaled -1 shifted (w - b, 0);
1079 fet_endchar;
1080
1081
1082 fet_beginchar ("Semi flat", "mirroredflat.backslash");
1083         set_char_box (.4 staff_space#, .8 staff_space#,
1084                       0.6 staff_space#, 1.9 staff_space#);
1085
1086         draw_meta_flat (0, w, 0.31 staff_space, false, false);
1087
1088         clearxy;
1089
1090         save slope, slash_width;
1091         slope = 0.5;
1092         slash_width = w;
1093
1094         z11 = (0, h / 2);
1095         z12 = z11 - (slash_width, slash_width * slope) / 2;
1096         z13 = z11 + (slash_width, slash_width * slope) / 2;
1097         penpos12 (1.5 stafflinethickness, angle (z13 - z12) - 90);
1098         penpos13 (1.5 stafflinethickness, angle (z13 - z12) - 90);
1099
1100         z14 = z12 - .75 stafflinethickness * unitvector (z13 - z12);
1101         z15 = z13 + .75 stafflinethickness * unitvector (z13 - z12);
1102
1103         fill z13r
1104              .. z15
1105              .. z13l
1106              -- z12l
1107              .. z14
1108              .. z12r
1109              -- z13r
1110              .. cycle;
1111
1112         currentpicture := currentpicture xscaled -1 shifted (w - b, 0);
1113
1114         labels (1, 2, 3);
1115 fet_endchar;
1116
1117
1118 fet_beginchar ("Double Flat", "flatflat");
1119         save left_wid, overlap, right_wid;
1120
1121         left_wid = .7;
1122         right_wid = .8;
1123         overlap = .05;
1124
1125         set_char_box (1.2 stafflinethickness#,
1126                       (left_wid + right_wid - overlap) * staff_space#,
1127                       .6 staff_space#, 1.9 staff_space#);
1128         draw_meta_flat (0, left_wid * staff_space, 1/3 staff_space, false, false);
1129         draw_meta_flat (hround ((left_wid - overlap) * staff_space),
1130                         right_wid * staff_space, 1/3 staff_space, false, false);
1131 fet_endchar;
1132
1133
1134 fet_beginchar ("3/4 Flat", "flatflat.slash");
1135         save left_wid, overlap, right_wid;
1136
1137         left_wid = .7;
1138         right_wid = .8;
1139         overlap = .05;
1140
1141         set_char_box (1.2 stafflinethickness#,
1142                       (left_wid + right_wid - overlap) * staff_space#,
1143                       .6 staff_space#, 1.9 staff_space#);
1144         draw_meta_flat (0, left_wid * staff_space, 1/3 staff_space, false, false);
1145         draw_meta_flat (hround ((left_wid - overlap) * staff_space),
1146                         right_wid * staff_space, 1/3 staff_space, false, false);
1147
1148         %% maybe we should clip part of the stems?
1149         %% or make the 1st flat smaller?
1150         %% or reverse it?
1151         pickup pencircle scaled 2 stafflinethickness;
1152
1153         z12 = round (-.25 w - b, .55 staff_space) + feta_offset;
1154         z13 = round (.75 w, 1.45 staff_space) + feta_offset;
1155         penpos12 (2 stafflinethickness, angle (z13 - z12) - 90);
1156         penpos13 (2 stafflinethickness, angle (z13 - z12) - 90);
1157
1158         z14 = z12 - stafflinethickness * unitvector (z13 - z12);
1159         z15 = z13 + stafflinethickness * unitvector (z13 - z12);
1160
1161         fill z13r
1162              .. z15
1163              .. z13l
1164              -- z12l
1165              .. z14
1166              .. z12r
1167              -- z13r
1168              .. cycle;
1169
1170         penlabels (12, 13);
1171         labels (14, 15);
1172
1173         remember_pic := currentpicture;
1174
1175         draw_staff (-2, 2, 0);
1176 fet_endchar;
1177
1178
1179 draw_shifted_too;
1180
1181
1182 fet_beginchar ("Double Sharp", "doublesharp");
1183         save klaverblad, klaversteel;
1184         save pat;
1185         path pat;
1186
1187         klaversteel = 1/15 staff_space;
1188         klaverblad = .4 staff_space - .5 stafflinethickness;
1189
1190         set_char_box (0, staff_space#, .5 staff_space#, .5 staff_space#);
1191
1192         z1 = (klaversteel, 0);
1193         z2 = (w / 2 - klaverblad / 10, h - klaverblad);
1194         z3 = (w / 2, h);
1195         z4 = z2 reflectedabout ((0, 0), (1, 1));
1196         z5 = z1 reflectedabout ((0, 0), (1, 1));
1197
1198         labels (1, 2, 3, 4, 5);
1199
1200         pickup pencircle scaled blot_diameter;
1201
1202         x2 := hfloor (rt x2) - blot_diameter / 2;
1203         x3 := hfloor (rt x3) - blot_diameter / 2;
1204         y3 := vfloor (top y3) - blot_diameter / 2;
1205         y4 := vfloor (top y4) - blot_diameter / 2;
1206
1207         pat = (rt z1){dir45}
1208               .. {right}(bot z2)
1209               .. rt z2
1210               -- rt z3{z3 - z2}
1211               .. top z3{z4 - z3}
1212               -- top z4{z4 - z3}
1213               .. (lft z4){down}
1214               .. {dir 225}(top z5);
1215         pat := pat
1216                -- reverse pat xscaled -1 shifted (-feta_eps, 0);
1217
1218         % assure symmetry -- it's more important to center the glyph on the
1219         % staff line than centering it between staff lines, so we use
1220         % feta_shift, not feta_space_shift.
1221         h := h + feta_shift;
1222
1223         fill pat shifted (0, feta_shift)
1224              -- reverse pat yscaled -1 shifted (0, -feta_eps)
1225              -- cycle;
1226
1227         % ugh
1228         currentpicture := currentpicture shifted (hround (w / 2), 0);
1229
1230         remember_pic := currentpicture;
1231
1232         draw_staff (-2, 2, 0);
1233 fet_endchar;
1234
1235
1236 draw_shifted_too;
1237
1238
1239 def draw_paren =
1240         save leftindent;
1241
1242         leftindent := .2 staff_space;
1243
1244         set_char_box (0, .5 staff_space# + stafflinethickness#,
1245                       staff_space#, staff_space#);
1246
1247         d := d - feta_shift;
1248
1249         z1 = (leftindent, h);
1250         z2 = (w - stafflinethickness, .5 (h - d));
1251         z3 = (leftindent, -d);
1252
1253         penpos1 (stafflinethickness, 35);
1254         penpos2 (.1 staff_space + stafflinethickness, 0);
1255         penpos3 (stafflinethickness, -35);
1256
1257         fill z2l{down}
1258              .. simple_serif (z3l, z3r, 90)
1259              .. z2r{up}
1260              .. simple_serif (z1r, z1l, 90)
1261              .. z2l{down}
1262              -- cycle;
1263 enddef;
1264
1265
1266 fet_beginchar ("Right Parenthesis", "rightparen");
1267         draw_paren;
1268         penlabels (1, 2, 3);
1269
1270         remember_pic := currentpicture;
1271
1272         draw_staff (-2, 2, 0);
1273 fet_endchar;
1274
1275
1276 draw_shifted_too;
1277
1278
1279 fet_beginchar ("Left Parenthesis", "leftparen");
1280         draw_paren;
1281
1282         currentpicture := currentpicture xscaled -1;
1283
1284         set_char_box (charwd, charbp, chardp, charht);
1285 fet_endchar;
1286
1287 fet_endgroup ("accidentals");