ps/music-drawing-routines.ps

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