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 fill
172 1 1 points { pop lineto } for
175 gsave stroke grestore fill
181 /draw_repeat_slash % width slope thick
189 beamthick beamthick slope div euclidean_length
193 width slope width mul rlineto
195 % width neg width angle sin mul neg rlineto
200 /draw_white_text % text scale font
205 exch scalefont setfont
213 /draw_ez_ball % ch letter_col ball_col font
216 findfont 0.7 scalefont setfont
220 0.5 0 0.5 0 360 arc closepath fill stroke
225 0.5 0 0.4 0 360 arc closepath
230 % 0.25 is empiric centering. Change to taste
236 % Simple, but does it work everywhere?
237 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
238 % reverted for now -- jcn
240 % The filled circles are drawn by setting the linewidth
241 % to 2*radius and drawing a point.
242 /simple_draw_ez_ball % ch letter_col ball_col font
245 findfont 0.85 scalefont setfont
246 /origin { 0.45 0 } def
258 % 0.25 is empiric centering. Change to taste
265 % this is for drawing slurs.
266 /draw_bezier_sandwich % thickness controls
268 % round ending and round beginning
269 1 setlinejoin 1 setlinecap
284 % 0 360 arc fill stroke
285 0 360 arc closepath fill stroke
295 gsave stroke grestore
299 /draw_white_dot % x1 y2 R
301 % 0 360 arc fill stroke
302 0 360 arc closepath % fill stroke
306 % 0 360 arc closepath % fill stroke
307 0.05 setlinewidth 0 setgray stroke
310 /draw_dashed_line % dash thickness dx dy
321 /draw_dashed_slur % dash thickness controls
334 % a b c d subvec == a-c b-d
342 % centre? zzwidth zzheight thickness x0 y0 x1 y1
347 4 2 roll % zzuw zzh th x1 y1 x0 y0
350 subvec % zzuw zzh th dx dy
352 2 copy euclidean_length /l exch def
357 l exch div round /n exch def
359 /zzw l n 2 mul div def
361 uy zzh mul 2 div ux zzh mul -2 div rmoveto
364 ux zzw mul uy zzh mul sub
365 uy zzw mul ux zzh mul add
367 ux zzw mul uy zzh mul add
368 uy zzw mul ux zzh mul sub
373 ux l mul uy l mul rlineto
382 /traject_alpha exch def
383 traject_ds traject_alpha sin mul add
385 traject_ds traject_alpha cos mul add
396 bracket_thick arch_height add half_height arch_thick sub arch_width add
397 arch_angle arch_height -0.15 mul bracket_traject
399 bracket_thick 0.5 mul half_height
400 0 arch_height 0.5 mul bracket_traject
404 bracket_thick half_height arch_thick sub
405 0 arch_height 0.4 mul bracket_traject
407 bracket_thick arch_height add half_height arch_thick sub arch_width add
408 arch_angle arch_height -0.25 mul bracket_traject
410 bracket_thick arch_height add half_height arch_thick sub arch_width add
412 bracket_thick half_height arch_thick sub
431 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
435 /bracket_thick exch def
437 /bracket_height exch def
438 /arch_height exch def
442 bracket_height 2 div bracket_thick add /half_height exch def
443 bracket_thick 0.5 mul setlinewidth
456 %end music-drawing-routines.ps