(interpret_stencil_expression): bugfix
[lilypond.git] / mf / feta-accordion.mf
blob461f27fe780b2caa06fba586766113ff3c01d62e
1 % -*- Fundamental -*-
3 fet_begingroup("accordion")
5 accreg_dot_size# := .5staff_space#;
6 accreg_linethickness# := 1.3stafflinethickness#;
8 % This dimention is the same on all registersymbols.
9 % The different symbols should calculate their other
10 % dimensions from this and accreg_dot_size
11 accreg_lh# := 1.0staff_space#;
13 define_pixels(accreg_dot_size, accreg_linethickness, accreg_lh);
14 pen accreg_pen;
15 accreg_pen := pencircle xscaled accreg_linethickness yscaled 0.7accreg_linethickness;
17 fet_beginchar("accDiscant", "accDiscant", "accDiscant")
18         save r, sx;
19         r# = 3/2accreg_lh#;
20         define_pixels(r);
21 %       set_char_box(r#, r#, 2r#, 0);
22         set_char_box(r#, r#, 0r#, 2r#); %% arg3 = under linjen, arg4 = over
23         pickup accreg_pen;
24         draw fullcircle scaled 2r;
25         sx = cosd(19.471221);
26         draw (-sx*r, r/3)--(sx*r, r/3);
27         draw (-sx*r, -r/3)--(sx*r, -r/3);
28         currentpicture := currentpicture shifted (0, r);
29 fet_endchar;
31 fet_beginchar("accDot", "accDot", "accDot")
32         set_char_box(accreg_dot_size#, accreg_dot_size#, 0, 0);
33         pickup pencircle scaled accreg_dot_size;
34         draw(0, 0);
35 fet_endchar;
37 fet_beginchar("accFreebase", "accFreebase", "accFreebase")
38         save r;
39         r#= accreg_lh#;
40         define_pixels(r);
41         set_char_box(r#, r#, 0, 2r#);
42         pickup accreg_pen;
43         draw fullcircle scaled 2r;
44         draw (-r, 0)--(r, 0);
45         currentpicture := currentpicture shifted (0, r);
46 fet_endchar;
48 fet_beginchar("accStdbase", "accStdbase", "accStdbase")
49         save r, sx;
50         r# = 2accreg_lh#;
51         define_pixels(r);
52         sx = cosd 30 ;
53         set_char_box(r#, r#, 0, 2r#);
54         pickup accreg_pen;
55         draw fullcircle scaled 2r;
56         draw (-r, 0)--(r, 0);
57         draw (-sx*r, r/2)--(sx*r, r/2);
58         draw (-sx*r, -r/2)--(sx*r, -r/2);
59         currentpicture := currentpicture shifted (0, r);
60 fet_endchar;
62 %%% strange turning path.
63 fet_beginchar("accBayanbase", "accBayanbase", "accBayanbase")
64         save lh;
65         lh = accreg_lh;
66 %       set_char_box(accreg_lh#, accreg_lh#, 3accreg_lh#, 0);
67         set_char_box(accreg_lh#, accreg_lh#, 0, 3accreg_lh#);
68         pickup pencircle scaled accreg_linethickness;
69         %draw (0, 0)--(2w, 0)--(2w, 3accreg_lh)--(0, 3accreg_lh)--(0, 0);
70         draw (0, 0)--(2w, 0)--(2w, 3accreg_lh)--(0, 3accreg_lh)--cycle;
71         draw (0, accreg_lh)--(2w, accreg_lh);
72         draw (0, 2accreg_lh)--(2w, 2accreg_lh);
73         currentpicture := currentpicture shifted (-w, 0);% -3lh);
74 fet_endchar;
76 def def_B(expr w, h) = 
77         % huh?
78         % pickup pencircle scaled 0.1pt;
79         pickup pencircle scaled 0.15linethickness;
80         penpos10(thin, -90);
81         penpos11(thin, -90);
82         penpos12(thick, 0);
83         penpos13(thin, 90);
84         penpos14(thin, 90);
86         penpos15(thick, 180);
87         penpos16(thin, -90);
88         penpos17(thin, -90);
89         penpos18(thick, 0);
90         penpos19(thick, 0);
91         z10 = (0, 0);
92         z11 = (cOne*w, 0);
93         z12 = (w, .5mb*h);
94         z13 = (cTwo*w, mb*h);
95         z14 = (2thick, mb*h);
96         z15 = (.94w, h-.5mt*h);
97         z16 = z13 + (0, mt*h);
98         z17 = (0, h);
99         z18 = (1.5thick, 0);
100         z19 = (1.5thick, h);
101 enddef;
103 def def_S(expr w, h) =
104         % huh?
105         %pickup pencircle scaled 0.02pt;
106         pickup pencircle scaled 0.03linethickness;
107         penpos1(thin, 180);
108         penpos2(thin, -90);
109         penpos3(thick, 0);
110         penpos4(.5thick, 90);
111         penpos5(thick, 0);
112         penpos6(thin, -90);
113         penpos7(thin, 180);
114         penpos8(thin, 180);
115         penpos9(thin, 0);
116         z1 = (0, hs);
117         z2 = (w/2, 0);
118         z3 = (w-.5thick, .5mb*h);
119         z4 = (w/2, mb*h);
120         z5 = (.5thick, h-.5mt*h);
121         z6 = (w/2, h);
122         z7 = (w, h-hs);
123         z8 = (0, y2r);
124         z9 = (w, y6l);
125         path bue, bueoverst;
126         bue=z2{left}..z1{up};
127         numeric t;
128         t:=xpart(bue intersectiontimes(z8l--z7l));
129         show t;
130         bueoverst=z6{right}..z7{down};
131 enddef;
133 def def_some_vars =
134         save hs, mb, mt, thin, thick, height, width, cOne, cTwo;
135         width = .8(4 staff_space);
136         height = 2.4staff_space;
137         % URG.  smaller sizes should be wider and fatter
138         %thin = 0.05staff_space;
139         %thick = 0.2staff_space;
140         save bx,hx; 4hx+bx=1.15; 10hx+bx=1;
141         fatten:=designsize*hx+bx*1.2;
142         thick:= 0.2staff_space*fatten;
143         % urg: mustn't ever go thinner than blot!
144         thin#:= blot_diameter#;
145         define_pixels (thin);
147         hs = 0.4staff_space;
148         mb = .53;
149         mt = .47;       
150         cOne = 0.65;
151         cTwo = 0.60;
152 enddef;
154 def print_penpos (suffix $)=
155         message "z"&str $ &"l = ("&decimal x.$.l&", "&decimal y.$.l&"); z"&str $ &"r = ("&decimal x.$.r&", "&decimal y.$.r&");";
156 enddef;
159 %%% strange turning path.
160 fet_beginchar("accOldEE", "accOldEE", "accOldEE")
161         set_char_box(staff_space#, staff_space#, 0, 2staff_space#);
162         show w;
163         show h;
164         r = staff_space;
165         lr = .4 staff_space - linethickness;
166         ir = .6 staff_space;
168         z1 = (0,0);
169         z2 = (0, ir);
170         penpos1 (0,0);
171         penpos2 ( .05 staff_space + .5 linethickness,0);
173         penlabels(1,2,3);
175         numeric pp;
176         pickup pencircle scaled blot_diameter;
177         for pp := 0 step 45 until 360:
178                 filldraw fullcircle scaled lr shifted (ir*(dir pp));
179                 filldraw  (z1r--z1l--z2l--z2r--cycle) rotated pp;
180         endfor
182         pickup accreg_pen;
183         draw fullcircle scaled 2r;
184         pickup penrazor;
186         filldraw fullcircle scaled lr;
188         currentpicture := currentpicture shifted (0, r);
191 fet_endchar;
195 fet_endgroup("accordion")