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 fill
 161 {
 162         /fillp exch def
 163         /blot exch def
 164
 165         0 setlinecap
 166         blot setlinewidth
 167         1 setlinejoin
 168
 169         /points exch def
 170         2 copy
 171         moveto
 172         1 1 points { pop lineto } for
 173         closepath
 174         fillp {
 175                 gsave stroke grestore fill
 176         }{
 177                 stroke
 178         } ifelse
 179 } bind def
 180
 181 /draw_repeat_slash % width slope thick
 182 {
 183         1 setlinecap
 184         1 setlinejoin
 185
 186         /beamthick exch def
 187         /slope exch def
 188         /width exch def
 189         beamthick beamthick slope div euclidean_length
 190           /xwid exch def
 191         0 0 moveto
 192         xwid 0  rlineto
 193         width slope width mul rlineto
 194         xwid neg 0 rlineto
 195       %  width neg width angle sin mul neg rlineto
 196         closepath fill
 197 } bind def
 198
 199
 200 /draw_white_text  % text scale font
 201 {
 202   %font
 203   findfont
 204   %scale
 205   exch scalefont setfont
 206   1 setgray
 207   0 0 moveto
 208   %-0.05 -0.05 moveto
 209   % text
 210   show
 211 } bind def
 212
 213 /draw_ez_ball % ch letter_col ball_col font
 214 {
 215         % font
 216         findfont 0.7 scalefont setfont
 217         0.1 setlinewidth
 218         0 0 moveto
 219         0 setgray
 220         0.5 0 0.5 0 360 arc closepath fill stroke
 221         % ball_col
 222         1 eq {
 223                 0.01 setlinewidth
 224                 1 setgray
 225                 0.5 0 0.4 0 360 arc closepath
 226                 fill stroke
 227         } if
 228         % letter_col
 229         setgray
 230         % 0.25 is empiric centering. Change to taste
 231         0.25 -0.25 moveto
 232         % ch
 233         show
 234 } bind def
 235
 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
 239 %
 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
 243 {
 244         % font
 245         findfont 0.85 scalefont setfont
 246         /origin { 0.45 0 } def
 247         0 setgray
 248         1.1 setlinewidth
 249         origin moveto
 250         origin lineto stroke
 251         % ball_col
 252         setgray
 253         0.9 setlinewidth
 254         origin moveto
 255         origin lineto stroke
 256         % letter_col
 257         setgray
 258         % 0.25 is empiric centering. Change to taste
 259         origin moveto
 260         -0.28 -0.30 rmoveto
 261         % ch
 262         show
 263 } bind def
 264
 265 % this is for drawing slurs.
 266 /draw_bezier_sandwich  % thickness controls
 267 {
 268     % round ending and round beginning
 269     1 setlinejoin 1 setlinecap
 270         setlinewidth
 271         moveto
 272         curveto
 273         lineto
 274         curveto
 275         closepath
 276         gsave
 277         fill
 278         grestore
 279         stroke
 280 } bind def
 281
 282 /draw_dot % x1 y2 R
 283 {
 284 %       0 360 arc fill stroke
 285         0 360 arc closepath fill stroke
 286 } bind def
 287
 288 /draw_circle % R T F
 289 {
 290         /filled exch def
 291         setlinewidth
 292         dup 0 moveto
 293         0 exch 0 exch
 294         0 360 arc closepath
 295         gsave stroke grestore
 296         filled { fill } if
 297 } bind def
 298
 299 /draw_white_dot % x1 y2 R
 300 {
 301 %       0 360 arc fill stroke
 302         0 360 arc closepath % fill stroke
 303 gsave
 304  1 setgray fill
 305 grestore
 306 %       0 360 arc closepath % fill stroke
 307   0.05 setlinewidth 0 setgray stroke
 308 } bind def
 309
 310 /draw_dashed_line % dash thickness dx dy
 311 {
 312         1 setlinecap
 313         1 setlinejoin
 314         setdash
 315         setlinewidth
 316         0 0 moveto
 317         lineto
 318         stroke
 319 } bind def
 320
 321 /draw_dashed_slur % dash thickness controls
 322 {
 323         1 setlinecap
 324         1 setlinejoin
 325         setdash
 326         setlinewidth
 327         8 -2 roll
 328         moveto
 329         curveto
 330         stroke
 331 } bind def
 332
 333
 334 % a b c d subvec  ==  a-c b-d
 335 /subvec {
 336   3 2 roll exch sub
 337   3 1 roll
 338   sub exch
 339 } bind def
 340
 341
 342 % centre? zzwidth zzheight thickness x0 y0 x1 y1
 343 /draw_zigzag_line {
 344   newpath
 345   6 dict begin
 346
 347   4 2 roll % zzuw zzh th x1 y1 x0 y0
 348   2 copy
 349   moveto
 350   subvec % zzuw zzh th dx dy
 351
 352   2 copy euclidean_length /l exch def
 353   l div /uy exch def
 354   l div /ux exch def
 355   setlinewidth
 356   /zzh exch def
 357   l exch div round /n exch def
 358   n 0 gt { %if
 359       /zzw l n 2 mul div def
 360       {
 361           uy zzh mul 2 div ux zzh mul -2 div rmoveto
 362       } if
 363       1 1 n {
 364           ux zzw mul uy zzh mul sub
 365           uy zzw mul ux zzh mul add
 366           rlineto
 367           ux zzw mul uy zzh mul add
 368           uy zzw mul ux zzh mul sub
 369           rlineto
 370       } bind for
 371   }{ %else
 372       pop
 373       ux l mul uy l mul rlineto
 374   } ifelse
 375   stroke
 376  end
 377 } bind def
 378
 379 /bracket_traject
 380 {
 381         /traject_ds exch def
 382         /traject_alpha exch def
 383         traject_ds traject_alpha sin mul add
 384         exch
 385         traject_ds traject_alpha cos mul add
 386         exch
 387 } bind def
 388
 389
 390
 391 /half_bracket
 392 {
 393 %6
 394         0 0
 395 %5a
 396         bracket_thick arch_height add half_height arch_thick sub arch_width add
 397         arch_angle arch_height -0.15 mul bracket_traject
 398 %5b
 399         bracket_thick 0.5 mul half_height
 400         0 arch_height 0.5 mul bracket_traject
 401 %5c
 402         0 half_height
 403 %4a
 404         bracket_thick half_height arch_thick sub
 405         0 arch_height 0.4 mul bracket_traject
 406 %4b
 407         bracket_thick arch_height add half_height arch_thick sub arch_width add
 408         arch_angle arch_height -0.25 mul bracket_traject
 409 %4c
 410         bracket_thick arch_height add half_height arch_thick sub arch_width add
 411 %3
 412         bracket_thick half_height arch_thick sub
 413 %2
 414         bracket_thick 0
 415 %1
 416         0 0
 417 } bind def
 418
 419 /draw_half_bracket {
 420         moveto
 421         lineto
 422         lineto
 423         curveto
 424         curveto
 425         lineto
 426         gsave
 427         fill
 428         grestore
 429 } bind def
 430
 431 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 432 {
 433         % urg
 434
 435         /bracket_thick exch def
 436         /arch_thick exch def
 437         /bracket_height exch def
 438         /arch_height exch def
 439         /arch_width exch def
 440         /arch_angle exch def
 441
 442         bracket_height 2 div bracket_thick add /half_height exch def
 443         bracket_thick 0.5 mul setlinewidth
 444         1 setlinecap
 445         1 setlinejoin
 446         half_bracket
 447         20 copy
 448         1 -1 scale
 449         draw_half_bracket
 450         stroke
 451         1 -1 scale
 452         draw_half_bracket
 453         stroke
 454 } bind def
 455
 456 %end music-drawing-routines.ps