1 %!PS-Adobe-1.0: music-drawing-routines.ps
3 % Functions for direct and embedded PostScript
7 {pop} {userdict /pdfmark /cleartomark load put} ifelse
10 % llx lly urx ury command
13 /editorcommand exch def
19 /Rect [ llx lly urx ury ]
40 1 copy mul exch 1 copy mul add sqrt
43 % FIXME. translate to middle of box.
44 % Nice rectangle with rounded corners
45 /draw_box % breapth width depth height
47 % currentdict /testing known {
48 %% real thin lines for testing
51 % /blot blot-diameter def
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
78 /draw_round_box % breapth width depth height blot
86 blot 2 div sub /h exch def
87 blot 2 div sub /d exch def
88 blot 2 div sub /w exch def
89 blot 2 div sub /b exch def
97 currentdict /testing known {
98 %% outline only, for testing:
101 closepath gsave stroke grestore fill
105 % Nice beam with rounded corners
106 /draw_beam % slope width thick blot
118 blot 2 div t 2 div neg moveto
124 currentdict /testing known {
125 %% outline only, for testing:
128 closepath gsave stroke grestore fill
132 /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
143 1 1 points {pop lineto} for
144 currentdict /testing known {
145 %% outline only, for testing:
148 closepath gsave stroke grestore fill
152 /draw_repeat_slash % width slope thick
160 beamthick beamthick slope div euclidean_length
164 width slope width mul rlineto
166 % width neg width angle sin mul neg rlineto
171 /draw_white_text % text scale font
176 exch scalefont setfont
184 /draw_ez_ball % ch letter_col ball_col font
187 findfont 0.7 scalefont setfont
191 0.5 0 0.5 0 360 arc closepath fill stroke
196 0.5 0 0.4 0 360 arc closepath
201 % 0.25 is empiric centering. Change to taste
207 % Simple, but does it work everywhere?
208 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
209 % reverted for now -- jcn
211 % The filled circles are drawn by setting the linewidth
212 % to 2*radius and drawing a point.
213 /simple_draw_ez_ball % ch letter_col ball_col font
216 findfont 0.85 scalefont setfont
217 /origin { 0.45 0 } def
229 % 0.25 is empiric centering. Change to taste
236 % this is for drawing slurs.
237 /draw_bezier_sandwich % thickness controls
239 % round ending and round beginning
240 1 setlinejoin 1 setlinecap
255 % 0 360 arc fill stroke
256 0 360 arc closepath fill stroke
259 /draw_white_dot % x1 y2 R
261 % 0 360 arc fill stroke
262 0 360 arc closepath % fill stroke
266 % 0 360 arc closepath % fill stroke
267 0.05 setlinewidth 0 setgray stroke
270 /draw_dashed_line % dash thickness dx dy
281 /draw_dashed_slur % dash thickness controls
294 % a b c d subvec == a-c b-d
302 % centre? zzwidth zzheight thickness x0 y0 x1 y1
307 4 2 roll % zzuw zzh th x1 y1 x0 y0
310 subvec % zzuw zzh th dx dy
312 2 copy euclidean_length /l exch def
317 l exch div round /n exch def
319 /zzw l n 2 mul div def
321 uy zzh mul 2 div ux zzh mul -2 div rmoveto
324 ux zzw mul uy zzh mul sub
325 uy zzw mul ux zzh mul add
327 ux zzw mul uy zzh mul add
328 uy zzw mul ux zzh mul sub
333 ux l mul uy l mul rlineto
342 /traject_alpha exch def
343 traject_ds traject_alpha sin mul add
345 traject_ds traject_alpha cos mul add
356 bracket_thick arch_height add half_height arch_thick sub arch_width add
357 arch_angle arch_height -0.15 mul bracket_traject
359 bracket_thick 0.5 mul half_height
360 0 arch_height 0.5 mul bracket_traject
364 bracket_thick half_height arch_thick sub
365 0 arch_height 0.4 mul bracket_traject
367 bracket_thick arch_height add half_height arch_thick sub arch_width add
368 arch_angle arch_height -0.25 mul bracket_traject
370 bracket_thick arch_height add half_height arch_thick sub arch_width add
372 bracket_thick half_height arch_thick sub
391 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
395 /bracket_thick exch def
397 /bracket_height exch def
398 /arch_height exch def
402 bracket_height 2 div bracket_thick add /half_height exch def
403 bracket_thick 0.5 mul setlinewidth
416 %end music-drawing-routines.ps