]> git.donarmstrong.com Git - lilypond.git/blob - mf/feta-accordion.mf
Merge branch 'master' of git+ssh://jneem@git.sv.gnu.org/srv/git/lilypond into jneeman
[lilypond.git] / mf / feta-accordion.mf
1 % -*- Fundamental -*-
2
3 fet_begingroup ("accordion");
4
5
6 %
7 % These dimensions are the same for all register symbols.
8 % The different symbols should calculate their other dimensions from them.
9 %
10
11 accreg_dot_size# := .5 staff_space#;
12 accreg_linethickness# := 1.3 stafflinethickness#;
13 accreg_lh# := 1.0 staff_space#;
14
15 define_pixels (accreg_dot_size, accreg_linethickness, accreg_lh);
16
17
18 fet_beginchar ("accDiscant", "accDiscant")
19         save r, pat, lh, lt;
20         path pat;
21
22         r# = 3/2 accreg_lh#;
23         define_pixels (r);
24
25         set_char_box (r# + accreg_linethickness# / 2,
26                       r# + accreg_linethickness# / 2,
27                       0, 2 r# + 0.7 accreg_linethickness#);
28
29         lh = vround (2/3 r);
30         lt = vround (0.7 accreg_linethickness);
31
32         h := 3 lh + lt;
33         b := w := (3 lh + hround accreg_linethickness) / 2;
34
35         penpos1 (hround accreg_linethickness, 0);
36         penpos2 (lt, 90);
37         penpos3 (hround accreg_linethickness, 180);
38         penpos4 (lt, 270);
39
40         z1r = (w, h / 2);
41         z2r = (0, h);
42         z3r = (-b, h / 2);
43         z4r = (0, 0);
44
45         penlabels (1, 2, 3, 4);
46
47         % mf doesn't handle pixel dropouts in outline objects, so we use
48         % `draw' if not called by mpost
49         if known miterlimit:
50                 fill z1r
51                      .. z2r
52                      .. z3r
53                      .. z4r
54                      .. cycle;
55                 unfill z1l
56                        .. z2l
57                        .. z3l
58                        .. z4l
59                        .. cycle;
60         else:
61                 pickup pencircle xscaled accreg_linethickness yscaled lt;
62                 draw z1
63                      .. z2
64                      .. z3
65                      .. z4
66                      .. cycle;
67         fi;
68
69         pat := z4{right}
70                .. z1{up}
71                .. {left}z2;
72
73         pickup penrazor scaled lt rotated 90;
74
75         top z5 = pat intersectionpoint ((0, lh + lt) -- (w, lh + lt));
76         z6 = z5 xscaled -1;
77         bot z7 = pat intersectionpoint ((0, 2 lh) -- (w, 2 lh));
78         z8 = z7 xscaled -1;
79
80         labels (5, 6, 7, 8);
81
82         draw z5
83              -- z6;
84         draw z7
85              -- z8;
86 fet_endchar;
87
88
89 fet_beginchar ("accDot", "accDot")
90         set_char_box (accreg_dot_size# / 2, accreg_dot_size# / 2,
91                       accreg_dot_size# / 2, accreg_dot_size# / 2);
92
93         pickup pencircle scaled accreg_dot_size;
94
95         rt x0 = hround (accreg_dot_size / 2);
96         top y0 = vround (accreg_dot_size / 2);
97
98         drawdot z0;
99 fet_endchar;
100
101
102 fet_beginchar ("accFreebase", "accFreebase")
103         save r, lh, lt;
104
105         r# = accreg_lh#;
106         define_pixels (r);
107
108         set_char_box (r# + accreg_linethickness# / 2,
109                       r# + accreg_linethickness# / 2,
110                       0, 2 r# + 0.7 accreg_linethickness#);
111
112         lh = vround r;
113         lt = vround (0.7 accreg_linethickness);
114
115         h := 2 lh + lt;
116         b := w := (2 lh + hround accreg_linethickness) / 2;
117
118         penpos1 (hround accreg_linethickness, 0);
119         penpos2 (lt, 90);
120         penpos3 (accreg_linethickness, 180);
121         penpos4 (lt, 270);
122
123         z1r = (w, h / 2);
124         z2r = (0, h);
125         z3r = (-b, h / 2);
126         z4r = (0, 0);
127
128         penlabels (1, 2, 3, 4);
129
130         % mf doesn't handle pixel dropouts in outline objects, so we use
131         % `draw' if not called by mpost
132         if known miterlimit:
133                 fill z1r
134                      .. z2r
135                      .. z3r
136                      .. z4r
137                      .. cycle;
138                 unfill z1l
139                        .. z2l
140                        .. z3l
141                        .. z4l
142                        .. cycle;
143         else:
144                 pickup pencircle xscaled accreg_linethickness yscaled lt;
145                 draw z1
146                      .. z2
147                      .. z3
148                      .. z4
149                      .. cycle;
150         fi;
151
152         pickup penrazor scaled lt rotated 90;
153
154         draw z1
155              -- z3;
156 fet_endchar;
157
158
159 fet_beginchar ("accStdbase", "accStdbase")
160         save r, p, lh, lt;
161         path pat;
162
163         r# = 2 accreg_lh#;
164         define_pixels (r);
165
166         set_char_box (r# + accreg_linethickness# / 2,
167                       r# + accreg_linethickness# / 2,
168                       0, 2 r# + 0.7 accreg_linethickness#);
169
170         lh = vround (1/2 r);
171         lt = vround (0.7 accreg_linethickness);
172
173         h := 4 lh + lt;
174         b := w := (4 lh + hround accreg_linethickness) / 2;
175
176         penpos1 (hround accreg_linethickness, 0);
177         penpos2 (lt, 90);
178         penpos3 (hround accreg_linethickness, 180);
179         penpos4 (lt, 270);
180
181         z1r = (w, h / 2);
182         z2r = (0, h);
183         z3r = (-b, h / 2);
184         z4r = (0, 0);
185
186         penlabels (1, 2, 3, 4);
187
188         % mf doesn't handle pixel dropouts in outline objects, so we use
189         % `draw' if not called by mpost
190         if known miterlimit:
191                 fill z1r
192                      .. z2r
193                      .. z3r
194                      .. z4r
195                      .. cycle;
196                 unfill z1l
197                        .. z2l
198                        .. z3l
199                        .. z4l
200                        .. cycle;
201         else:
202                 pickup pencircle xscaled accreg_linethickness yscaled lt;
203                 draw z1
204                      .. z2
205                      .. z3
206                      .. z4
207                      .. cycle;
208         fi;
209
210         pat := z4{right}
211                .. z1{up}
212                .. {left}z2;
213
214         pickup penrazor scaled lt rotated 90;
215
216         top z5 = pat intersectionpoint ((0, lh + lt) -- (w, lh + lt));
217         z6 = z5 xscaled -1;
218         bot z7 = pat intersectionpoint ((0, 3 lh) -- (w, 3 lh));
219         z8 = z7 xscaled -1;
220
221         labels (5, 6, 7, 8);
222
223         draw z1
224              -- z3;
225         draw z5
226              -- z6;
227         draw z7
228              -- z8;
229 fet_endchar;
230
231
232 fet_beginchar ("accBayanbase", "accBayanbase")
233         save lh, lt;
234
235         lh = vround accreg_lh;
236         lt = vround accreg_linethickness;
237
238         set_char_box (accreg_lh# + accreg_linethickness# / 2,
239                       accreg_lh# + accreg_linethickness# / 2,
240                       0, 3 accreg_lh# + accreg_linethickness#);
241
242         h := 3 lh + lt;
243
244         draw_rounded_block ((-w, 0), (-w + lt, h), lt);
245         draw_rounded_block ((w - lt, 0), (w, h), lt);
246
247         pickup penrazor scaled lt rotated 90;
248
249         bot z1 = (-w + lt / 2, 0);
250         bot z2 = (-w + lt / 2, lh);
251         bot z3 = (-w + lt / 2, 2 lh);
252         bot z4 = (-w + lt / 2, 3 lh);
253
254         bot z5 = (w - lt / 2, 0);
255         bot z6 = (w - lt / 2, lh);
256         bot z7 = (w - lt / 2, 2 lh);
257         bot z8 = (w - lt / 2, 3 lh);
258
259         draw z1
260              -- z5;
261         draw z2
262              -- z6;
263         draw z3
264              -- z7;
265         draw z4
266              -- z8;
267 fet_endchar;
268
269
270 def def_B (expr w, h) =
271         pickup pencircle scaled 0.15 linethickness;
272
273         penpos10 (thin, -90);
274         penpos11 (thin, -90);
275         penpos12 (thick, 0);
276         penpos13 (thin, 90);
277         penpos14 (thin, 90);
278
279         penpos15 (thick, 180);
280         penpos16 (thin, -90);
281         penpos17 (thin, -90);
282         penpos18 (thick, 0);
283         penpos19 (thick, 0);
284
285         z10 = (0, 0);
286         z11 = (cOne * w, 0);
287         z12 = (w, .5 mb * h);
288         z13 = (cTwo * w, mb * h);
289         z14 = (2 thick, mb * h);
290         z15 = (.94 w, h - .5 mt * h);
291         z16 = z13 + (0, mt * h);
292         z17 = (0, h);
293         z18 = (1.5 thick, 0);
294         z19 = (1.5 thick, h);
295 enddef;
296
297
298 def def_S (expr w, h) =
299         pickup pencircle scaled 0.03 linethickness;
300
301         penpos1 (thin, 180);
302         penpos2 (thin, -90);
303         penpos3 (thick, 0);
304         penpos4 (.5 thick, 90);
305         penpos5 (thick, 0);
306         penpos6 (thin, -90);
307         penpos7 (thin, 180);
308         penpos8 (thin, 180);
309         penpos9 (thin, 0);
310
311         z1 = (0, hs);
312         z2 = (w / 2, 0);
313         z3 = (w - .5 thick, .5 mb * h);
314         z4 = (w / 2, mb * h);
315         z5 = (.5 thick, h - .5 mt * h);
316         z6 = (w / 2, h);
317         z7 = (w, h - hs);
318         z8 = (0, y2r);
319         z9 = (w, y6l);
320
321         path bue, bueoverst;
322
323         bue := z2{left}
324                .. z1{up};
325
326         t := xpart (bue intersectiontimes (z8l -- z7l));
327
328         bueoverst := z6{right}
329                      .. z7{down};
330 enddef;
331
332
333 def def_some_vars =
334         save hs, mb, mt, thin, thick, height, width, cOne, cTwo;
335         save bx, hx;
336
337         width = .8 (4 staff_space);
338         height = 2.4 staff_space;
339         % URG.  smaller sizes should be wider and fatter
340         % thin = 0.05 staff_space;
341         % thick = 0.2 staff_space;
342
343         4 hx + bx = 1.15;
344         10 hx + bx = 1;
345         fatten := designsize * hx + bx * 1.2;
346         thick := 0.2 staff_space * fatten;
347
348         % urg: mustn't ever go thinner than blot!
349         thin# := blot_diameter#;
350         define_pixels (thin);
351
352         hs = 0.4 staff_space;
353         mb = .53;
354         mt = .47;
355         cOne = 0.65;
356         cTwo = 0.60;
357 enddef;
358
359
360 fet_beginchar ("accOldEE", "accOldEE")
361         save r, pp, ir, lh, lt, stroke_width;
362
363         r# = staff_space#;
364         define_pixels (r);
365
366         lr = .4 staff_space - linethickness;
367         ir = .6 staff_space;
368         stroke_width = .05 staff_space + .5 linethickness;
369
370         set_char_box (r# + accreg_linethickness# / 2,
371                       r# + accreg_linethickness# / 2,
372                       0, 2 r# + 0.7 accreg_linethickness#);
373
374         z1 = (0, 0);
375         z2 = (0, ir);
376         z3 = (0, -ir);
377
378         penpos1 (blot_diameter, 0);
379         penpos2 (stroke_width + blot_diameter, 0);
380         penpos3 (stroke_width + blot_diameter, 0);
381
382         pickup pencircle scaled (lr + blot_diameter);
383
384         for pp := 0 step 45 until 135:
385                 drawdot z2 rotated pp;
386                 drawdot z3 rotated pp;
387
388                 penstroke (z2e
389                            -- z1e
390                            -- z3e) rotated pp;
391         endfor;
392
393         pickup pencircle scaled lr;
394
395         drawdot (0, 0);
396
397         currentpicture := currentpicture shifted (0, h / 2);
398
399         lh = vround (2 r);
400         lt = vround (0.7 accreg_linethickness);
401
402         h := lh + lt;
403         b := w := (lh + hround accreg_linethickness) / 2;
404
405         penpos10 (hround accreg_linethickness, 0);
406         penpos11 (lt, 90);
407         penpos12 (hround accreg_linethickness, 180);
408         penpos13 (lt, 270);
409
410         z10r = (w, h / 2);
411         z11r = (0, h);
412         z12r = (-b, h / 2);
413         z13r = (0, 0);
414
415         % penlabels (1, 2, 10, 11, 12, 13);
416
417         % mf doesn't handle pixel dropouts in outline objects, so we use
418         % `draw' if not called by mpost
419         if known miterlimit:
420                 fill z10r
421                      .. z11r
422                      .. z12r
423                      .. z13r
424                      .. cycle;
425                 unfill z10l
426                        .. z11l
427                        .. z12l
428                        .. z13l
429                        .. cycle;
430         else:
431                 pickup pencircle xscaled accreg_linethickness yscaled lt;
432                 draw z10
433                      .. z11
434                      .. z12
435                      .. z13
436                      .. cycle;
437         fi;
438 fet_endchar;
439
440
441 fet_endgroup ("accordion");