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