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_dashed_line % dash thickness dx dy
 232 {
 233         1 setlinecap
 234         1 setlinejoin
 235         setdash
 236         setlinewidth
 237         0 0 moveto
 238         lineto
 239         stroke
 240 } bind def
 241
 242 /draw_dashed_slur % dash thickness controls
 243 {
 244         1 setlinecap
 245         1 setlinejoin
 246         setdash
 247         setlinewidth
 248         8 -2 roll
 249         moveto
 250         curveto
 251         stroke
 252 } bind def
 253
 254
 255 % a b c d subvec  ==  a-c b-d
 256 /subvec {
 257   3 2 roll exch sub
 258   3 1 roll
 259   sub exch
 260 } bind def
 261
 262
 263 % centre? zzwidth zzheight thickness x0 y0 x1 y1
 264 /draw_zigzag_line {
 265   newpath
 266   6 dict begin
 267
 268   4 2 roll % zzuw zzh th x1 y1 x0 y0
 269   2 copy
 270   moveto
 271   subvec % zzuw zzh th dx dy
 272
 273   2 copy euclidean_length /l exch def
 274   l div /uy exch def
 275   l div /ux exch def
 276   setlinewidth
 277   /zzh exch def
 278   l exch div round /n exch def
 279   n 0 gt { %if
 280       /zzw l n 2 mul div def
 281       {
 282           uy zzh mul 2 div ux zzh mul -2 div rmoveto
 283       } if
 284       1 1 n {
 285           ux zzw mul uy zzh mul sub
 286           uy zzw mul ux zzh mul add
 287           rlineto
 288           ux zzw mul uy zzh mul add
 289           uy zzw mul ux zzh mul sub
 290           rlineto
 291       } bind for
 292   }{ %else
 293       pop
 294       ux l mul uy l mul rlineto
 295   } ifelse
 296   stroke
 297  end
 298 } bind def
 299
 300 /bracket_traject
 301 {
 302         /traject_ds exch def
 303         /traject_alpha exch def
 304         traject_ds traject_alpha sin mul add
 305         exch
 306         traject_ds traject_alpha cos mul add
 307         exch
 308 } bind def
 309
 310
 311
 312 /half_bracket
 313 {
 314 %6
 315         0 0
 316 %5a
 317         bracket_thick arch_height add half_height arch_thick sub arch_width add
 318         arch_angle arch_height -0.15 mul bracket_traject
 319 %5b
 320         bracket_thick 0.5 mul half_height
 321         0 arch_height 0.5 mul bracket_traject
 322 %5c
 323         0 half_height
 324 %4a
 325         bracket_thick half_height arch_thick sub
 326         0 arch_height 0.4 mul bracket_traject
 327 %4b
 328         bracket_thick arch_height add half_height arch_thick sub arch_width add
 329         arch_angle arch_height -0.25 mul bracket_traject
 330 %4c
 331         bracket_thick arch_height add half_height arch_thick sub arch_width add
 332 %3
 333         bracket_thick half_height arch_thick sub
 334 %2
 335         bracket_thick 0
 336 %1
 337         0 0
 338 } bind def
 339
 340 /draw_half_bracket {
 341         moveto
 342         lineto
 343         lineto
 344         curveto
 345         curveto
 346         lineto
 347         gsave
 348         fill
 349         grestore
 350 } bind def
 351
 352 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 353 {
 354         % urg
 355
 356         /bracket_thick exch def
 357         /arch_thick exch def
 358         /bracket_height exch def
 359         /arch_height exch def
 360         /arch_width exch def
 361         /arch_angle exch def
 362
 363         bracket_height 2 div bracket_thick add /half_height exch def
 364         bracket_thick 0.5 mul setlinewidth
 365         1 setlinecap
 366         1 setlinejoin
 367         half_bracket
 368         20 copy
 369         1 -1 scale
 370         draw_half_bracket
 371         stroke
 372         1 -1 scale
 373         draw_half_bracket
 374         stroke
 375 } bind def
 376
 377 %end music-drawing-routines.ps