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 font
 157 {
 158   %font
 159   findfont 0.8 scalefont setfont
 160   1 setgray
 161   0 0 moveto
 162   % text
 163   show
 164 } bind def
 165
 166 /draw_ez_ball % ch letter_col ball_col font
 167 {
 168         % font
 169         findfont 0.7 scalefont setfont
 170         0.1 setlinewidth
 171         0 0 moveto
 172         0 setgray
 173         0.5 0 0.5 0 360 arc closepath fill stroke
 174         % ball_col
 175         1 eq {
 176                 0.01 setlinewidth
 177                 1 setgray
 178                 0.5 0 0.4 0 360 arc closepath
 179                 fill stroke
 180         } if
 181         % letter_col
 182         setgray
 183         % 0.25 is empiric centering. Change to taste
 184         0.25 -0.25 moveto
 185         % ch
 186         show
 187 } bind def
 188
 189 % Simple, but does it work everywhere?
 190 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
 191 % reverted for now -- jcn
 192 %
 193 % The filled circles are drawn by setting the linewidth
 194 % to 2*radius and drawing a point.
 195 /simple_draw_ez_ball % ch letter_col ball_col font
 196 {
 197         % font
 198         findfont 0.85 scalefont setfont
 199         /origin { 0.45 0 } def
 200         0 setgray
 201         1.1 setlinewidth
 202         origin moveto
 203         origin lineto stroke
 204         % ball_col
 205         setgray
 206         0.9 setlinewidth
 207         origin moveto
 208         origin lineto stroke
 209         % letter_col
 210         setgray
 211         % 0.25 is empiric centering. Change to taste
 212         origin moveto
 213         -0.28 -0.30 rmoveto
 214         % ch
 215         show
 216 } bind def
 217
 218 % this is for drawing slurs.
 219 /draw_bezier_sandwich  % thickness controls
 220 {
 221     % round ending and round beginning
 222     1 setlinejoin 1 setlinecap
 223         setlinewidth
 224         moveto
 225         curveto
 226         lineto
 227         curveto
 228         closepath
 229         gsave
 230         fill
 231         grestore
 232         stroke
 233 } bind def
 234
 235 /draw_dot % x1 y2 R
 236 {
 237 %       0 360 arc fill stroke
 238         0 360 arc closepath fill stroke
 239 } bind def
 240
 241 /draw_white_dot % x1 y2 R
 242 {
 243 %       0 360 arc fill stroke
 244         0 360 arc closepath % fill stroke
 245 gsave
 246  1 setgray fill
 247 grestore
 248 %       0 360 arc closepath % fill stroke
 249   0.05 setlinewidth 0 setgray stroke
 250 } bind def
 251
 252 /draw_dashed_line % dash thickness dx dy
 253 {
 254         1 setlinecap
 255         1 setlinejoin
 256         setdash
 257         setlinewidth
 258         0 0 moveto
 259         lineto
 260         stroke
 261 } bind def
 262
 263 /draw_dashed_slur % dash thickness controls
 264 {
 265         1 setlinecap
 266         1 setlinejoin
 267         setdash
 268         setlinewidth
 269         8 -2 roll
 270         moveto
 271         curveto
 272         stroke
 273 } bind def
 274
 275
 276 % a b c d subvec  ==  a-c b-d
 277 /subvec {
 278   3 2 roll exch sub
 279   3 1 roll
 280   sub exch
 281 } bind def
 282
 283
 284 % centre? zzwidth zzheight thickness x0 y0 x1 y1
 285 /draw_zigzag_line {
 286   newpath
 287   6 dict begin
 288
 289   4 2 roll % zzuw zzh th x1 y1 x0 y0
 290   2 copy
 291   moveto
 292   subvec % zzuw zzh th dx dy
 293
 294   2 copy euclidean_length /l exch def
 295   l div /uy exch def
 296   l div /ux exch def
 297   setlinewidth
 298   /zzh exch def
 299   l exch div round /n exch def
 300   n 0 gt { %if
 301       /zzw l n 2 mul div def
 302       {
 303           uy zzh mul 2 div ux zzh mul -2 div rmoveto
 304       } if
 305       1 1 n {
 306           ux zzw mul uy zzh mul sub
 307           uy zzw mul ux zzh mul add
 308           rlineto
 309           ux zzw mul uy zzh mul add
 310           uy zzw mul ux zzh mul sub
 311           rlineto
 312       } bind for
 313   }{ %else
 314       pop
 315       ux l mul uy l mul rlineto
 316   } ifelse
 317   stroke
 318  end
 319 } bind def
 320
 321 /bracket_traject
 322 {
 323         /traject_ds exch def
 324         /traject_alpha exch def
 325         traject_ds traject_alpha sin mul add
 326         exch
 327         traject_ds traject_alpha cos mul add
 328         exch
 329 } bind def
 330
 331
 332
 333 /half_bracket
 334 {
 335 %6
 336         0 0
 337 %5a
 338         bracket_thick arch_height add half_height arch_thick sub arch_width add
 339         arch_angle arch_height -0.15 mul bracket_traject
 340 %5b
 341         bracket_thick 0.5 mul half_height
 342         0 arch_height 0.5 mul bracket_traject
 343 %5c
 344         0 half_height
 345 %4a
 346         bracket_thick half_height arch_thick sub
 347         0 arch_height 0.4 mul bracket_traject
 348 %4b
 349         bracket_thick arch_height add half_height arch_thick sub arch_width add
 350         arch_angle arch_height -0.25 mul bracket_traject
 351 %4c
 352         bracket_thick arch_height add half_height arch_thick sub arch_width add
 353 %3
 354         bracket_thick half_height arch_thick sub
 355 %2
 356         bracket_thick 0
 357 %1
 358         0 0
 359 } bind def
 360
 361 /draw_half_bracket {
 362         moveto
 363         lineto
 364         lineto
 365         curveto
 366         curveto
 367         lineto
 368         gsave
 369         fill
 370         grestore
 371 } bind def
 372
 373 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 374 {
 375         % urg
 376
 377         /bracket_thick exch def
 378         /arch_thick exch def
 379         /bracket_height exch def
 380         /arch_height exch def
 381         /arch_width exch def
 382         /arch_angle exch def
 383
 384         bracket_height 2 div bracket_thick add /half_height exch def
 385         bracket_thick 0.5 mul setlinewidth
 386         1 setlinecap
 387         1 setlinejoin
 388         half_bracket
 389         20 copy
 390         1 -1 scale
 391         draw_half_bracket
 392         stroke
 393         1 -1 scale
 394         draw_half_bracket
 395         stroke
 396 } bind def
 397
 398 %end music-drawing-routines.ps