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
 288 {
 289         setlinewidth
 290         dup 0 moveto
 291         0 exch 0 exch
 292         0 360 arc closepath stroke
 293 } bind def
 294
 295 /draw_white_dot % x1 y2 R
 296 {
 297 %       0 360 arc fill stroke
 298         0 360 arc closepath % fill stroke
 299 gsave
 300  1 setgray fill
 301 grestore
 302 %       0 360 arc closepath % fill stroke
 303   0.05 setlinewidth 0 setgray stroke
 304 } bind def
 305
 306 /draw_dashed_line % dash thickness dx dy
 307 {
 308         1 setlinecap
 309         1 setlinejoin
 310         setdash
 311         setlinewidth
 312         0 0 moveto
 313         lineto
 314         stroke
 315 } bind def
 316
 317 /draw_dashed_slur % dash thickness controls
 318 {
 319         1 setlinecap
 320         1 setlinejoin
 321         setdash
 322         setlinewidth
 323         8 -2 roll
 324         moveto
 325         curveto
 326         stroke
 327 } bind def
 328
 329
 330 % a b c d subvec  ==  a-c b-d
 331 /subvec {
 332   3 2 roll exch sub
 333   3 1 roll
 334   sub exch
 335 } bind def
 336
 337
 338 % centre? zzwidth zzheight thickness x0 y0 x1 y1
 339 /draw_zigzag_line {
 340   newpath
 341   6 dict begin
 342
 343   4 2 roll % zzuw zzh th x1 y1 x0 y0
 344   2 copy
 345   moveto
 346   subvec % zzuw zzh th dx dy
 347
 348   2 copy euclidean_length /l exch def
 349   l div /uy exch def
 350   l div /ux exch def
 351   setlinewidth
 352   /zzh exch def
 353   l exch div round /n exch def
 354   n 0 gt { %if
 355       /zzw l n 2 mul div def
 356       {
 357           uy zzh mul 2 div ux zzh mul -2 div rmoveto
 358       } if
 359       1 1 n {
 360           ux zzw mul uy zzh mul sub
 361           uy zzw mul ux zzh mul add
 362           rlineto
 363           ux zzw mul uy zzh mul add
 364           uy zzw mul ux zzh mul sub
 365           rlineto
 366       } bind for
 367   }{ %else
 368       pop
 369       ux l mul uy l mul rlineto
 370   } ifelse
 371   stroke
 372  end
 373 } bind def
 374
 375 /bracket_traject
 376 {
 377         /traject_ds exch def
 378         /traject_alpha exch def
 379         traject_ds traject_alpha sin mul add
 380         exch
 381         traject_ds traject_alpha cos mul add
 382         exch
 383 } bind def
 384
 385
 386
 387 /half_bracket
 388 {
 389 %6
 390         0 0
 391 %5a
 392         bracket_thick arch_height add half_height arch_thick sub arch_width add
 393         arch_angle arch_height -0.15 mul bracket_traject
 394 %5b
 395         bracket_thick 0.5 mul half_height
 396         0 arch_height 0.5 mul bracket_traject
 397 %5c
 398         0 half_height
 399 %4a
 400         bracket_thick half_height arch_thick sub
 401         0 arch_height 0.4 mul bracket_traject
 402 %4b
 403         bracket_thick arch_height add half_height arch_thick sub arch_width add
 404         arch_angle arch_height -0.25 mul bracket_traject
 405 %4c
 406         bracket_thick arch_height add half_height arch_thick sub arch_width add
 407 %3
 408         bracket_thick half_height arch_thick sub
 409 %2
 410         bracket_thick 0
 411 %1
 412         0 0
 413 } bind def
 414
 415 /draw_half_bracket {
 416         moveto
 417         lineto
 418         lineto
 419         curveto
 420         curveto
 421         lineto
 422         gsave
 423         fill
 424         grestore
 425 } bind def
 426
 427 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 428 {
 429         % urg
 430
 431         /bracket_thick exch def
 432         /arch_thick exch def
 433         /bracket_height exch def
 434         /arch_height exch def
 435         /arch_width exch def
 436         /arch_angle exch def
 437
 438         bracket_height 2 div bracket_thick add /half_height exch def
 439         bracket_thick 0.5 mul setlinewidth
 440         1 setlinecap
 441         1 setlinejoin
 442         half_bracket
 443         20 copy
 444         1 -1 scale
 445         draw_half_bracket
 446         stroke
 447         1 -1 scale
 448         draw_half_bracket
 449         stroke
 450 } bind def
 451
 452 %end music-drawing-routines.ps