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