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