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