ps/music-drawing-routines.ps

   1 %!PS-Adobe-1.0: lily.ps
   2 %
   3 % Functions for direct and embedded PostScript
   4
   5 % round cappings
   6 1 setlinecap
   7
   8 /euclidean_length
   9 {
  10         1 copy mul exch 1 copy mul add sqrt
  11 } bind def
  12
  13 /simpledraw_box % breapth width depth height
  14 {
  15         /h exch def
  16         /d exch def
  17         /w exch def
  18         /b exch def
  19
  20         0.01 setlinewidth
  21         1 setlinejoin
  22         0 0 moveto
  23         b neg d neg rmoveto
  24         b w add 0 rlineto
  25         0 d h add rlineto
  26         b w add neg 0 rlineto
  27         %closepath gsave stroke grestore fill
  28         closepath fill
  29 } bind def
  30
  31
  32 % FIXME.  translate to middle of box.
  33 % Nice rectangle with rounded corners
  34 /draw_box % breapth width depth height
  35 {
  36         1 setlinejoin
  37         /l 0.05 def
  38         l setlinewidth
  39         1 setlinejoin
  40
  41         l 2 div sub /h exch def
  42         l 2 div sub /d exch def
  43         l 2 div sub /w exch def
  44         l 2 div sub /b exch def
  45
  46         b neg d neg moveto
  47         b w add 0 rlineto
  48         0 d h add rlineto
  49         b w add neg 0 rlineto
  50         0 d h add neg rlineto
  51         closepath gsave stroke grestore fill
  52 } bind def
  53
  54 % ugh, see rectfill
  55 /simpledraw_beam % slope width thick
  56 {
  57         /t exch def
  58         /w exch def
  59         w mul /h exch def
  60         1 setlinejoin
  61         % ugh?
  62         0.05 setlinewidth
  63
  64         0 t 2 div neg moveto
  65         w h rlineto
  66         0 t rlineto
  67         w neg h neg rlineto
  68         0 t neg rlineto
  69         closepath gsave stroke grestore fill
  70 } bind def
  71
  72 % Nice beam with rounded corners
  73 /draw_beam % slope width thick
  74 {
  75         % ugh?
  76         /l 0.1 def
  77         l 2 div setlinewidth
  78         1 setlinejoin
  79         l sub /t exch def
  80         l sub /w exch def
  81         w mul /h exch def
  82
  83         l 2 div t 2 div neg moveto
  84         w h rlineto
  85         0 t rlineto
  86         w neg h neg rlineto
  87         0 t neg rlineto
  88         closepath gsave stroke grestore fill
  89 } bind def
  90
  91 /draw_repeat_slash % width slope thick
  92 {
  93   /beamthick exch def
  94   /slope exch def
  95   /width exch def
  96   beamthick beamthick slope div euclidean_length
  97     /xwid exch def
  98   0 0 moveto
  99   xwid 0  rlineto
 100   width slope width mul rlineto
 101   xwid neg 0 rlineto
 102 %  width neg width angle sin mul neg rlineto
 103   closepath fill
 104 } bind def
 105
 106 /draw_hairpin % width start_h end_h thick
 107 {
 108   setlinewidth
 109   /end_h exch def
 110   /start_h exch def
 111   /wid exch def
 112   0 start_h moveto
 113   wid end_h lineto
 114   stroke
 115   0 start_h neg moveto
 116   wid end_h neg lineto
 117   stroke
 118 } bind def
 119
 120 /draw_tuplet % height gap dx dy thick dir
 121 {
 122         /dir exch def
 123         setlinewidth
 124         1 setlinecap
 125         1 setlinejoin
 126         /tuplet_dy exch def
 127         /tuplet_dx exch def
 128         /tuplet_gapx exch def
 129         /tuplet_h exch def
 130         tuplet_dy tuplet_dx div tuplet_gapx mul /tuplet_gapy exch def
 131
 132
 133         0 tuplet_h neg dir mul moveto
 134         0 0 lineto
 135         tuplet_dx tuplet_gapx sub 2 div
 136                 tuplet_dy tuplet_gapy sub 2 div  lineto
 137         tuplet_dx tuplet_gapx add 2 div
 138                 tuplet_dy tuplet_gapy add 2 div  moveto
 139         tuplet_dx tuplet_dy lineto
 140         tuplet_dx tuplet_dy tuplet_h dir neg mul add lineto
 141         stroke
 142 } bind def
 143
 144 /draw_ez_ball % ch letter_col ball_col font
 145 {
 146         % font
 147         findfont 0.7 scalefont setfont
 148         0.1 setlinewidth
 149         0 0 moveto
 150         0 setgray
 151         0.5 0 0.5 0 360 arc closepath fill stroke
 152         % ball_col
 153         1 eq {
 154                 0.01 setlinewidth
 155                 1 setgray
 156                 0.5 0 0.4 0 360 arc closepath
 157                 fill stroke
 158         } if
 159         % letter_col
 160         setgray
 161         % 0.25 is empiric centering. Change to taste
 162         0.25 -0.25 moveto
 163         % ch
 164         show
 165 } bind def
 166
 167 % Simple, but does it work everywhere?
 168 % Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
 169 % reverted for now -- jcn
 170 %
 171 % The filled circles are drawn by setting the linewidth
 172 % to 2*radius and drawing a point.
 173 /simple_draw_ez_ball % ch letter_col ball_col font
 174 {
 175         % font
 176         findfont 0.85 scalefont setfont
 177         /origin { 0.45 0 } def
 178         0 setgray
 179         1.1 setlinewidth
 180         origin moveto
 181         origin lineto stroke
 182         % ball_col
 183         setgray
 184         0.9 setlinewidth
 185         origin moveto
 186         origin lineto stroke
 187         % letter_col
 188         setgray
 189         % 0.25 is empiric centering. Change to taste
 190         origin moveto
 191         -0.28 -0.30 rmoveto
 192         % ch
 193         show
 194 } bind def
 195
 196 /draw_volta % h w thick vert_start vert_end
 197 {
 198         /vert_end exch def
 199         /vert_start exch def
 200         setlinewidth
 201         /volta_w exch def
 202         /volta_h exch def
 203         1 setlinecap
 204         1 setlinejoin
 205         vert_start 0 eq {
 206                 0 0 moveto
 207                 0 volta_h lineto
 208         } if
 209         0 volta_h moveto
 210         volta_w volta_h lineto
 211         vert_end 0 eq {
 212                 volta_w 0 lineto
 213         } if
 214         stroke
 215 } bind def
 216
 217 % this is for drawing slurs.
 218 /draw_bezier_sandwich  % thickness controls
 219 {
 220         setlinewidth
 221         moveto
 222         curveto
 223         lineto
 224         curveto
 225         gsave
 226         fill
 227         grestore
 228         stroke
 229 } bind def
 230
 231 /draw_dashed_line % dash thickness dx dy
 232 {
 233         1 setlinecap
 234         1 setlinejoin
 235         setdash
 236         setlinewidth
 237         0 0 moveto
 238         lineto
 239         stroke
 240 } bind def
 241
 242 /draw_dashed_slur % dash thickness controls
 243 {
 244         1 setlinecap
 245         1 setlinejoin
 246         setdash
 247         setlinewidth
 248         8 -2 roll
 249         moveto
 250         curveto
 251         stroke
 252 } bind def
 253
 254
 255
 256 /bracket_traject
 257 {
 258         /traject_ds exch def
 259         /traject_alpha exch def
 260         traject_ds traject_alpha sin mul add
 261         exch
 262         traject_ds traject_alpha cos mul add
 263         exch
 264 } bind def
 265
 266
 267
 268 /half_bracket
 269 {
 270 %6
 271         0 0
 272 %5a
 273         bracket_thick arch_height add half_height arch_thick sub arch_width add
 274         arch_angle arch_height -0.15 mul bracket_traject
 275 %5b
 276         bracket_thick 0.5 mul half_height
 277         0 arch_height 0.5 mul bracket_traject
 278 %5c
 279         0 half_height
 280 %4a
 281         bracket_thick half_height arch_thick sub
 282         0 arch_height 0.4 mul bracket_traject
 283 %4b
 284         bracket_thick arch_height add half_height arch_thick sub arch_width add
 285         arch_angle arch_height -0.25 mul bracket_traject
 286 %4c
 287         bracket_thick arch_height add half_height arch_thick sub arch_width add
 288 %3
 289         bracket_thick half_height arch_thick sub
 290 %2
 291         bracket_thick 0
 292 %1
 293         0 0
 294 } bind def
 295
 296 /draw_half_bracket {
 297         moveto
 298         lineto
 299         lineto
 300         curveto
 301         curveto
 302         lineto
 303         gsave
 304         fill
 305         grestore
 306 } bind def
 307
 308 /draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
 309 {
 310         % urg
 311
 312         /bracket_thick exch def
 313         /arch_thick exch def
 314         /bracket_height exch def
 315         /arch_height exch def
 316         /arch_width exch def
 317         /arch_angle exch def
 318
 319         bracket_height 2 div bracket_thick add /half_height exch def
 320         bracket_thick 0.5 mul setlinewidth
 321         1 setlinecap
 322         1 setlinejoin
 323         half_bracket
 324         20 copy
 325         1 -1 scale
 326         draw_half_bracket
 327         stroke
 328         1 -1 scale
 329         draw_half_bracket
 330         stroke
 331 } bind def
 332