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