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