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