ps/music-drawing-routines.ps

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