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