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