ps/music-drawing-routines.ps

   1 %!PS-Adobe-1.0: music-drawing-routines.ps
   2 %
   3 % Functions for direct and embedded PostScript
   4
   5
   6 /pdfmark where
   7 {pop} {userdict /pdfmark /cleartomark load put} ifelse
   8
   9
  10 % llx lly urx ury command
  11 /mark_file_line
  12 {
  13     /command exch def
  14     /ury exch def
  15     /urx exch def
  16     /lly exch def
  17     /llx exch def
  18     [
  19         /Rect [ llx lly urx ury ]
  20         /Border [ 0 0 0 0 ]
  21 %       /Action /Launch
  22 %       /File command
  23         /Action <<
  24             /Subtype /URI
  25             /URI command
  26         >>
  27
  28         /Subtype /Link
  29     /ANN
  30     pdfmark
  31 }
  32 bind def
  33
  34 /set_tex_dimen {
  35         cvr def
  36 } bind def
  37
  38
  39
  40 /euclidean_length
  41 {
  42         1 copy mul exch 1 copy mul add sqrt
  43 } bind def
  44
  45 % FIXME.  translate to middle of box.
  46 % Nice rectangle with rounded corners
  47 /draw_box % breapth width depth height
  48 {
  49 %       currentdict /testing known {
  50                 %% real thin lines for testing
  51                 /blot 0.005 def
  52 %       }{
  53 %               /blot blot-diameter def
  54 %       } ifelse
  55
  56         0 setlinecap
  57         blot setlinewidth
  58         1 setlinejoin
  59
  60         blot 2 div sub /h exch def
  61         blot 2 div sub /d exch def
  62         blot 2 div sub /w exch def
  63         blot 2 div sub /b exch def
  64
  65         b neg d neg moveto
  66         b w add 0 rlineto
  67         0 d h add rlineto
  68         b w add neg 0 rlineto
  69         0 d h add neg rlineto
  70
  71         currentdict /testing known {
  72                 %% outline only, for testing:
  73                 stroke
  74         }{
  75                 closepath gsave stroke grestore fill
  76         } ifelse
  77 } bind def
  78
  79
  80 /draw_round_box % breapth width depth height blot
  81 {
  82         /blot exch def
  83
  84         0 setlinecap
  85         blot setlinewidth
  86         1 setlinejoin
  87
  88         blot 2 div sub /h exch def
  89         blot 2 div sub /d exch def
  90         blot 2 div sub /w exch def
  91         blot 2 div sub /b exch def
  92
  93         b neg d neg moveto
  94         b w add 0 rlineto
  95         0 d h add rlineto
  96         b w add neg 0 rlineto
  97         0 d h add neg rlineto
  98
  99         currentdict /testing known {
 100                 %% outline only, for testing:
 101                 stroke
 102         }{
 103                 closepath gsave stroke grestore fill
 104         } ifelse
 105 } bind def
 106
 107 % Nice beam with rounded corners
 108 /draw_beam % slope width thick  blot
 109 {
 110         /blot exch def
 111         blot setlinewidth
 112
 113         0 setlinecap
 114         1 setlinejoin
 115
 116         blot sub /t exch def
 117         blot sub /w exch def
 118         w mul /h exch def
 119
 120         blot 2 div t 2 div neg moveto
 121         w h rlineto
 122         0 t rlineto
 123         w neg h neg rlineto
 124         0 t neg rlineto
 125
 126         currentdict /testing known {
 127                 %% outline only, for testing:
 128                 stroke
 129         }{
 130                 closepath gsave stroke grestore fill
 131         } ifelse
 132 } bind def
 133
 134 /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
 135 {
 136         /blot exch def
 137
 138         0 setlinecap
 139         blot setlinewidth
 140         1 setlinejoin
 141
 142         /points exch def
 143         2 copy
 144         moveto
 145         1 1 points {pop lineto} for
 146         currentdict /testing known {
 147                 %% outline only, for testing:
 148                 stroke
 149         }{
 150                 closepath gsave stroke grestore fill
 151         } ifelse
 152 } bind def
 153
 154 /draw_repeat_slash % width slope thick
 155 {
 156         1 setlinecap
 157         1 setlinejoin
 158
 159         /beamthick exch def
 160         /slope exch def
 161         /width exch def
 162         beamthick beamthick slope div euclidean_length
 163           /xwid exch def
 164         0 0 moveto
 165         xwid 0  rlineto
 166         width slope width mul rlineto
 167         xwid neg 0 rlineto
 168       %  width neg width angle sin mul neg rlineto
 169         closepath fill
 170 } bind def
 171
 172
 173 /draw_white_text  % text scale font
 174 {
 175   %font
 176   findfont
 177   %scale
 178   exch scalefont setfont
 179   1 setgray
 180   0 0 moveto
 181   %-0.05 -0.05 moveto
 182   % text
 183   show
 184 } bind def
 185
 186 /draw_ez_ball % ch letter_col ball_col font
 187 {
 188         % font
 189         findfont 0.7 scalefont setfont
 190         0.1 setlinewidth
 191         0 0 moveto
 192         0 setgray
 193         0.5 0 0.5 0 360 arc closepath fill stroke
 194         % ball_col
 195         1 eq {
 196                 0.01 setlinewidth
 197                 1 setgray
 198                 0.5 0 0.4 0 360 arc closepath
 199                 fill stroke
 200         } if
 201         % letter_col
 202         setgray
 203         % 0.25 is empiric centering. Change to taste
 204         0.25 -0.25 moveto
 205         % ch
 206         show
 207 } bind def
 208
 209 % Simple, but does it work everywhere?
 210 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
 211 % reverted for now -- jcn
 212 %
 213 % The filled circles are drawn by setting the linewidth
 214 % to 2*radius and drawing a point.
 215 /simple_draw_ez_ball % ch letter_col ball_col font
 216 {
 217         % font
 218         findfont 0.85 scalefont setfont
 219         /origin { 0.45 0 } def
 220         0 setgray
 221         1.1 setlinewidth
 222         origin moveto
 223         origin lineto stroke
 224         % ball_col
 225         setgray
 226         0.9 setlinewidth
 227         origin moveto
 228         origin lineto stroke
 229         % letter_col
 230         setgray
 231         % 0.25 is empiric centering. Change to taste
 232         origin moveto
 233         -0.28 -0.30 rmoveto
 234         % ch
 235         show
 236 } bind def
 237
 238 % this is for drawing slurs.
 239 /draw_bezier_sandwich  % thickness controls
 240 {
 241     % round ending and round beginning
 242     1 setlinejoin 1 setlinecap
 243         setlinewidth
 244         moveto
 245         curveto
 246         lineto
 247         curveto
 248         closepath
 249         gsave
 250         fill
 251         grestore
 252         stroke
 253 } bind def
 254
 255 /draw_dot % x1 y2 R
 256 {
 257 %       0 360 arc fill stroke
 258         0 360 arc closepath fill stroke
 259 } bind def
 260
 261 /draw_white_dot % x1 y2 R
 262 {
 263 %       0 360 arc fill stroke
 264         0 360 arc closepath % fill stroke
 265 gsave
 266  1 setgray fill
 267 grestore
 268 %       0 360 arc closepath % fill stroke
 269   0.05 setlinewidth 0 setgray stroke
 270 } bind def
 271
 272 /draw_dashed_line % dash thickness dx dy
 273 {
 274         1 setlinecap
 275         1 setlinejoin
 276         setdash
 277         setlinewidth
 278         0 0 moveto
 279         lineto
 280         stroke
 281 } bind def
 282
 283 /draw_dashed_slur % dash thickness controls
 284 {
 285         1 setlinecap
 286         1 setlinejoin
 287         setdash
 288         setlinewidth
 289         8 -2 roll
 290         moveto
 291         curveto
 292         stroke
 293 } bind def
 294
 295
 296 % a b c d subvec  ==  a-c b-d
 297 /subvec {
 298   3 2 roll exch sub
 299   3 1 roll
 300   sub exch
 301 } bind def
 302
 303
 304 % centre? zzwidth zzheight thickness x0 y0 x1 y1
 305 /draw_zigzag_line {
 306   newpath
 307   6 dict begin
 308
 309   4 2 roll % zzuw zzh th x1 y1 x0 y0
 310   2 copy
 311   moveto
 312   subvec % zzuw zzh th dx dy
 313
 314   2 copy euclidean_length /l exch def
 315   l div /uy exch def
 316   l div /ux exch def
 317   setlinewidth
 318   /zzh exch def
 319   l exch div round /n exch def
 320   n 0 gt { %if
 321       /zzw l n 2 mul div def
 322       {
 323           uy zzh mul 2 div ux zzh mul -2 div rmoveto
 324       } if
 325       1 1 n {
 326           ux zzw mul uy zzh mul sub
 327           uy zzw mul ux zzh mul add
 328           rlineto
 329           ux zzw mul uy zzh mul add
 330           uy zzw mul ux zzh mul sub
 331           rlineto
 332       } bind for
 333   }{ %else
 334       pop
 335       ux l mul uy l mul rlineto
 336   } ifelse
 337   stroke
 338  end
 339 } bind def
 340
 341 /bracket_traject
 342 {
 343         /traject_ds exch def
 344         /traject_alpha exch def
 345         traject_ds traject_alpha sin mul add
 346         exch
 347         traject_ds traject_alpha cos mul add
 348         exch
 349 } bind def
 350
 351
 352
 353 /half_bracket
 354 {
 355 %6
 356         0 0
 357 %5a
 358         bracket_thick arch_height add half_height arch_thick sub arch_width add
 359         arch_angle arch_height -0.15 mul bracket_traject
 360 %5b
 361         bracket_thick 0.5 mul half_height
 362         0 arch_height 0.5 mul bracket_traject
 363 %5c
 364         0 half_height
 365 %4a
 366         bracket_thick half_height arch_thick sub
 367         0 arch_height 0.4 mul bracket_traject
 368 %4b
 369         bracket_thick arch_height add half_height arch_thick sub arch_width add
 370         arch_angle arch_height -0.25 mul bracket_traject
 371 %4c
 372         bracket_thick arch_height add half_height arch_thick sub arch_width add
 373 %3
 374         bracket_thick half_height arch_thick sub
 375 %2
 376         bracket_thick 0
 377 %1
 378         0 0
 379 } bind def
 380
 381 /draw_half_bracket {
 382         moveto
 383         lineto
 384         lineto
 385         curveto
 386         curveto
 387         lineto
 388         gsave
 389         fill
 390         grestore
 391 } bind def
 392
 393 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 394 {
 395         % urg
 396
 397         /bracket_thick exch def
 398         /arch_thick exch def
 399         /bracket_height exch def
 400         /arch_height exch def
 401         /arch_width exch def
 402         /arch_angle exch def
 403
 404         bracket_height 2 div bracket_thick add /half_height exch def
 405         bracket_thick 0.5 mul setlinewidth
 406         1 setlinecap
 407         1 setlinejoin
 408         half_bracket
 409         20 copy
 410         1 -1 scale
 411         draw_half_bracket
 412         stroke
 413         1 -1 scale
 414         draw_half_bracket
 415         stroke
 416 } bind def
 417
 418 %end music-drawing-routines.ps