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