* lily/ly-module.cc (LY_DEFINE): bugfix.

[lilypond.git] / ps / music-drawing-routines.ps

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index a3ad13a895a561c659a2499f09c5dcc1b35ed683..5d39f3305d3c0ff56dc3214c8910045094a0c96d 100644 (file)
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -2,32 +2,28 @@
 %
 % Functions for direct and embedded PostScript
 
-/blot-diameter { lilypondpaperblotdiameter } bind def
-
-% fucking redhat xdvi patch.
-/skeel { scale } bind def
-
 
 /set_tex_dimen {
        cvr def     
 } bind def
 
+
+
 /euclidean_length  
 { 
        1 copy mul exch 1 copy mul add sqrt 
 } bind def 
 
-/skeel { scale } bind def
 % FIXME.  translate to middle of box.
 % Nice rectangle with rounded corners
 /draw_box % breapth width depth height
 {
-       currentdict /testing known {
+%      currentdict /testing known {
                %% real thin lines for testing
                /blot 0.005 def
-       }{
-               /blot blot-diameter def
-       } ifelse
+%      }{
+%              /blot blot-diameter def
+%      } ifelse
 
        0 setlinecap
        blot setlinewidth
@@ -52,6 +48,18 @@
        } ifelse
 } bind def
 
+
+/draw_symmetric_x_triangle % h w th
+{
+    setlinewidth
+    0 0 moveto
+    dup 0 lineto
+    2 div 
+    exch lineto
+    0 0 lineto
+    stroke
+} bind def
+
 /draw_round_box % breapth width depth height blot
 {
        /blot exch def
@@ -80,14 +88,9 @@
 } bind def
 
 % Nice beam with rounded corners
-/draw_beam % slope width thick 
+/draw_beam % slope width thick  blot
 {
-       currentdict /testing known {
-               %% real thin lines for testing
-               /blot 0.005 def
-       }{
-               /blot blot-diameter def
-       } ifelse
+       /blot exch def 
        blot setlinewidth
 
        0 setlinecap
@@ -111,6 +114,26 @@
        } ifelse
 } bind def 
 
+/draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
+{
+       /blot exch def
+
+       0 setlinecap
+       blot setlinewidth
+       1 setlinejoin
+
+       /points exch def
+       2 copy
+       moveto
+       1 1 points {pop lineto} for
+       currentdict /testing known {
+               %% outline only, for testing:
+               stroke
+       }{
+               closepath gsave stroke grestore fill
+       } ifelse
+} bind def
+
 /draw_repeat_slash % width slope thick
 {
        1 setlinecap
@@ -129,47 +152,6 @@
        closepath fill
 } bind def
 
-/draw_hairpin % width start_h end_h thick
-{
-       1 setlinecap
-       1 setlinejoin
-
-       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
-} bind def
-
-/draw_tuplet % height gap dx dy thick dir 
-{ 
-       1 setlinecap 
-       1 setlinejoin 
-
-       /dir exch def 
-       setlinewidth 
-       /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
 {
@@ -223,36 +205,17 @@
        show
 } bind def
 
-/draw_volta % h w thick vert_start vert_end 
-{ 
-       1 setlinecap 
-       1 setlinejoin 
-
-       /vert_end exch def 
-       /vert_start exch def 
-       setlinewidth 
-       /volta_w exch def 
-       /volta_h exch def 
-       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 
-
 % this is for drawing slurs. 
 /draw_bezier_sandwich  % thickness controls 
-{ 
+{
+    % round ending and round beginning
+    1 setlinejoin 1 setlinecap
        setlinewidth 
        moveto 
        curveto 
        lineto 
-       curveto 
+       curveto
+       closepath
        gsave 
        fill 
        grestore 
@@ -289,6 +252,50 @@
 } bind def 
 
 
+% a b c d subvec  ==  a-c b-d
+/subvec {
+  3 2 roll exch sub
+  3 1 roll
+  sub exch
+} bind def
+
+
+% centre? zzwidth zzheight thickness x0 y0 x1 y1
+/draw_zigzag_line {
+  newpath
+  6 dict begin
+ 
+  4 2 roll % zzuw zzh th x1 y1 x0 y0
+  2 copy
+  moveto
+  subvec % zzuw zzh th dx dy
+
+  2 copy euclidean_length /l exch def
+  l div /uy exch def
+  l div /ux exch def
+  setlinewidth
+  /zzh exch def
+  l exch div round /n exch def
+  n 0 gt { %if
+      /zzw l n 2 mul div def
+      {
+         uy zzh mul 2 div ux zzh mul -2 div rmoveto
+      } if
+      1 1 n {
+         ux zzw mul uy zzh mul sub
+         uy zzw mul ux zzh mul add
+         rlineto
+         ux zzw mul uy zzh mul add
+         uy zzw mul ux zzh mul sub
+         rlineto
+      } bind for
+  }{ %else
+      pop
+      ux l mul uy l mul rlineto
+  } ifelse
+  stroke
+ end
+} bind def
 
 /bracket_traject 
 { 
@@ -367,3 +374,4 @@
        stroke 
 } bind def 
 
+%end music-drawing-routines.ps