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
19 /Rect [ llx lly urx ury ]
22 pdf-viewer (acroread) eq
31 % xpdf. FIXME: gpdf, kpdf etc?
53 1 copy mul exch 1 copy mul add sqrt
56 % FIXME. translate to middle of box.
57 % Nice rectangle with rounded corners
58 /draw_box % breapth width depth height
60 % currentdict /testing known {
61 %% real thin lines for testing
64 % /blot blot-diameter def
71 blot 2 div sub /h exch def
72 blot 2 div sub /d exch def
73 blot 2 div sub /w exch def
74 blot 2 div sub /b exch def
82 currentdict /testing known {
83 %% outline only, for testing:
86 closepath gsave stroke grestore fill
91 /draw_round_box % breapth width depth height blot
99 blot 2 div sub /h exch def
100 blot 2 div sub /d exch def
101 blot 2 div sub /w exch def
102 blot 2 div sub /b exch def
107 b w add neg 0 rlineto
108 0 d h add neg rlineto
110 currentdict /testing known {
111 %% outline only, for testing:
114 closepath gsave stroke grestore fill
118 % Nice beam with rounded corners
119 /draw_beam % slope width thick blot
131 blot 2 div t 2 div neg moveto
137 currentdict /testing known {
138 %% outline only, for testing:
141 closepath gsave stroke grestore fill
145 /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
156 1 1 points {pop lineto} for
157 currentdict /testing known {
158 %% outline only, for testing:
161 closepath gsave stroke grestore fill
165 /draw_repeat_slash % width slope thick
173 beamthick beamthick slope div euclidean_length
177 width slope width mul rlineto
179 % width neg width angle sin mul neg rlineto
184 /draw_white_text % text scale font
189 exch scalefont setfont
197 /draw_ez_ball % ch letter_col ball_col font
200 findfont 0.7 scalefont setfont
204 0.5 0 0.5 0 360 arc closepath fill stroke
209 0.5 0 0.4 0 360 arc closepath
214 % 0.25 is empiric centering. Change to taste
220 % Simple, but does it work everywhere?
221 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
222 % reverted for now -- jcn
224 % The filled circles are drawn by setting the linewidth
225 % to 2*radius and drawing a point.
226 /simple_draw_ez_ball % ch letter_col ball_col font
229 findfont 0.85 scalefont setfont
230 /origin { 0.45 0 } def
242 % 0.25 is empiric centering. Change to taste
249 % this is for drawing slurs.
250 /draw_bezier_sandwich % thickness controls
252 % round ending and round beginning
253 1 setlinejoin 1 setlinecap
268 % 0 360 arc fill stroke
269 0 360 arc closepath fill stroke
272 /draw_white_dot % x1 y2 R
274 % 0 360 arc fill stroke
275 0 360 arc closepath % fill stroke
279 % 0 360 arc closepath % fill stroke
280 0.05 setlinewidth 0 setgray stroke
283 /draw_dashed_line % dash thickness dx dy
294 /draw_dashed_slur % dash thickness controls
307 % a b c d subvec == a-c b-d
315 % centre? zzwidth zzheight thickness x0 y0 x1 y1
320 4 2 roll % zzuw zzh th x1 y1 x0 y0
323 subvec % zzuw zzh th dx dy
325 2 copy euclidean_length /l exch def
330 l exch div round /n exch def
332 /zzw l n 2 mul div def
334 uy zzh mul 2 div ux zzh mul -2 div rmoveto
337 ux zzw mul uy zzh mul sub
338 uy zzw mul ux zzh mul add
340 ux zzw mul uy zzh mul add
341 uy zzw mul ux zzh mul sub
346 ux l mul uy l mul rlineto
355 /traject_alpha exch def
356 traject_ds traject_alpha sin mul add
358 traject_ds traject_alpha cos mul add
369 bracket_thick arch_height add half_height arch_thick sub arch_width add
370 arch_angle arch_height -0.15 mul bracket_traject
372 bracket_thick 0.5 mul half_height
373 0 arch_height 0.5 mul bracket_traject
377 bracket_thick half_height arch_thick sub
378 0 arch_height 0.4 mul bracket_traject
380 bracket_thick arch_height add half_height arch_thick sub arch_width add
381 arch_angle arch_height -0.25 mul bracket_traject
383 bracket_thick arch_height add half_height arch_thick sub arch_width add
385 bracket_thick half_height arch_thick sub
404 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
408 /bracket_thick exch def
410 /bracket_height exch def
411 /arch_height exch def
415 bracket_height 2 div bracket_thick add /half_height exch def
416 bracket_thick 0.5 mul setlinewidth
429 %end music-drawing-routines.ps