1 %!PS-Adobe-1.0: music-drawing-routines.ps
3 % Functions for direct and embedded PostScript
5 /blot-diameter { lilypondpaperblotdiameter } bind def
13 1 copy mul exch 1 copy mul add sqrt
16 % FIXME. translate to middle of box.
17 % Nice rectangle with rounded corners
18 /draw_box % breapth width depth height
20 currentdict /testing known {
21 %% real thin lines for testing
24 /blot blot-diameter def
31 blot 2 div sub /h exch def
32 blot 2 div sub /d exch def
33 blot 2 div sub /w exch def
34 blot 2 div sub /b exch def
42 currentdict /testing known {
43 %% outline only, for testing:
46 closepath gsave stroke grestore fill
50 /draw_round_box % breapth width depth height blot
58 blot 2 div sub /h exch def
59 blot 2 div sub /d exch def
60 blot 2 div sub /w exch def
61 blot 2 div sub /b exch def
69 currentdict /testing known {
70 %% outline only, for testing:
73 closepath gsave stroke grestore fill
77 % Nice beam with rounded corners
78 /draw_beam % slope width thick
80 currentdict /testing known {
81 %% real thin lines for testing
84 /blot blot-diameter def
95 blot 2 div t 2 div neg moveto
101 currentdict /testing known {
102 %% outline only, for testing:
105 closepath gsave stroke grestore fill
109 /draw_repeat_slash % width slope thick
117 beamthick beamthick slope div euclidean_length
121 width slope width mul rlineto
123 % width neg width angle sin mul neg rlineto
128 /draw_ez_ball % ch letter_col ball_col font
131 findfont 0.7 scalefont setfont
135 0.5 0 0.5 0 360 arc closepath fill stroke
140 0.5 0 0.4 0 360 arc closepath
145 % 0.25 is empiric centering. Change to taste
151 % Simple, but does it work everywhere?
152 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
153 % reverted for now -- jcn
155 % The filled circles are drawn by setting the linewidth
156 % to 2*radius and drawing a point.
157 /simple_draw_ez_ball % ch letter_col ball_col font
160 findfont 0.85 scalefont setfont
161 /origin { 0.45 0 } def
173 % 0.25 is empiric centering. Change to taste
180 % this is for drawing slurs.
181 /draw_bezier_sandwich % thickness controls
196 % 0 360 arc fill stroke
197 0 360 arc closepath fill stroke
200 /draw_dashed_line % dash thickness dx dy
211 /draw_dashed_slur % dash thickness controls
224 % a b c d subvec == a-c b-d
232 % centre? zzwidth zzheight thickness x0 y0 x1 y1
237 4 2 roll % zzuw zzh th x1 y1 x0 y0
240 subvec % zzuw zzh th dx dy
242 2 copy euclidean_length /l exch def
247 l exch div round /n exch def
249 /zzw l n 2 mul div def
251 uy zzh mul 2 div ux zzh mul -2 div rmoveto
254 ux zzw mul uy zzh mul sub
255 uy zzw mul ux zzh mul add
257 ux zzw mul uy zzh mul add
258 uy zzw mul ux zzh mul sub
263 ux l mul uy l mul rlineto
272 /traject_alpha exch def
273 traject_ds traject_alpha sin mul add
275 traject_ds traject_alpha cos mul add
286 bracket_thick arch_height add half_height arch_thick sub arch_width add
287 arch_angle arch_height -0.15 mul bracket_traject
289 bracket_thick 0.5 mul half_height
290 0 arch_height 0.5 mul bracket_traject
294 bracket_thick half_height arch_thick sub
295 0 arch_height 0.4 mul bracket_traject
297 bracket_thick arch_height add half_height arch_thick sub arch_width add
298 arch_angle arch_height -0.25 mul bracket_traject
300 bracket_thick arch_height add half_height arch_thick sub arch_width add
302 bracket_thick half_height arch_thick sub
321 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
325 /bracket_thick exch def
327 /bracket_height exch def
328 /arch_height exch def
332 bracket_height 2 div bracket_thick add /half_height exch def
333 bracket_thick 0.5 mul setlinewidth