1 %!PS-Adobe-1.0: music-drawing-routines.ps
3 % Functions for direct and embedded PostScript
5 /blot-diameter { lilypondpaperblotdiameter } bind def
7 % fucking redhat xdvi patch.
8 /skeel { scale } bind def
16 1 copy mul exch 1 copy mul add sqrt
19 % FIXME. translate to middle of box.
20 % Nice rectangle with rounded corners
21 /draw_box % breapth width depth height
23 currentdict /testing known {
24 %% real thin lines for testing
27 /blot blot-diameter def
34 blot 2 div sub /h exch def
35 blot 2 div sub /d exch def
36 blot 2 div sub /w exch def
37 blot 2 div sub /b exch def
45 currentdict /testing known {
46 %% outline only, for testing:
49 closepath gsave stroke grestore fill
53 /draw_round_box % breapth width depth height blot
61 blot 2 div sub /h exch def
62 blot 2 div sub /d exch def
63 blot 2 div sub /w exch def
64 blot 2 div sub /b exch def
72 currentdict /testing known {
73 %% outline only, for testing:
76 closepath gsave stroke grestore fill
80 % Nice beam with rounded corners
81 /draw_beam % slope width thick
83 currentdict /testing known {
84 %% real thin lines for testing
87 /blot blot-diameter def
98 blot 2 div t 2 div neg moveto
104 currentdict /testing known {
105 %% outline only, for testing:
108 closepath gsave stroke grestore fill
112 /draw_repeat_slash % width slope thick
120 beamthick beamthick slope div euclidean_length
124 width slope width mul rlineto
126 % width neg width angle sin mul neg rlineto
131 /draw_ez_ball % ch letter_col ball_col font
134 findfont 0.7 scalefont setfont
138 0.5 0 0.5 0 360 arc closepath fill stroke
143 0.5 0 0.4 0 360 arc closepath
148 % 0.25 is empiric centering. Change to taste
154 % Simple, but does it work everywhere?
155 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
156 % reverted for now -- jcn
158 % The filled circles are drawn by setting the linewidth
159 % to 2*radius and drawing a point.
160 /simple_draw_ez_ball % ch letter_col ball_col font
163 findfont 0.85 scalefont setfont
164 /origin { 0.45 0 } def
176 % 0.25 is empiric centering. Change to taste
183 % this is for drawing slurs.
184 /draw_bezier_sandwich % thickness controls
199 % 0 360 arc fill stroke
200 0 360 arc closepath fill stroke
203 /draw_dashed_line % dash thickness dx dy
214 /draw_dashed_slur % dash thickness controls
227 % a b c d subvec == a-c b-d
235 % centre? zzwidth zzheight thickness x0 y0 x1 y1
240 4 2 roll % zzuw zzh th x1 y1 x0 y0
243 subvec % zzuw zzh th dx dy
245 2 copy euclidean_length /l exch def
250 l exch div round /n exch def
252 /zzw l n 2 mul div def
254 uy zzh mul 2 div ux zzh mul -2 div rmoveto
257 ux zzw mul uy zzh mul sub
258 uy zzw mul ux zzh mul add
260 ux zzw mul uy zzh mul add
261 uy zzw mul ux zzh mul sub
266 ux l mul uy l mul rlineto
275 /traject_alpha exch def
276 traject_ds traject_alpha sin mul add
278 traject_ds traject_alpha cos mul add
289 bracket_thick arch_height add half_height arch_thick sub arch_width add
290 arch_angle arch_height -0.15 mul bracket_traject
292 bracket_thick 0.5 mul half_height
293 0 arch_height 0.5 mul bracket_traject
297 bracket_thick half_height arch_thick sub
298 0 arch_height 0.4 mul bracket_traject
300 bracket_thick arch_height add half_height arch_thick sub arch_width add
301 arch_angle arch_height -0.25 mul bracket_traject
303 bracket_thick arch_height add half_height arch_thick sub arch_width add
305 bracket_thick half_height arch_thick sub
324 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
328 /bracket_thick exch def
330 /bracket_height exch def
331 /arch_height exch def
335 bracket_height 2 div bracket_thick add /half_height exch def
336 bracket_thick 0.5 mul setlinewidth