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