ps/lily.ps

   1 %!PS-Adobe-1.0: lily.ps
   2 %
   3 % 2 setlanguagelevel %  hmm. auto_resize_dicts doesn't help either.
   4 % round cappings
   5 1 setlinecap
   6 %
   7 % scm/lily.scm should allow blank lines, now
   8 %
   9 /draw_beam % width slope thick
  10 {
  11         2 div /beam_thick exch def
  12         /beam_slope exch def
  13         /beam_wd exch def
  14         beam_slope beam_wd mul /beam_ht exch def
  15         0 beam_thick neg moveto
  16         beam_wd beam_ht rlineto
  17         0 beam_thick 2 mul rlineto
  18         0 beam_thick lineto
  19         closepath fill
  20 } bind def
  21 %
  22 /draw_decrescendo %  width height cons thick
  23 {
  24         setlinewidth
  25         /cresc_cont exch def
  26         /cresc_ht exch def
  27         /cresc_wd exch def
  28 %
  29         cresc_wd cresc_cont moveto
  30         0 cresc_ht lineto
  31         stroke
  32         cresc_wd cresc_cont neg moveto
  33         0 cresc_ht neg lineto
  34         stroke
  35 } bind def
  36 %
  37 /draw_crescendo % width height cons thick
  38 {
  39         setlinewidth
  40         /cresc_cont exch def
  41         /cresc_ht exch def
  42         /cresc_wd exch def
  43 %
  44         0 cresc_cont moveto
  45         cresc_wd cresc_ht lineto
  46         stroke
  47         0 cresc_cont neg moveto
  48         cresc_wd cresc_ht neg lineto
  49         stroke
  50 } bind def
  51 %
  52 /lily_distance
  53 {
  54         1 copy mul exch 1 copy mul add sqrt
  55 } bind def
  56 %
  57 /draw_tuplet % height gap dx dy thick dir
  58 {
  59 % urg: the only Level-2 PS, check effect in print
  60 %       true setstrokeadjust
  61         /dir exch def
  62         setlinewidth
  63         1 setlinecap
  64         1 setlinejoin
  65         /tuplet_dy exch def
  66         /tuplet_dx exch def
  67         /tuplet_gapx exch def
  68         /tuplet_h exch def
  69         tuplet_dy tuplet_dx div tuplet_gapx mul /tuplet_gapy exch def
  70 %
  71 %
  72         0 0 moveto
  73         0 tuplet_h dir mul lineto
  74         tuplet_dx tuplet_gapx sub 2 div
  75                 tuplet_dy tuplet_gapy sub 2 div tuplet_h dir mul add lineto
  76         tuplet_dx tuplet_gapx add 2 div
  77                 tuplet_dy tuplet_gapy add 2 div tuplet_h dir mul add moveto
  78         tuplet_dx tuplet_dy tuplet_h dir mul add lineto
  79         tuplet_dx tuplet_dy lineto
  80         stroke
  81 } bind def
  82 %
  83 /draw_volta % h w thick vert_start vert_end
  84 {
  85         /vert_end exch def
  86         /vert_start exch def
  87         setlinewidth
  88         /volta_w exch def
  89         /volta_h exch def
  90 % urg: the only Level-2 PS, check effect in print
  91 %       true setstrokeadjust
  92         1 setlinecap
  93         1 setlinejoin
  94         vert_start 0 eq {
  95                 0 0 moveto
  96                 0 volta_h lineto
  97         } if
  98         0 volta_h moveto
  99         volta_w volta_h lineto
 100         vert_end 0 eq {
 101                 volta_w 0 lineto
 102         } if
 103         stroke
 104 } bind def
 105 %
 106 % this is for drawing slurs.
 107 /draw_bezier_sandwich  % thickness controls
 108 {
 109         setlinewidth
 110         moveto
 111         curveto
 112         lineto
 113         curveto
 114         gsave
 115         fill
 116         grestore
 117         stroke
 118 } bind def
 119 %
 120 /draw_dashed_line % dash thickness dx dy
 121 {
 122         1 setlinecap
 123         1 setlinejoin
 124         setdash
 125         setlinewidth
 126         0 0 moveto
 127         lineto
 128         stroke
 129 } bind def
 130 %
 131 /xdraw_dashed_line % dash thickness dx dy
 132 {
 133         1 setlinecap
 134         1 setlinejoin
 135         setdash
 136         dup
 137         setlinewidth
 138         2 div
 139         dup
 140         0 moveto
 141         neg add
 142         lineto
 143         stroke
 144 } bind def
 145 %
 146 /draw_dashed_slur % dash thickness controls
 147 {
 148         1 setlinecap
 149         1 setlinejoin
 150         setdash
 151         setlinewidth
 152         8 -2 roll
 153         moveto
 154         curveto
 155         stroke
 156 } bind def
 157 %
 158 %
 159 %
 160 /bracket_traject
 161 {
 162   /traject_ds exch def
 163   /traject_alpha exch def
 164   traject_ds traject_alpha sin mul add
 165   exch
 166   traject_ds traject_alpha cos mul add
 167   exch
 168 } bind def
 169 %
 170 %
 171 %
 172 /half_bracket
 173 {
 174 %6
 175         0 0
 176 %5a
 177         bracket_thick arch_height add half_height arch_thick sub arch_width add
 178         arch_angle arch_height -0.15 mul bracket_traject
 179 %5b
 180         1 half_height
 181         0 arch_height 0.5 mul bracket_traject
 182 %5c
 183         0 half_height
 184 %4a
 185         bracket_thick half_height arch_thick sub
 186         0 arch_height 0.4 mul bracket_traject
 187 %4b
 188         bracket_thick arch_height add half_height arch_thick sub arch_width add
 189         arch_angle arch_height -0.25 mul bracket_traject
 190 %4c
 191         bracket_thick arch_height add half_height arch_thick sub arch_width add
 192 %3
 193         bracket_thick half_height arch_thick sub
 194 %2
 195         bracket_thick 0
 196 %1
 197         0 0
 198 } bind def
 199 %
 200 /draw_half_bracket {
 201         moveto
 202         lineto
 203         lineto
 204         curveto
 205         curveto
 206         lineto
 207         gsave
 208         fill
 209         grestore
 210 } bind def
 211 %
 212 /draw_bracket % arch_angle arch_width arch_height bracket_width bracket_height arch_thick bracket_thick
 213 {
 214         % urg
 215         /bracket_thick exch def
 216         /arch_thick exch def
 217         /bracket_height exch def
 218         /bracket_width exch def
 219         /arch_height exch def
 220         /arch_width exch def
 221         /arch_angle exch def
 222 %
 223         bracket_height 2 div bracket_thick add /half_height exch def
 224 % urg: the only Level-2 PS, check effect in print
 225 %       true setstrokeadjust
 226         1 setlinecap
 227         1 setlinejoin
 228         half_bracket
 229         20 copy
 230         1 -1 scale
 231         draw_half_bracket
 232         stroke
 233         1 -1 scale
 234 % ugh, ugh:
 235         0.05 0 translate
 236         draw_half_bracket
 237         stroke
 238 } bind def
 239 %