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