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