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