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