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