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
  12
  13 % llx lly urx ury URI
  14 /mark_URI
  15 {
  16     /command exch def
  17     /ury exch def
  18     /urx exch def
  19     /lly exch def
  20     /llx exch def
  21     [
  22         /Rect [ llx lly urx ury ]
  23         /Border [ 0 0 0 0 ]
  24
  25         /Action
  26             <<
  27                 /Subtype /URI
  28                 /URI command
  29             >>
  30         /Subtype /Link
  31     /ANN
  32     pdfmark
  33 }
  34 bind def
  35
  36 /set_tex_dimen
  37 {
  38         cvr def
  39 } bind def
  40
  41
  42
  43 /euclidean_length
  44 {
  45         1 copy mul exch 1 copy mul add sqrt
  46 } bind def
  47
  48 % FIXME.  translate to middle of box.
  49 % Nice rectangle with rounded corners
  50 /draw_box % breapth width depth height
  51 {
  52 %       currentdict /testing known {
  53                 %% real thin lines for testing
  54                 /blot 0.005 def
  55 %       }{
  56 %               /blot blot-diameter def
  57 %       } ifelse
  58
  59         0 setlinecap
  60         blot setlinewidth
  61         1 setlinejoin
  62
  63         blot 2 div sub /h exch def
  64         blot 2 div sub /d exch def
  65         blot 2 div sub /w exch def
  66         blot 2 div sub /b exch def
  67
  68         b neg d neg moveto
  69         b w add 0 rlineto
  70         0 d h add rlineto
  71         b w add neg 0 rlineto
  72         0 d h add neg rlineto
  73
  74         currentdict /testing known {
  75                 %% outline only, for testing:
  76                 stroke
  77         }{
  78                 closepath gsave stroke grestore fill
  79         } ifelse
  80 } bind def
  81
  82
  83 /draw_round_box % breapth width depth height blot
  84 {
  85         /blot exch def
  86
  87         0 setlinecap
  88         blot setlinewidth
  89         1 setlinejoin
  90
  91         blot 2 div sub /h exch def
  92         blot 2 div sub /d exch def
  93         blot 2 div sub /w exch def
  94         blot 2 div sub /b exch def
  95
  96         b neg d neg moveto
  97         b w add 0 rlineto
  98         0 d h add rlineto
  99         b w add neg 0 rlineto
 100         0 d h add neg rlineto
 101
 102         currentdict /testing known {
 103                 %% outline only, for testing:
 104                 stroke
 105         }{
 106                 closepath gsave stroke grestore fill
 107         } ifelse
 108 } bind def
 109
 110 % Nice beam with rounded corners
 111 /draw_beam % slope width thick  blot
 112 {
 113         /blot exch def
 114         blot setlinewidth
 115
 116         0 setlinecap
 117         1 setlinejoin
 118
 119         blot sub /t exch def
 120         blot sub /w exch def
 121         w mul /h exch def
 122
 123         blot 2 div t 2 div neg moveto
 124         w h rlineto
 125         0 t rlineto
 126         w neg h neg rlineto
 127         0 t neg rlineto
 128
 129         currentdict /testing known {
 130                 %% outline only, for testing:
 131                 stroke
 132         }{
 133                 closepath gsave stroke grestore fill
 134         } ifelse
 135 } bind def
 136
 137 /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
 138 {
 139         /blot exch def
 140
 141         0 setlinecap
 142         blot setlinewidth
 143         1 setlinejoin
 144
 145         /points exch def
 146         2 copy
 147         moveto
 148         1 1 points {pop lineto} for
 149         currentdict /testing known {
 150                 %% outline only, for testing:
 151                 stroke
 152         }{
 153                 closepath gsave stroke grestore fill
 154         } ifelse
 155 } bind def
 156
 157 /draw_repeat_slash % width slope thick
 158 {
 159         1 setlinecap
 160         1 setlinejoin
 161
 162         /beamthick exch def
 163         /slope exch def
 164         /width exch def
 165         beamthick beamthick slope div euclidean_length
 166           /xwid exch def
 167         0 0 moveto
 168         xwid 0  rlineto
 169         width slope width mul rlineto
 170         xwid neg 0 rlineto
 171       %  width neg width angle sin mul neg rlineto
 172         closepath fill
 173 } bind def
 174
 175
 176 /draw_white_text  % text scale font
 177 {
 178   %font
 179   findfont
 180   %scale
 181   exch scalefont setfont
 182   1 setgray
 183   0 0 moveto
 184   %-0.05 -0.05 moveto
 185   % text
 186   show
 187 } bind def
 188
 189 /draw_ez_ball % ch letter_col ball_col font
 190 {
 191         % font
 192         findfont 0.7 scalefont setfont
 193         0.1 setlinewidth
 194         0 0 moveto
 195         0 setgray
 196         0.5 0 0.5 0 360 arc closepath fill stroke
 197         % ball_col
 198         1 eq {
 199                 0.01 setlinewidth
 200                 1 setgray
 201                 0.5 0 0.4 0 360 arc closepath
 202                 fill stroke
 203         } if
 204         % letter_col
 205         setgray
 206         % 0.25 is empiric centering. Change to taste
 207         0.25 -0.25 moveto
 208         % ch
 209         show
 210 } bind def
 211
 212 % Simple, but does it work everywhere?
 213 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
 214 % reverted for now -- jcn
 215 %
 216 % The filled circles are drawn by setting the linewidth
 217 % to 2*radius and drawing a point.
 218 /simple_draw_ez_ball % ch letter_col ball_col font
 219 {
 220         % font
 221         findfont 0.85 scalefont setfont
 222         /origin { 0.45 0 } def
 223         0 setgray
 224         1.1 setlinewidth
 225         origin moveto
 226         origin lineto stroke
 227         % ball_col
 228         setgray
 229         0.9 setlinewidth
 230         origin moveto
 231         origin lineto stroke
 232         % letter_col
 233         setgray
 234         % 0.25 is empiric centering. Change to taste
 235         origin moveto
 236         -0.28 -0.30 rmoveto
 237         % ch
 238         show
 239 } bind def
 240
 241 % this is for drawing slurs.
 242 /draw_bezier_sandwich  % thickness controls
 243 {
 244     % round ending and round beginning
 245     1 setlinejoin 1 setlinecap
 246         setlinewidth
 247         moveto
 248         curveto
 249         lineto
 250         curveto
 251         closepath
 252         gsave
 253         fill
 254         grestore
 255         stroke
 256 } bind def
 257
 258 /draw_dot % x1 y2 R
 259 {
 260 %       0 360 arc fill stroke
 261         0 360 arc closepath fill stroke
 262 } bind def
 263
 264 /draw_circle % R T
 265 {
 266         setlinewidth
 267         dup 0 moveto
 268         0 exch 0 exch
 269         0 360 arc closepath 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