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