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