1 %!PS-Adobe-1.0: music-drawing-routines.ps
3 % Functions for direct and embedded PostScript
6 %% TODO: use dicts or prefixes to prevent namespace pollution.
9 {pop} {userdict /pdfmark /cleartomark load put} ifelse
11 % from adobe tech note 5002.
13 /b4_Inc_state save def % Save state for cleanup
14 /dict_count countdictstack def % Count objects on dict stack
15 /op_count count 1 sub def % Count objects on operand stack
16 userdict begin % Push userdict on dict stack
17 /showpage { } def % Redefine showpage, { } = null proc
18 0 setgray 0 setlinecap % Prepare graphics state
19 1 setlinewidth 0 setlinejoin
20 10 setmiterlimit [ ] 0 setdash newpath
21 /languagelevel where % If level not equal to 1 then
22 {pop languagelevel % set strokeadjust and
23 1 ne % overprint to their defaults.
24 {false setstrokeadjust false setoverprint
31 count op_count sub {pop} repeat % Clean up stacks
32 countdictstack dict_count sub {end} repeat
45 /Rect [ llx lly urx ury ]
68 1 copy mul exch 1 copy mul add sqrt
71 % FIXME. translate to middle of box.
72 % Nice rectangle with rounded corners
73 /draw_box % breapth width depth height
75 % currentdict /testing known {
76 %% real thin lines for testing
79 % /blot blot-diameter def
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
106 /draw_round_box % breapth width depth height blot
114 blot 2 div sub /h exch def
115 blot 2 div sub /d exch def
116 blot 2 div sub /w exch def
117 blot 2 div sub /b exch def
122 b w add neg 0 rlineto
123 0 d h add neg rlineto
125 currentdict /testing known {
126 %% outline only, for testing:
129 closepath gsave stroke grestore fill
133 % Nice beam with rounded corners
134 /draw_beam % slope width thick blot
146 blot 2 div t 2 div neg moveto
152 currentdict /testing known {
153 %% outline only, for testing:
156 closepath gsave stroke grestore fill
160 /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
171 1 1 points {pop lineto} for
172 currentdict /testing known {
173 %% outline only, for testing:
176 closepath gsave stroke grestore fill
180 /draw_repeat_slash % width slope thick
188 beamthick beamthick slope div euclidean_length
192 width slope width mul rlineto
194 % width neg width angle sin mul neg rlineto
199 /draw_white_text % text scale font
204 exch scalefont setfont
212 /draw_ez_ball % ch letter_col ball_col font
215 findfont 0.7 scalefont setfont
219 0.5 0 0.5 0 360 arc closepath fill stroke
224 0.5 0 0.4 0 360 arc closepath
229 % 0.25 is empiric centering. Change to taste
235 % Simple, but does it work everywhere?
236 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
237 % reverted for now -- jcn
239 % The filled circles are drawn by setting the linewidth
240 % to 2*radius and drawing a point.
241 /simple_draw_ez_ball % ch letter_col ball_col font
244 findfont 0.85 scalefont setfont
245 /origin { 0.45 0 } def
257 % 0.25 is empiric centering. Change to taste
264 % this is for drawing slurs.
265 /draw_bezier_sandwich % thickness controls
267 % round ending and round beginning
268 1 setlinejoin 1 setlinecap
283 % 0 360 arc fill stroke
284 0 360 arc closepath fill stroke
292 0 360 arc closepath stroke
295 /draw_white_dot % x1 y2 R
297 % 0 360 arc fill stroke
298 0 360 arc closepath % fill stroke
302 % 0 360 arc closepath % fill stroke
303 0.05 setlinewidth 0 setgray stroke
306 /draw_dashed_line % dash thickness dx dy
317 /draw_dashed_slur % dash thickness controls
330 % a b c d subvec == a-c b-d
338 % centre? zzwidth zzheight thickness x0 y0 x1 y1
343 4 2 roll % zzuw zzh th x1 y1 x0 y0
346 subvec % zzuw zzh th dx dy
348 2 copy euclidean_length /l exch def
353 l exch div round /n exch def
355 /zzw l n 2 mul div def
357 uy zzh mul 2 div ux zzh mul -2 div rmoveto
360 ux zzw mul uy zzh mul sub
361 uy zzw mul ux zzh mul add
363 ux zzw mul uy zzh mul add
364 uy zzw mul ux zzh mul sub
369 ux l mul uy l mul rlineto
378 /traject_alpha exch def
379 traject_ds traject_alpha sin mul add
381 traject_ds traject_alpha cos mul add
392 bracket_thick arch_height add half_height arch_thick sub arch_width add
393 arch_angle arch_height -0.15 mul bracket_traject
395 bracket_thick 0.5 mul half_height
396 0 arch_height 0.5 mul bracket_traject
400 bracket_thick half_height arch_thick sub
401 0 arch_height 0.4 mul bracket_traject
403 bracket_thick arch_height add half_height arch_thick sub arch_width add
404 arch_angle arch_height -0.25 mul bracket_traject
406 bracket_thick arch_height add half_height arch_thick sub arch_width add
408 bracket_thick half_height arch_thick sub
427 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
431 /bracket_thick exch def
433 /bracket_height exch def
434 /arch_height exch def
438 bracket_height 2 div bracket_thick add /half_height exch def
439 bracket_thick 0.5 mul setlinewidth
452 %end music-drawing-routines.ps