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 width
 121 {
 122         1 setlinecap
 123         1 setlinejoin
 124         setdash
 125         setlinewidth
 126         0 0 moveto
 127         0 lineto
 128         stroke
 129 } bind def
 130 %
 131 /draw_dashed_slur % dash thickness controls
 132 {
 133         1 setlinecap
 134         1 setlinejoin
 135         setdash
 136         setlinewidth
 137         8 -2 roll
 138         moveto
 139         curveto
 140         stroke
 141 } bind def
 142 %
 143 %
 144 %
 145 /bracket_traject
 146 {
 147   /traject_ds exch def
 148   /traject_alpha exch def
 149   traject_ds traject_alpha sin mul add
 150   exch
 151   traject_ds traject_alpha cos mul add
 152   exch
 153 } bind def
 154 %
 155 %
 156 %
 157 /half_bracket
 158 {
 159 %6
 160         0 0
 161 %5a
 162         bracket_thick arch_height add half_height arch_thick sub arch_width add
 163         arch_angle arch_height -0.15 mul bracket_traject
 164 %5b
 165         1 half_height
 166         0 arch_height 0.5 mul bracket_traject
 167 %5c
 168         0 half_height
 169 %4a
 170         bracket_thick half_height arch_thick sub
 171         0 arch_height 0.4 mul bracket_traject
 172 %4b
 173         bracket_thick arch_height add half_height arch_thick sub arch_width add
 174         arch_angle arch_height -0.25 mul bracket_traject
 175 %4c
 176         bracket_thick arch_height add half_height arch_thick sub arch_width add
 177 %3
 178         bracket_thick half_height arch_thick sub
 179 %2
 180         bracket_thick 0
 181 %1
 182         0 0
 183 } bind def
 184 %
 185 /draw_half_bracket {
 186         moveto
 187         lineto
 188         lineto
 189         curveto
 190         curveto
 191         lineto
 192         gsave
 193         fill
 194         grestore
 195 } bind def
 196 %
 197 /draw_bracket % arch_angle arch_width arch_height bracket_width bracket_height arch_thick bracket_thick
 198 {
 199         % urg
 200         /bracket_thick exch def
 201         /arch_thick exch def
 202         /bracket_height exch def
 203         /bracket_width exch def
 204         /arch_height exch def
 205         /arch_width exch def
 206         /arch_angle exch def
 207 %
 208         bracket_height 2 div bracket_thick add /half_height exch def
 209 % urg: the only Level-2 PS, check effect in print
 210 %       true setstrokeadjust
 211         1 setlinecap
 212         1 setlinejoin
 213         half_bracket
 214         20 copy
 215         1 -1 scale
 216         draw_half_bracket
 217         stroke
 218         1 -1 scale
 219 % ugh, ugh:
 220         0.05 0 translate
 221         draw_half_bracket
 222         stroke
 223 } bind def
 224 %