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