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