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 /blot-diameter { lilypondpaperblotdiameter } bind def
   7
   8 /set_tex_dimen {
   9         cvr def
  10 } bind def
  11
  12
  13
  14 /euclidean_length
  15 {
  16         1 copy mul exch 1 copy mul add sqrt
  17 } bind def
  18
  19 % FIXME.  translate to middle of box.
  20 % Nice rectangle with rounded corners
  21 /draw_box % breapth width depth height
  22 {
  23         currentdict /testing known {
  24                 %% real thin lines for testing
  25                 /blot 0.005 def
  26         }{
  27                 /blot blot-diameter def
  28         } ifelse
  29
  30         0 setlinecap
  31         blot setlinewidth
  32         1 setlinejoin
  33
  34         blot 2 div sub /h exch def
  35         blot 2 div sub /d exch def
  36         blot 2 div sub /w exch def
  37         blot 2 div sub /b exch def
  38
  39         b neg d neg moveto
  40         b w add 0 rlineto
  41         0 d h add rlineto
  42         b w add neg 0 rlineto
  43         0 d h add neg rlineto
  44
  45         currentdict /testing known {
  46                 %% outline only, for testing:
  47                 stroke
  48         }{
  49                 closepath gsave stroke grestore fill
  50         } ifelse
  51 } bind def
  52
  53
  54 /draw_symmetric_x_triangle % h w th
  55 {
  56     setlinewidth
  57     0 0 moveto
  58     dup 0 lineto
  59     2 div
  60     exch lineto
  61     0 0 lineto
  62     stroke
  63 } bind def
  64
  65 /draw_round_box % breapth width depth height blot
  66 {
  67         /blot exch def
  68
  69         0 setlinecap
  70         blot setlinewidth
  71         1 setlinejoin
  72
  73         blot 2 div sub /h exch def
  74         blot 2 div sub /d exch def
  75         blot 2 div sub /w exch def
  76         blot 2 div sub /b exch def
  77
  78         b neg d neg moveto
  79         b w add 0 rlineto
  80         0 d h add rlineto
  81         b w add neg 0 rlineto
  82         0 d h add neg rlineto
  83
  84         currentdict /testing known {
  85                 %% outline only, for testing:
  86                 stroke
  87         }{
  88                 closepath gsave stroke grestore fill
  89         } ifelse
  90 } bind def
  91
  92 % Nice beam with rounded corners
  93 /draw_beam % slope width thick  blot
  94 {
  95         /blot exch def
  96         blot setlinewidth
  97
  98         0 setlinecap
  99         1 setlinejoin
 100
 101         blot sub /t exch def
 102         blot sub /w exch def
 103         w mul /h exch def
 104
 105         blot 2 div t 2 div neg moveto
 106         w h rlineto
 107         0 t rlineto
 108         w neg h neg rlineto
 109         0 t neg rlineto
 110
 111         currentdict /testing known {
 112                 %% outline only, for testing:
 113                 stroke
 114         }{
 115                 closepath gsave stroke grestore fill
 116         } ifelse
 117 } bind def
 118
 119 /draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
 120 {
 121         /blot exch def
 122
 123         0 setlinecap
 124         blot setlinewidth
 125         1 setlinejoin
 126
 127         /points exch def
 128         2 copy
 129         moveto
 130         1 1 points {pop lineto} for
 131         currentdict /testing known {
 132                 %% outline only, for testing:
 133                 stroke
 134         }{
 135                 closepath gsave stroke grestore fill
 136         } ifelse
 137 } bind def
 138
 139 /draw_repeat_slash % width slope thick
 140 {
 141         1 setlinecap
 142         1 setlinejoin
 143
 144         /beamthick exch def
 145         /slope exch def
 146         /width exch def
 147         beamthick beamthick slope div euclidean_length
 148           /xwid exch def
 149         0 0 moveto
 150         xwid 0  rlineto
 151         width slope width mul rlineto
 152         xwid neg 0 rlineto
 153       %  width neg width angle sin mul neg rlineto
 154         closepath fill
 155 } bind def
 156
 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_dashed_line % dash thickness dx dy
 234 {
 235         1 setlinecap
 236         1 setlinejoin
 237         setdash
 238         setlinewidth
 239         0 0 moveto
 240         lineto
 241         stroke
 242 } bind def
 243
 244 /draw_dashed_slur % dash thickness controls
 245 {
 246         1 setlinecap
 247         1 setlinejoin
 248         setdash
 249         setlinewidth
 250         8 -2 roll
 251         moveto
 252         curveto
 253         stroke
 254 } bind def
 255
 256
 257 % a b c d subvec  ==  a-c b-d
 258 /subvec {
 259   3 2 roll exch sub
 260   3 1 roll
 261   sub exch
 262 } bind def
 263
 264
 265 % centre? zzwidth zzheight thickness x0 y0 x1 y1
 266 /draw_zigzag_line {
 267   newpath
 268   6 dict begin
 269
 270   4 2 roll % zzuw zzh th x1 y1 x0 y0
 271   2 copy
 272   moveto
 273   subvec % zzuw zzh th dx dy
 274
 275   2 copy euclidean_length /l exch def
 276   l div /uy exch def
 277   l div /ux exch def
 278   setlinewidth
 279   /zzh exch def
 280   l exch div round /n exch def
 281   n 0 gt { %if
 282       /zzw l n 2 mul div def
 283       {
 284           uy zzh mul 2 div ux zzh mul -2 div rmoveto
 285       } if
 286       1 1 n {
 287           ux zzw mul uy zzh mul sub
 288           uy zzw mul ux zzh mul add
 289           rlineto
 290           ux zzw mul uy zzh mul add
 291           uy zzw mul ux zzh mul sub
 292           rlineto
 293       } bind for
 294   }{ %else
 295       pop
 296       ux l mul uy l mul rlineto
 297   } ifelse
 298   stroke
 299  end
 300 } bind def
 301
 302 /bracket_traject
 303 {
 304         /traject_ds exch def
 305         /traject_alpha exch def
 306         traject_ds traject_alpha sin mul add
 307         exch
 308         traject_ds traject_alpha cos mul add
 309         exch
 310 } bind def
 311
 312
 313
 314 /half_bracket
 315 {
 316 %6
 317         0 0
 318 %5a
 319         bracket_thick arch_height add half_height arch_thick sub arch_width add
 320         arch_angle arch_height -0.15 mul bracket_traject
 321 %5b
 322         bracket_thick 0.5 mul half_height
 323         0 arch_height 0.5 mul bracket_traject
 324 %5c
 325         0 half_height
 326 %4a
 327         bracket_thick half_height arch_thick sub
 328         0 arch_height 0.4 mul bracket_traject
 329 %4b
 330         bracket_thick arch_height add half_height arch_thick sub arch_width add
 331         arch_angle arch_height -0.25 mul bracket_traject
 332 %4c
 333         bracket_thick arch_height add half_height arch_thick sub arch_width add
 334 %3
 335         bracket_thick half_height arch_thick sub
 336 %2
 337         bracket_thick 0
 338 %1
 339         0 0
 340 } bind def
 341
 342 /draw_half_bracket {
 343         moveto
 344         lineto
 345         lineto
 346         curveto
 347         curveto
 348         lineto
 349         gsave
 350         fill
 351         grestore
 352 } bind def
 353
 354 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 355 {
 356         % urg
 357
 358         /bracket_thick exch def
 359         /arch_thick exch def
 360         /bracket_height exch def
 361         /arch_height exch def
 362         /arch_width exch def
 363         /arch_angle exch def
 364
 365         bracket_height 2 div bracket_thick add /half_height exch def
 366         bracket_thick 0.5 mul setlinewidth
 367         1 setlinecap
 368         1 setlinejoin
 369         half_bracket
 370         20 copy
 371         1 -1 scale
 372         draw_half_bracket
 373         stroke
 374         1 -1 scale
 375         draw_half_bracket
 376         stroke
 377 } bind def
 378
 379 %end music-drawing-routines.ps