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