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