]> git.donarmstrong.com Git - lilypond.git/blobdiff - ps/music-drawing-routines.ps
Fix some bugs in the dynamic engraver and PostScript backend
[lilypond.git] / ps / music-drawing-routines.ps
index f1b9fa0fd8a3ee56b9dca59bde15e02c3ab848e5..e0f28e82a6a21e9b9918409a81bd5c0c255858af 100644 (file)
-%!PS-Adobe-1.0: lily.ps 
+%!PS-Adobe-1.0: music-drawing-routines.ps
 %
 % Functions for direct and embedded PostScript
 
-% round cappings 
-1 setlinecap
+% Careful with double % as comment prefix.
+% Any %%X comment is interpreted as DSC comments.
 
-/euclidean_length  
-{ 
-       1 copy mul exch 1 copy mul add sqrt 
-} bind def 
+% TODO: use dicts or prefixes to prevent namespace pollution.
 
-/simpledraw_box % breapth width depth height
-{
-       /h exch def
-       /d exch def
-       /w exch def
-       /b exch def
+% Emulation code from Postscript Language Reference.
 
-       0.01 setlinewidth
-       1 setlinejoin
-       0 0 moveto
-       b neg d neg rmoveto
-       b w add 0 rlineto
-       0 d h add rlineto
-       b w add neg 0 rlineto
-       %closepath gsave stroke grestore fill
-       closepath fill
+/*SF
+{
+       exch findfont exch
+       dup type /arraytype eq
+               {makefont}
+               {scalefont}
+       ifelse
+       setfont
 } bind def
 
+/languagelevel where
+       {pop languagelevel}
+       {1}
+ifelse
 
-% FIXME.  translate to middle of box.
-% Nice rectangle with rounded corners
-/draw_box % breapth width depth height
-{
-       1 setlinejoin
-       /l 0.05 def
-       l setlinewidth
-       1 setlinejoin
+2 lt
+       { /selectfont /*SF load def }
+if
 
-       l 2 div sub /h exch def
-       l 2 div sub /d exch def
-       l 2 div sub /w exch def
-       l 2 div sub /b exch def
-
-       b neg d neg moveto
-       b w add 0 rlineto
-       0 d h add rlineto
-       b w add neg 0 rlineto
-       0 d h add neg rlineto
-       closepath gsave stroke grestore fill
-} bind def
+% end emulation code
 
-% ugh, see rectfill
-/simpledraw_beam % slope width thick 
-{
-       /t exch def
-       /w exch def
-       w mul /h exch def
-       1 setlinejoin
-       % ugh?
-       0.05 setlinewidth
-
-       0 t 2 div neg moveto
-       w h rlineto
-       0 t rlineto
-       w neg h neg rlineto
-       0 t neg rlineto
-       closepath gsave stroke grestore fill
-} bind def 
+/pdfmark where
+{pop} {userdict /pdfmark /cleartomark load put} ifelse
 
-% Nice beam with rounded corners
-/draw_beam % slope width thick 
+
+% llx lly urx ury URI
+/mark_URI
+% It's possible to eliminate the coordinate variables by doing [ /Rect [ 7 3
+% roll.  That is, however, kind of ugly.  It would be nice if this procedure
+% were only included when PDF marks are enabled.
 {
-       % ugh?
-       /l 0.1 def
-       l 2 div setlinewidth
-       1 setlinejoin
-       l sub /t exch def
-       l sub /w exch def
-       w mul /h exch def
-
-       l 2 div t 2 div neg moveto
-       w h rlineto
-       0 t rlineto
-       w neg h neg rlineto
-       0 t neg rlineto
-       closepath gsave stroke grestore fill
+    /command exch def
+    /ury exch def
+    /urx exch def
+    /lly exch def
+    /llx exch def
+    [
+       /Rect [ llx lly urx ury ]
+       
+       /Border [ 0 0 0 ]
+
+        /Action
+           <<
+               /Subtype /URI
+               /URI command
+           >>
+        /Subtype /Link
+    /ANN
+    pdfmark
+}
+bind def
+
+% from adobe tech note 5002. 
+/BeginEPSF { %def
+    /b4_Inc_state save def % Save state for cleanup
+    /dict_count countdictstack def % Count objects on dict stack
+    /op_count count 1 sub def % Count objects on operand stack
+    userdict begin % Push userdict on dict stack
+    /showpage { } def % Redefine showpage, { } = null proc
+    0 setgray 0 setlinecap % Prepare graphics state
+    1 setlinewidth 0 setlinejoin
+    10 setmiterlimit [ ] 0 setdash newpath
+    /languagelevel where % If level not equal to 1 then
+    {pop languagelevel % set strokeadjust and
+    1 ne % overprint to their defaults.
+      {false setstrokeadjust false setoverprint
+      } if
+    } if
+} bind def
+
+/EndEPSF { %def
+  count op_count sub {pop} repeat % Clean up stacks
+  countdictstack dict_count sub {end} repeat
+  b4_Inc_state restore
 } bind def 
 
-/draw_repeat_slash % width slope thick
+
+%<font> <encoding> <name> reencode-font
+/reencode-font
 {
-  /beamthick exch def
-  /slope exch def
-  /width exch def
-  beamthick beamthick slope div euclidean_length
-    /xwid exch def 
-  0 0 moveto
-  xwid 0  rlineto
-  width slope width mul rlineto
-  xwid neg 0 rlineto
-%  width neg width angle sin mul neg rlineto
-  closepath fill
+    /name exch def
+    /encoding exch def
+    dup length
+    dict begin {
+       1 index /FID ne {def} {pop
+       pop} ifelse
+    }
+    forall
+    /Encoding encoding
+    def currentdict
+    end
+    name exch definefont
 } bind def
 
-/draw_hairpin % width start_h end_h thick
+
+
+/set_tex_dimen
 {
-  setlinewidth
-  /end_h exch def 
-  /start_h exch def
-  /wid exch def
-  0 start_h moveto
-  wid end_h lineto
-  stroke
-  0 start_h neg moveto
-  wid end_h neg lineto
-  stroke
+       cvr def
 } bind def
 
-/draw_tuplet % height gap dx dy thick dir 
-{ 
-       /dir exch def 
-       setlinewidth 
-       1 setlinecap 
-       1 setlinejoin 
-       /tuplet_dy exch def 
-       /tuplet_dx exch def 
-       /tuplet_gapx exch def 
-       /tuplet_h exch def 
-       tuplet_dy tuplet_dx div tuplet_gapx mul /tuplet_gapy exch def 
-
-
-       0 tuplet_h neg dir mul moveto 
-       0 0 lineto  
-       tuplet_dx tuplet_gapx sub 2 div  
-               tuplet_dy tuplet_gapy sub 2 div  lineto 
-       tuplet_dx tuplet_gapx add 2 div  
-               tuplet_dy tuplet_gapy add 2 div  moveto 
-       tuplet_dx tuplet_dy lineto 
-       tuplet_dx tuplet_dy tuplet_h dir neg mul add lineto 
-       stroke 
-} bind def 
 
-/draw_ez_ball % ch letter_col ball_col font
-{
-       % font
-       findfont 0.7 scalefont setfont 
-       0.1 setlinewidth
-       0 0 moveto
-       0 setgray
-       0.5 0 0.5 0 360 arc closepath fill stroke
-       % ball_col
-       1 eq {
-               0.01 setlinewidth
-               1 setgray
-               0.5 0 0.4 0 360 arc closepath
-               fill stroke
-       } if 
-       % letter_col
-       setgray
-       % 0.25 is empiric centering. Change to taste
-       0.25 -0.25 moveto
-       % ch
-       show
+/stroke_and_fill {
+       gsave
+               stroke
+       grestore
+       fill
 } bind def
 
-% Simple, but does it work everywhere?
-% Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
-% reverted for now -- jcn
-%
-% The filled circles are drawn by setting the linewidth
-% to 2*radius and drawing a point.
-/simple_draw_ez_ball % ch letter_col ball_col font
-{
-       % font
-       findfont 0.85 scalefont setfont
-       /origin { 0.45 0 } def
-       0 setgray
-       1.1 setlinewidth
-       origin moveto
-       origin lineto stroke
-       % ball_col
-       setgray
-       0.9 setlinewidth
-       origin moveto
-       origin lineto stroke
-       % letter_col
-       setgray
-       % 0.25 is empiric centering. Change to taste
-       origin moveto
-       -0.28 -0.30 rmoveto
-       % ch
-       show
+/vector_add { % x1 y1 x2 y2 vector_add x1+x2 y1+y2
+       exch
+       4 1 roll
+       add
+       3 1 roll
+       add
+       exch
 } bind def
 
-/draw_volta % h w thick vert_start vert_end 
-{ 
-       /vert_end exch def 
-       /vert_start exch def 
-       setlinewidth 
-       /volta_w exch def 
-       /volta_h exch def 
-       1 setlinecap 
-       1 setlinejoin 
-       vert_start 0 eq { 
-               0 0 moveto 
-               0 volta_h lineto 
-       } if 
-       0 volta_h moveto 
-       volta_w volta_h lineto 
-       vert_end 0 eq { 
-               volta_w 0 lineto 
-       } if 
-       stroke 
-} bind def 
+/draw_round_box % width height x y blot
+{
+       setlinewidth % w h x y
+       0 setlinecap
+       1 setlinejoin
 
-% this is for drawing slurs. 
-/draw_bezier_sandwich  % thickness controls 
-{ 
-       setlinewidth 
-       moveto 
-       curveto 
-       lineto 
-       curveto 
-       gsave 
-       fill 
-       grestore 
-       stroke 
-} bind def 
+       rmoveto % w h
+       currentpoint % w h x1 y1
+       4 2 roll % x1 y1 w h
+       4 copy
+       rectfill
+       rectstroke
+} bind def
 
-/draw_dashed_line % dash thickness dx dy
-{ 
-       1 setlinecap 
-       1 setlinejoin 
-       setdash 
-       setlinewidth 
-       0 0 moveto
-       lineto
-       stroke 
-} bind def 
+/draw_polygon % fill? x(n) y(n) x(n-1) y(n-1) ... x(0) y(0) n blot
+{
+       setlinewidth %set to blot
 
-/draw_dashed_slur % dash thickness controls
-{ 
-       1 setlinecap 
-       1 setlinejoin 
-       setdash 
-       setlinewidth 
-       8 -2 roll 
-       moveto 
-       curveto 
-       stroke 
-} bind def 
+       0 setlinecap
+       1 setlinejoin
 
+       3 1 roll
+       /polygon_x
+       currentpoint
+       /polygon_y exch def
+       def
+       rmoveto % x(0) y(0)
+       { polygon_x polygon_y vector_add lineto } repeat % n times
+       closepath 
+       { %fill?
+               stroke_and_fill
+       }{
+               stroke
+       } ifelse
+} bind def
 
+/draw_repeat_slash % x-width width height draw_repeat_slash
+{
+       2 index % duplicate x-width
+       1 setlinecap
+       1 setlinejoin
+       
+         0  rlineto % x-width 0
+            rlineto % width height
+       neg 0 rlineto % -x-width 0
+       closepath fill
+} bind def
 
-/bracket_traject 
-{ 
-       /traject_ds exch def 
-       /traject_alpha exch def 
-       traject_ds traject_alpha sin mul add 
-       exch 
-       traject_ds traject_alpha cos mul add 
-       exch 
-} bind def 
+% this is for drawing slurs.
+/draw_bezier_sandwich  % thickness controls
+{
+       gsave
+       currentpoint translate
+    % round ending and round beginning
+    1 setlinejoin 1 setlinecap
+       setlinewidth
+       moveto
+       curveto
+       lineto
+       curveto
+       closepath
+       stroke_and_fill
+       grestore
+} bind def
+
+/draw_dot % radius x y draw_dot
+{
+       rmoveto
+       currentpoint
+       3 2 roll
+       0 360 arc closepath stroke_and_fill
+} bind def
 
+/draw_circle % filled? radius thickness draw_circle
+{
+       setlinewidth    % f? r
+       currentpoint    % f? r x0 y0
+       3 2 roll        % f? x0 y0 r
+       dup 0 rmoveto
+       0 360 arc closepath
+               { stroke_and_fill } 
+               { stroke }
+       ifelse
+} bind def
 
 
-/half_bracket
-{ 
-%6 
-       0 0 
-%5a 
-       bracket_thick arch_height add half_height arch_thick sub arch_width add 
-       arch_angle arch_height -0.15 mul bracket_traject 
-%5b 
-       bracket_thick 0.5 mul half_height 
-       0 arch_height 0.5 mul bracket_traject 
-%5c 
-       0 half_height 
-%4a 
-       bracket_thick half_height arch_thick sub 
-       0 arch_height 0.4 mul bracket_traject 
-%4b 
-       bracket_thick arch_height add half_height arch_thick sub arch_width add 
-       arch_angle arch_height -0.25 mul bracket_traject 
-%4c 
-       bracket_thick arch_height add half_height arch_thick sub arch_width add 
-%3 
-       bracket_thick half_height arch_thick sub 
-%2 
-       bracket_thick 0 
-%1 
-       0 0 
-} bind def 
+/draw_line % dx dy x1 y1 thickness draw_line
+{
+       setlinewidth % dx dy x1 y1
+       1 setlinecap
+       1 setlinejoin
+       rmoveto % dx dy
+       rlineto
+       stroke
+} bind def
 
-/draw_half_bracket { 
-       moveto 
-       lineto 
-       lineto 
-       curveto 
-       curveto 
-       lineto 
-       gsave 
-       fill 
-       grestore 
-} bind def 
+/draw_dashed_line % dx dy thickness dashpattern draw_dashed_line
+{
+       1 setlinecap
+       1 setlinejoin
+       setdash % dx dy thickness
+       setlinewidth %dx dy
+       rlineto
+       stroke
+       [] 0 setdash % reset dash pattern
+} bind def
 
-/draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
-{ 
-       % urg
-
-       /bracket_thick exch def
-       /arch_thick exch def
-       /bracket_height exch def
-       /arch_height exch def
-       /arch_width exch def
-       /arch_angle exch def
-
-       bracket_height 2 div bracket_thick add /half_height exch def 
-       bracket_thick 0.5 mul setlinewidth
-       1 setlinecap 
-       1 setlinejoin 
-       half_bracket 
-       20 copy 
-       1 -1 scale 
-       draw_half_bracket 
-       stroke 
-       1 -1 scale 
-       draw_half_bracket 
-       stroke 
-} bind def 
+/draw_dashed_slur % controls thickness dash
+{
+gsave
+       currentpoint translate
+       1 setlinecap
+       1 setlinejoin
+       setdash
+       setlinewidth
+       8 2 roll
+       moveto
+       curveto
+       stroke
+grestore
+} bind def
 
+/print_glyphs % dx dy glyph print_glyphs
+{
+       {
+               currentpoint %dx dy glyph x0 y0
+               3 2 roll %dx dy x0 y0 glyph
+               glyphshow % dx dy x0 y0
+               moveto % dx dy
+               rmoveto
+       }repeat
+}bind def
+%end music-drawing-routines.ps