]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-toevallig.mf
Add arrowed natural signs
[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 ("1/2 Sharp", "sharp.slashslash.stem");
270         save stem, stemwidth;
271         save outer_space, interbeam;
272
273         stemwidth# := stafflinethickness# + .05 staff_space#;
274         define_whole_blacker_pixels (stemwidth);
275
276         interbeam := 1.05 staff_space_rounded;
277
278         set_char_box (0, 0.7 staff_space#,
279                       1.5 staff_space#, 1.5 staff_space#);
280
281         stem := 7 / 16 * w;
282         outer_space := hround ((w - stemwidth) / 2);
283
284         w := 2 outer_space + stemwidth;
285         d := d - feta_space_shift;
286
287         draw_meta_sharp (w, -.5 interbeam);
288         draw_meta_sharp (w, -.5 interbeam + vround interbeam);
289
290         pickup pencircle scaled stemwidth;
291
292         lft x5 = lft x6 = outer_space;
293         top y6 = vround (1.5 staff_space - .5 stem);
294         bot y5 = -top y6 + feta_space_shift;
295
296         labels (5, 6);
297
298         draw_gridline (z5, z6, stemwidth);
299
300         remember_pic := currentpicture;
301
302         draw_staff (-2, 2, 0);
303 fet_endchar;
304
305
306 draw_shifted_too;
307
308
309 fet_beginchar ("Sharp (3 beams)", "sharp.slashslashslash.stemstem");
310         save stem, stemx, stemwidth;
311         save outer_space, interbeam;
312         save sharp_beamheight;
313
314         sharp_beamheight# := 0.22 staff_space# + stafflinethickness#;
315
316         stemwidth# := stafflinethickness# + .05 staff_space#;
317         define_whole_blacker_pixels (stemwidth);
318
319         interbeam := 1.2 staff_space_rounded;
320
321         set_char_box (0, 1.1 staff_space#,
322                       1.5 staff_space#, 1.5 staff_space#);
323
324         stem := 7 / 16 * w;
325         stemx := hround stem;
326         outer_space := hround ((w - stemx - stemwidth) / 2);
327
328         w := 2 outer_space + stemx + stemwidth;
329         d := d - feta_space_shift;
330
331         draw_meta_sharp (.88 w, -.5 interbeam);
332         draw_meta_sharp (.88 w, -.5 interbeam + vround interbeam);
333         sharp_beamheight# := 1/.88 sharp_beamheight#;
334         draw_meta_sharp (w, 0);
335
336         pickup pencircle scaled stemwidth;
337
338         lft x5 = lft x6 = outer_space;
339         lft x7 = lft x8 = outer_space + stemx;
340         bot y5 = -d;
341         top y6 = vround (1.5 staff_space - stem * beamslope);
342         bot y7 = -top y6 + feta_space_shift;
343         top y8 = h;
344
345         labels (5, 6, 7, 8);    
346
347         draw_gridline (z5, z6, stemwidth);
348         draw_gridline (z7, z8, stemwidth);
349
350         remember_pic := currentpicture;
351
352         draw_staff (-2, 2, 0);
353 fet_endchar;
354
355
356 draw_shifted_too;
357
358
359 fet_beginchar ("1/2 Sharp (3 beams)", "sharp.slashslashslash.stem");
360         save stem, stemx, stemwidth;
361         save outer_space, interbeam;
362         save sharp_beamheight;
363
364         sharp_beamheight# := 0.22 staff_space# + stafflinethickness#;
365
366         stemwidth# := stafflinethickness# + .05 staff_space#;
367         define_whole_blacker_pixels (stemwidth);
368
369         interbeam := 1.2 staff_space_rounded;
370
371         set_char_box (0, 0.95 staff_space#,
372                       1.3 staff_space#, 1.3 staff_space#);
373
374         stem := 7 / 16 * w;
375         outer_space := hround ((w - stemwidth) / 2);
376
377         w := 2 outer_space + stemwidth;
378         d := d - feta_space_shift;
379
380         draw_meta_sharp (.8 w, -.5 interbeam);
381         draw_meta_sharp (.8 w, -.5 interbeam + vround interbeam);
382         sharp_beamheight# := 1/.8 sharp_beamheight#;
383         draw_meta_sharp (w, 0);
384
385         pickup pencircle scaled stemwidth;
386
387         lft x5 = lft x6 = outer_space;
388         top y6 = vround (1.5 staff_space - .5 stem);
389         bot y5 = -top y6 + feta_space_shift;
390         labels (5, 6);
391
392         draw_gridline (z5, z6, stemwidth);
393
394         remember_pic := currentpicture;
395
396         draw_staff (-2, 2, 0);
397 fet_endchar;
398
399
400 draw_shifted_too;
401
402
403 fet_beginchar ("3/4 Sharp", "sharp.slashslash.stemstemstem");
404         save stem, stemx, stemwidth;
405         save outer_space, interbeam;
406
407         stemwidth# := stafflinethickness# + .05 staff_space#;
408         define_whole_blacker_pixels (stemwidth);
409
410         interbeam := 1.05 staff_space_rounded;
411
412         set_char_box (0, 1.6 staff_space#,
413                       1.5 staff_space#, 1.5 staff_space#);
414
415         stem := 9 / 32 * w;
416         stemx := hround stem;
417         outer_space := hround ((w - 2 stemx - stemwidth) / 2);
418
419         w := 2 outer_space + 2 stemx + stemwidth;
420         d := d - feta_space_shift;
421
422         draw_meta_sharp (w, -.5 interbeam);
423         draw_meta_sharp (w, -.5 interbeam + vround interbeam);
424
425         pickup pencircle scaled stemwidth;
426
427         lft x5 = lft x6 = outer_space;
428         lft x7 = lft x8 = outer_space + stemx;
429         lft x9 = lft x10 = outer_space + 2 stemx;
430         bot y5 = -d;
431         top y6 = vround (1.5 staff_space - 2 stem * beamslope);
432         bot y9 = -top y6 + feta_space_shift;
433         top y10 = h;
434         y7 = .5 [y5, y9];
435         y8 = .5 [y6, y10];
436
437         labels (5, 6, 7, 8, 9, 10);
438
439         draw_gridline (z5, z6, stemwidth);
440         draw_gridline (z7, z8, stemwidth);
441         draw_gridline (z9, z10, stemwidth);
442
443         remember_pic := currentpicture;
444
445         draw_staff (-2, 2, 0);
446 fet_endchar;
447
448
449 draw_shifted_too;
450
451
452 %
453 % The stems of the natural are brushed (at least, in Barenreiter SCS)
454 %
455
456 def draw_natural (expr arrowup, arrowdown) =
457         save stemwidth, top_stem_thick;
458         save ne, pat_top, pat_bottom;
459         save depth, height, extendleft, extendright, stemlength;
460         save brush_scale_up, brush_scale_down;
461         pair ne;
462         path pat_top, pat_bottom;
463
464         top_stem_thick# = stafflinethickness# + .10 staff_space#;
465         stemwidth# = 0.09 staff_space# + .5 stafflinethickness#;
466         define_whole_blacker_pixels (top_stem_thick, stemwidth);
467
468         stemlength# = 1.5 staff_space#;
469         define_pixels (stemlength);
470
471         height# = stemlength#;
472         depth# = stemlength#;
473         extendleft# = 0;
474         extendright# = 0;
475         if arrowup:
476                 extendleft# := 3 stafflinethickness#;
477                 height# := height# + 1.2 staff_space#;
478         fi;
479         if arrowdown:
480                 extendright# := 3.15 stafflinethickness#;
481                 depth# := depth# + 1.2 staff_space#;
482         fi;
483         define_pixels (extendright);
484
485         set_char_box (extendleft#, 2/3 staff_space#, depth#, height#);
486
487         d := d - feta_space_shift;
488
489         pickup pencircle scaled stemwidth;
490
491         brush_scale_up   := 1.0;
492         brush_scale_down := 1.0;
493         % to look nice, arrowed stems must be less brushed
494         if arrowup:
495                 brush_scale_up := 0.85;
496         fi;
497         if arrowdown:
498                 brush_scale_down := 0.85;
499         fi;
500
501         penpos1 (top_stem_thick, 0);
502         penpos3 (top_stem_thick, 0);
503         penpos2 (stemwidth, 0);
504         penpos4 (stemwidth, 0);
505         % z1' and z3' are needed for the arrowed accidentals
506         penpos1' (top_stem_thick * brush_scale_up, 0);
507         penpos3' (top_stem_thick * brush_scale_down, 0);
508
509         x2r = w;
510         x4l = 0;
511         x3 = x3' = x2;
512         x1 = x1' = x4;
513
514         y1 = y1' = stemlength;
515         y3 = y3' = -stemlength;
516         top y2 = vround (staff_space - 3/2 stafflinethickness);
517         y4 = -y2 + feta_space_shift;
518
519         pat_bottom := z4r{z4r - z1r}
520                       .. bot z4
521                       .. z4l{z1l - z4l};
522         fill simple_serif (z1'l, z1'r, -30)
523              -- pat_bottom
524              -- cycle;
525
526         pat_top := z2r{z2r - z3r}
527                    .. top z2
528                    .. z2l{z3l - z2l};
529         fill simple_serif (z3'l, z3'r, 30)
530              -- pat_top
531              -- cycle;
532
533         ne = (x2 - x4, stafflinethickness);
534
535         z11' = z3l + whatever * (z2l - z3l);
536         y11' = vround (.5 (staff_space - stafflinethickness));
537         z11 = z11' + whatever * ne;
538         x11 = x12;
539         z12 = directionpoint -ne of pat_top;
540         z13 = z12 + whatever * ne;
541         x13 = x1;
542         z14 = z11 + whatever * ne;
543         x14 = x1;
544
545         z21' = z4r + whatever * (z1r - z4r);
546         y21' = -y11' + feta_space_shift;
547         z21 = z21' + whatever * ne;
548         x21 = x22;
549         z22 = directionpoint -ne of pat_bottom;
550         z23 = z22 + whatever * ne;
551         x23 = x3;
552         z24 = z21 + whatever * ne;
553         x24 = x3;
554
555         fill z11
556              -- z12
557              -- z13
558              -- z14
559              -- cycle;
560         fill z21
561              -- z22
562              -- z23
563              -- z24
564              -- cycle;
565
566         penlabels (1, 1', 2, 3, 3', 4);
567         labels (11, 11', 12, 13, 14, 21, 21', 22, 23, 24);
568
569         if arrowup:
570                 draw_arrow (z1, top_stem_thick * brush_scale_up,
571                             z1'l-z4l, stafflinethickness/2, false);
572         fi;
573         if arrowdown:
574                 draw_arrow (z3, top_stem_thick * brush_scale_down,
575                             z2r-z3'r, stafflinethickness/2, true);
576                 w := w + extendright;
577         fi;
578
579         remember_pic := currentpicture;
580
581         draw_staff (-2, 2, 0);
582 enddef;
583
584 fet_beginchar ("Natural", "natural");
585         draw_natural (false, false);
586 fet_endchar;
587
588
589 draw_shifted_too;
590
591
592 fet_beginchar ("Natural", "natural.arrowup");
593         draw_natural (true, false);
594 fet_endchar;
595
596
597 draw_shifted_too;
598
599
600 fet_beginchar ("Natural", "natural.arrowdown");
601         draw_natural (false, true);
602 fet_endchar;
603
604
605 draw_shifted_too;
606
607
608 %
609 % Dedicated to my mom.    (3/10/97)
610 %
611 % Mamma, ik hou van je; kom je alsjeblieft terug?
612 %    -- HW
613 %
614 %
615 % TODO: remove crook_fatness
616 % TODO: document, simplify!
617 %
618
619 def draw_meta_flat (expr xcenter, w, crook_fatness, arrowup, arrowdown) =
620         save crook_thinness;
621         save bottom_overshoot, bot_crook_dir;
622         save top_stem_thick, top_stem_thick_orig, bottom_stem_thick, hair, smaller_hole;
623         save top_crook_thinness;
624         save zwiep;
625         save center;
626         pair center, bot_crook_dir;
627         save clearing, clearing_orig;
628
629         clearxy;
630
631         % the stem shouldn't reach the top staff line.
632         %% TODO: should take from height.
633         %
634         % TODO: parameterize this
635         %
636         if w >= 0.75 staff_space:
637                 smaller_hole = 0.35 stafflinethickness;
638         else:
639                 smaller_hole = 0;
640         fi;
641         crook_thinness = .7 stafflinethickness + .06 staff_space;
642         top_crook_thinness = 1 stafflinethickness + .065 staff_space;
643         clearing = 1.7 stafflinethickness;
644         clearing_orig = clearing;
645         if arrowup:
646                 clearing := 0.5 staff_space;
647         fi;
648         bottom_overshoot = stafflinethickness;
649
650         bottom_stem_thick# = 0.06 staff_space# + 0.6 stafflinethickness#;
651         top_stem_thick# = 0.1 staff_space# + 1.2 stafflinethickness#;
652         top_stem_thick_orig# = top_stem_thick#;
653         if arrowup:
654                 % to look nice, arrowed stems should be less brushed
655                 top_stem_thick# := top_stem_thick#*0.80;
656         fi;
657         define_whole_blacker_pixels (bottom_stem_thick, top_stem_thick,
658                                      top_stem_thick_orig);
659
660         if odd (top_stem_thick - bottom_stem_thick):
661                 top_stem_thick := top_stem_thick - 1;
662         fi;
663         if odd (top_stem_thick_orig - bottom_stem_thick):
664                 top_stem_thick_orig := top_stem_thick_orig - 1;
665         fi;
666
667         center = (xcenter, 0);
668
669         x1l = hround (xcenter - .5 top_stem_thick);
670         y1 = vround (2 staff_space - clearing);
671         x2l = hround (xcenter - .5 bottom_stem_thick);
672         y2 = -.5 staff_space - .5 stafflinethickness;
673         % z16 and the _orig variables are needed for arrowed accidentals because
674         % their inner part should be unchanged from plain ones but the points z3l,
675         % z3r and z10 depend on values that are different for arrowed accidentals
676         x16l = hround (xcenter - .5 top_stem_thick_orig);
677         y16 = vround (2 staff_space - clearing_orig);
678
679         penpos1 (top_stem_thick, 0);
680         penpos16 (top_stem_thick_orig, 0);
681         penpos2 (bottom_stem_thick, 0);
682
683         y3l = vfloor ((staff_space - stafflinethickness) / 2);
684         z3l = whatever [z2r, z1r];
685         z3r = .3 [z2r, (z16r shifted (0, clearing_orig - 1.7 stafflinethickness))]
686               + (smaller_hole, 0);
687         x3r := hceiling x3r;
688
689         % we insert z3l to get better conversion with mf2pt1
690         fill simple_serif (z1r, z1l, 30)
691              -- z2l
692              -- z2r
693              -- z3l
694              -- cycle;
695
696         z10 = whatever [z2r, z16r] + (smaller_hole, 0);
697         y10 = -1/10 staff_space;
698         x10 := hceiling x10;
699
700         x11 = xcenter + bottom_overshoot / 3;
701         y11 = -vround (.5 (staff_space + stafflinethickness)
702                        + bottom_overshoot);
703
704         x2a = 0.2[x2r,x7];
705         y2a = 1.5[y2,y11];
706
707         penpos4 (whatever, 53);
708
709         y4l - y4r = top_crook_thinness;
710         y5r = .15 staff_space;
711         x5l = hround (w + xcenter);
712         y4 = staff_space / 2;
713         x4r = .45 [x5r, x3r];
714         y4l := vround y4l;
715
716         penpos5 (crook_fatness, -175);
717
718         bot_crook_dir = unitvector ((x5l, 0) - z11);
719         z8 = z11 + whatever * bot_crook_dir;
720         y8 = -staff_space / 2;
721
722         z7 = z8
723              + whatever * bot_crook_dir
724              + crook_thinness * (bot_crook_dir rotated 90);
725         x7 = .1 [x3r, x8];
726
727         unfill z3r{z3r - z10}
728                .. z4r{right}
729                .. z5r{down}
730                .. z7{-bot_crook_dir}
731                & z7
732                .. z10{z3r - z10}
733                -- cycle;
734
735         if arrowdown:
736                 fill z2l{down}
737                      .. z2a{up}
738                      .. z8{bot_crook_dir}
739                      .. z5l{up}
740                      .. z4l{left}
741                      .. z3l
742                      -- cycle;
743         else:
744                 fill z2l{down}
745                      .. z11{right}
746                      .. z8{bot_crook_dir}
747                      .. z5l{up}
748                      .. z4l{left}
749                      .. z3l
750                      -- cycle;
751         fi;
752
753         if arrowup:
754                 draw_arrow (z1, top_stem_thick, z1l-z2l,
755                             0.5stafflinethickness, false);
756         fi;
757         if arrowdown:
758                 draw_arrow ((0.5[x2l,x2a],y2), x2a-x2l, up,
759                             staff_space/2, true);
760         fi;
761 enddef;
762
763
764 def draw_arrowed_meta_flat (expr xcenter, width, crook_fatness, arrowup, arrowdown) =
765         save depth, height, extendleft;
766
767         depth# = 0.6 staff_space#;
768         height# = 1.9 staff_space#;
769         extendleft# := 1.2 stafflinethickness#;
770         if arrowup:
771                 extendleft# := 3.45 stafflinethickness#;
772                 height# := height# + 0.8 staff_space#;
773         fi;
774         if arrowdown:
775                 extendleft# := 3.45 stafflinethickness#;
776                 depth# := depth# + 1.6 staff_space#;
777         fi;
778
779         set_char_box (extendleft#, width, depth#, height#);
780         draw_meta_flat(xcenter, w, crook_fatness, arrowup, arrowdown);
781 enddef;
782
783 %
784 % unfortunately, 600dpi is not enough to show the brush of the stem.
785 %
786
787 fet_beginchar ("Flat", "flat");
788         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, false, false);
789         penlabels (range 0 thru 11);
790
791         remember_pic := currentpicture;
792
793         draw_staff (-2, 2, 0);
794 fet_endchar;
795
796
797 draw_shifted_too;
798
799
800 fet_beginchar ("Arrowed Flat (up-arrow)", "flat.arrowup");
801         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, true, false);
802         penlabels (range 0 thru 23);
803
804         remember_pic := currentpicture;
805
806         draw_staff (-2, 2, 0.0);
807 fet_endchar;
808
809
810 draw_shifted_too;
811
812
813 fet_beginchar ("Arrowed Flat (down-arrow)", "flat.arrowdown");
814         draw_arrowed_meta_flat(0, 0.8 staff_space#, 0.31 staff_space, false, true);
815         penlabels (range 0 thru 23);
816
817         remember_pic := currentpicture;
818
819         draw_staff (-2, 2, 0.0);
820 fet_endchar;
821
822
823 draw_shifted_too;
824
825
826 fet_beginchar ("Flat (slashed)", "flat.slash");
827         set_char_box (.4 staff_space#, .8 staff_space#,
828                       0.6 staff_space#, 1.9 staff_space#);
829
830         draw_meta_flat (0, w, 0.31 staff_space, false, false);
831
832         clearxy;
833
834         save slope, slash_width;
835         slope = 0.5;
836         slash_width = w;
837
838         z11 = (0, h / 2);
839         z12 = z11 - (slash_width, slash_width * slope) / 2;
840         z13 = z11 + (slash_width, slash_width * slope) / 2;
841         penpos12 (1.5 stafflinethickness, angle (z13 - z12) - 90);
842         penpos13 (1.5 stafflinethickness, angle (z13 - z12) - 90);
843
844         z14 = z12 - .75 stafflinethickness * unitvector (z13 - z12);
845         z15 = z13 + .75 stafflinethickness * unitvector (z13 - z12);
846
847         fill z13r
848              .. z15
849              .. z13l
850              -- z12l
851              .. z14
852              .. z12r
853              -- z13r
854              .. cycle;
855
856         penlabels (12, 13);
857         labels (14, 15);
858
859         remember_pic := currentpicture;
860
861         draw_staff (-2, 2, 0);
862 fet_endchar;
863
864
865 fet_beginchar ("Flat (slashed twice)", "flat.slashslash");
866         set_char_box (.4 staff_space#, .8 staff_space#,
867                       0.6 staff_space#, 1.9 staff_space#);
868
869         draw_meta_flat (0, w, 0.31 staff_space, false, false);
870
871         clearxy;
872
873         save slope, slash_width;
874         slope = 0.5;
875         slash_width = w;
876
877         z11 = (0, 5/12 h);
878         z12 = z11 - (slash_width, slash_width * slope) / 2;
879         z13 = z11 + (slash_width, slash_width * slope) / 2;
880         penpos12 (1.5 stafflinethickness, angle (z13 - z12) - 90);
881         penpos13 (1.5 stafflinethickness, angle (z13 - z12) - 90);
882
883         z14 = z12 - .75 stafflinethickness * unitvector (z13 - z12);
884         z15 = z13 + .75 stafflinethickness * unitvector (z13 - z12);
885
886         fill z13r
887              .. z15
888              .. z13l
889              -- z12l
890              .. z14
891              .. z12r
892              -- z13r
893              .. cycle;
894
895         penlabels (12, 13);
896         labels (14, 15);
897
898         z21 = (0, 2/3 h);
899         z22 = z21 - (slash_width, slash_width * slope) / 2;
900         z23 = z21 + (slash_width, slash_width * slope) / 2;
901         penpos22 (1.5 stafflinethickness, angle (z23 - z22) - 90);
902         penpos23 (1.5 stafflinethickness, angle (z23 - z22) - 90);
903
904         z24 = z22 - .75 stafflinethickness * unitvector (z23 - z22);
905         z25 = z23 + .75 stafflinethickness * unitvector (z23 - z22);
906
907         fill z23r
908              .. z25
909              .. z23l
910              -- z22l
911              .. z24
912              .. z22r
913              -- z23r
914              .. cycle;
915
916         penlabels (22, 23);
917         labels (24, 25);
918
919         remember_pic := currentpicture;
920
921         draw_staff (-2, 2, 0);
922 fet_endchar;
923
924
925 fet_beginchar ("Flatflat (mirrored)", "mirroredflat.flat");
926         set_char_box (0, 1.6 staff_space#, 
927                       0.6 staff_space#, 1.9 staff_space#);
928
929         % This is a modified version of `draw_meta_flat'.
930
931         save crook_thinness, crook_fatness;
932         save bottom_overshoot, bot_crook_dir;
933         save top_stem_thick, bottom_stem_thick, hair, smaller_hole;
934         save top_crook_thinness;
935         save zwiep;
936         save center;
937         pair center, bot_crook_dir;
938         save clearing, wid;
939         save pat;
940         path pat;
941
942         clearxy;
943
944         wid = w / 2;
945
946         % the stem shouldn't reach the top staff line.
947         %% TODO: should take from height.
948         %
949         % TODO: parameterize this
950         %
951         if wid >= 0.75 staff_space:
952                 smaller_hole = 0.35 stafflinethickness;
953         else:
954                 smaller_hole = 0;
955         fi;
956         clearing = 1.7 stafflinethickness;
957         crook_thinness = .7 stafflinethickness + .06 staff_space;
958         crook_fatness = 0.31 staff_space;
959         top_crook_thinness = 1 stafflinethickness + .065 staff_space;
960         bottom_overshoot = stafflinethickness;
961
962         bottom_stem_thick# = 0.06 staff_space# + 0.6 stafflinethickness#;
963         top_stem_thick# = 0.1 staff_space# + 1.2 stafflinethickness#;
964         define_whole_blacker_pixels (bottom_stem_thick, top_stem_thick);
965
966         if odd (top_stem_thick - bottom_stem_thick):
967                 top_stem_thick := top_stem_thick - 1;
968         fi;
969
970         center = (0, 0);
971
972         x1l = hround (-.5 top_stem_thick);
973         y1 = vround (2 staff_space - clearing);
974         x2l = hround (-.5 bottom_stem_thick);
975         y2 = -.5 staff_space - .5 stafflinethickness;
976
977         penpos1 (top_stem_thick, 0);
978         penpos2 (bottom_stem_thick, 0);
979
980         y3l = vfloor ((staff_space - stafflinethickness) / 2);
981         z3l = whatever [z2r, z1r];
982         z3r = .3 [z2r, z1r] + (smaller_hole, 0);
983         x3r := hceiling x3r;
984
985         z10 = whatever [z2r, z1r] + (smaller_hole, 0);
986         y10 = -1/10 staff_space;
987         x10 := hceiling x10;
988
989         x11 = bottom_overshoot / 3;
990         y11 = -vround (.5 (staff_space + stafflinethickness)
991                        + bottom_overshoot);
992
993         penpos4 (whatever, 53);
994
995         y4l - y4r = top_crook_thinness;
996         y5r = .15 staff_space;
997         x5l = hround (wid);
998         y4 = staff_space / 2;
999         x4r = .45 [x5r, x3r];
1000         y4l := vround y4l;
1001
1002         penpos5 (crook_fatness, -175);
1003
1004         bot_crook_dir = unitvector ((x5l, 0) - z11);
1005         z8 = z11 + whatever * bot_crook_dir;
1006         y8 = -staff_space / 2;
1007
1008         z7 = z8
1009              + whatever * bot_crook_dir
1010              + crook_thinness * (bot_crook_dir rotated 90);
1011         x7 = .1 [x3r, x8];
1012
1013         pat := z3r{z3r - z10}
1014                .. z4r{right}
1015                .. z5r{down}
1016                .. z7{-bot_crook_dir}
1017                & z7
1018                .. z10{z3r - z10}
1019                -- cycle;
1020         unfill pat;
1021         unfill pat xscaled -1;
1022
1023         pat := z11{right}
1024                .. z8{bot_crook_dir}
1025                .. z5l{up}
1026                .. z4l{left}
1027                .. z3l;
1028         fill pat
1029              -- simple_serif (z1r, z1l, 30)
1030              -- reverse pat xscaled -1 shifted (-feta_eps, 0)
1031              -- cycle;
1032
1033         currentpicture := currentpicture shifted (w/2, 0);
1034
1035         remember_pic := currentpicture;
1036
1037         draw_staff (-2, 2, 0);
1038 fet_endchar;
1039
1040
1041 draw_shifted_too;
1042
1043
1044 fet_beginchar ("Semi flat", "mirroredflat");
1045         set_char_box (1.2 stafflinethickness#, .8 staff_space#,
1046                       0.6 staff_space#, 1.9 staff_space#);
1047
1048         draw_meta_flat (0, w, 0.31 staff_space, false, false);
1049         currentpicture := currentpicture xscaled -1 shifted (w - b, 0);
1050 fet_endchar;
1051
1052
1053 fet_beginchar ("Semi flat", "mirroredflat.backslash");
1054         set_char_box (.4 staff_space#, .8 staff_space#,
1055                       0.6 staff_space#, 1.9 staff_space#);
1056
1057         draw_meta_flat (0, w, 0.31 staff_space, false, false);
1058
1059         clearxy;
1060
1061         save slope, slash_width;
1062         slope = 0.5;
1063         slash_width = w;
1064
1065         z11 = (0, h / 2);
1066         z12 = z11 - (slash_width, slash_width * slope) / 2;
1067         z13 = z11 + (slash_width, slash_width * slope) / 2;
1068         penpos12 (1.5 stafflinethickness, angle (z13 - z12) - 90);
1069         penpos13 (1.5 stafflinethickness, angle (z13 - z12) - 90);
1070
1071         z14 = z12 - .75 stafflinethickness * unitvector (z13 - z12);
1072         z15 = z13 + .75 stafflinethickness * unitvector (z13 - z12);
1073
1074         fill z13r
1075              .. z15
1076              .. z13l
1077              -- z12l
1078              .. z14
1079              .. z12r
1080              -- z13r
1081              .. cycle;
1082
1083         currentpicture := currentpicture xscaled -1 shifted (w - b, 0);
1084
1085         labels (1, 2, 3);
1086 fet_endchar;
1087
1088
1089 fet_beginchar ("Double Flat", "flatflat");
1090         save left_wid, overlap, right_wid;
1091
1092         left_wid = .7;
1093         right_wid = .8;
1094         overlap = .05;
1095
1096         set_char_box (1.2 stafflinethickness#,
1097                       (left_wid + right_wid - overlap) * staff_space#,
1098                       .6 staff_space#, 1.9 staff_space#);
1099         draw_meta_flat (0, left_wid * staff_space, 1/3 staff_space, false, false);
1100         draw_meta_flat (hround ((left_wid - overlap) * staff_space),
1101                         right_wid * staff_space, 1/3 staff_space, false, false);
1102 fet_endchar;
1103
1104
1105 fet_beginchar ("3/4 Flat", "flatflat.slash");
1106         save left_wid, overlap, right_wid;
1107
1108         left_wid = .7;
1109         right_wid = .8;
1110         overlap = .05;
1111
1112         set_char_box (1.2 stafflinethickness#,
1113                       (left_wid + right_wid - overlap) * staff_space#,
1114                       .6 staff_space#, 1.9 staff_space#);
1115         draw_meta_flat (0, left_wid * staff_space, 1/3 staff_space, false, false);
1116         draw_meta_flat (hround ((left_wid - overlap) * staff_space),
1117                         right_wid * staff_space, 1/3 staff_space, false, false);
1118
1119         %% maybe we should clip part of the stems?
1120         %% or make the 1st flat smaller?
1121         %% or reverse it?
1122         pickup pencircle scaled 2 stafflinethickness;
1123
1124         z12 = round (-.25 w - b, .55 staff_space) + feta_offset;
1125         z13 = round (.75 w, 1.45 staff_space) + feta_offset;
1126         penpos12 (2 stafflinethickness, angle (z13 - z12) - 90);
1127         penpos13 (2 stafflinethickness, angle (z13 - z12) - 90);
1128
1129         z14 = z12 - stafflinethickness * unitvector (z13 - z12);
1130         z15 = z13 + stafflinethickness * unitvector (z13 - z12);
1131
1132         fill z13r
1133              .. z15
1134              .. z13l
1135              -- z12l
1136              .. z14
1137              .. z12r
1138              -- z13r
1139              .. cycle;
1140
1141         penlabels (12, 13);
1142         labels (14, 15);
1143
1144         remember_pic := currentpicture;
1145
1146         draw_staff (-2, 2, 0);
1147 fet_endchar;
1148
1149
1150 draw_shifted_too;
1151
1152
1153 fet_beginchar ("Double Sharp", "doublesharp");
1154         save klaverblad, klaversteel;
1155         save pat;
1156         path pat;
1157
1158         klaversteel = 1/15 staff_space;
1159         klaverblad = .4 staff_space - .5 stafflinethickness;
1160
1161         set_char_box (0, staff_space#, .5 staff_space#, .5 staff_space#);
1162
1163         z1 = (klaversteel, 0);
1164         z2 = (w / 2 - klaverblad / 10, h - klaverblad);
1165         z3 = (w / 2, h);
1166         z4 = z2 reflectedabout ((0, 0), (1, 1));
1167         z5 = z1 reflectedabout ((0, 0), (1, 1));
1168
1169         labels (1, 2, 3, 4, 5);
1170
1171         pickup pencircle scaled blot_diameter;
1172
1173         x2 := hfloor (rt x2) - blot_diameter / 2;
1174         x3 := hfloor (rt x3) - blot_diameter / 2;
1175         y3 := vfloor (top y3) - blot_diameter / 2;
1176         y4 := vfloor (top y4) - blot_diameter / 2;
1177
1178         pat = (rt z1){dir45}
1179               .. {right}(bot z2)
1180               .. rt z2
1181               -- rt z3{z3 - z2}
1182               .. top z3{z4 - z3}
1183               -- top z4{z4 - z3}
1184               .. (lft z4){down}
1185               .. {dir 225}(top z5);
1186         pat := pat
1187                -- reverse pat xscaled -1 shifted (-feta_eps, 0);
1188
1189         % assure symmetry -- it's more important to center the glyph on the
1190         % staff line than centering it between staff lines, so we use
1191         % feta_shift, not feta_space_shift.
1192         h := h + feta_shift;
1193
1194         fill pat shifted (0, feta_shift)
1195              -- reverse pat yscaled -1 shifted (0, -feta_eps)
1196              -- cycle;
1197
1198         % ugh
1199         currentpicture := currentpicture shifted (hround (w / 2), 0);
1200
1201         remember_pic := currentpicture;
1202
1203         draw_staff (-2, 2, 0);
1204 fet_endchar;
1205
1206
1207 draw_shifted_too;
1208
1209
1210 def draw_paren =
1211         save leftindent;
1212
1213         leftindent := .2 staff_space;
1214
1215         set_char_box (0, .5 staff_space# + stafflinethickness#,
1216                       staff_space#, staff_space#);
1217
1218         d := d - feta_shift;
1219
1220         z1 = (leftindent, h);
1221         z2 = (w - stafflinethickness, .5 (h - d));
1222         z3 = (leftindent, -d);
1223
1224         penpos1 (stafflinethickness, 35);
1225         penpos2 (.1 staff_space + stafflinethickness, 0);
1226         penpos3 (stafflinethickness, -35);
1227
1228         fill z2l{down}
1229              .. simple_serif (z3l, z3r, 90)
1230              .. z2r{up}
1231              .. simple_serif (z1r, z1l, 90)
1232              .. z2l{down}
1233              -- cycle;
1234 enddef;
1235
1236
1237 fet_beginchar ("Right Parenthesis", "rightparen");
1238         draw_paren;
1239         penlabels (1, 2, 3);
1240
1241         remember_pic := currentpicture;
1242
1243         draw_staff (-2, 2, 0);
1244 fet_endchar;
1245
1246
1247 draw_shifted_too;
1248
1249
1250 fet_beginchar ("Left Parenthesis", "leftparen");
1251         draw_paren;
1252
1253         currentpicture := currentpicture xscaled -1;
1254
1255         set_char_box (charwd, charbp, chardp, charht);
1256 fet_endchar;
1257
1258 fet_endgroup ("accidentals");