patch::: 1.5.8.jcn1

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

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index 2ed8afd58351e8f2b2acb63d05c263fc69d1ebfd..a4c83114657fef3a603c0d53be2981c1b0a50466 100644 (file)
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -1,63 +1,131 @@
-%!PS-Adobe-1.0: lily.ps 
+%!PS-Adobe-1.0: music-drawing-routines.ps
 %
 % Functions for direct and embedded PostScript
 
-% round cappings 
-1 setlinecap
+/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 
 
-/draw_beam % width slope thick 
-{ 
-        2 div /beam_thick exch def 
-        /beam_slope exch def 
-        /beam_wd exch def 
-        beam_slope beam_wd mul /beam_ht exch def 
-        0 beam_thick neg moveto  
-        beam_wd beam_ht rlineto  
-        0 beam_thick 2 mul rlineto 
-        0 beam_thick lineto 
-        closepath fill 
+/skeel { scale } bind def
+% FIXME.  translate to middle of box.
+% Nice rectangle with rounded corners
+/draw_box % breapth width depth height
+{
+       currentdict /testing known {
+               %% real thin lines for testing
+               /blot 0.005 def
+       }{
+               /blot blot-diameter def
+       } ifelse
+
+       0 setlinecap
+       blot setlinewidth
+       1 setlinejoin
+
+       blot 2 div sub /h exch def
+       blot 2 div sub /d exch def
+       blot 2 div sub /w exch def
+       blot 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
+
+       currentdict /testing known {
+               %% outline only, for testing:
+               stroke
+       }{
+               closepath gsave stroke grestore fill
+       } ifelse
+} bind def
+
+% Nice beam with rounded corners
+/draw_beam % slope width thick 
+{
+       currentdict /testing known {
+               %% real thin lines for testing
+               /blot 0.005 def
+       }{
+               /blot blot-diameter def
+       } ifelse
+       blot setlinewidth
+
+       0 setlinecap
+       1 setlinejoin
+
+       blot sub /t exch def
+       blot sub /w exch def
+       w mul /h exch def
+
+       blot 2 div t 2 div neg moveto
+       w h rlineto
+       0 t rlineto
+       w neg h neg rlineto
+       0 t neg rlineto
+
+       currentdict /testing known {
+               %% outline only, for testing:
+               stroke
+       }{
+               closepath gsave stroke grestore fill
+       } ifelse
 } bind def 
 
 /draw_repeat_slash % width slope thick
 {
-  /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
+       1 setlinecap
+       1 setlinejoin
+
+       /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
 } bind def
 
 /draw_hairpin % width start_h end_h thick
 {
-  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
+       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 
 { 
-       /dir exch def 
-       setlinewidth 
        1 setlinecap 
        1 setlinejoin 
+
+       /dir exch def 
+       setlinewidth 
        /tuplet_dy exch def 
        /tuplet_dx exch def 
        /tuplet_gapx exch def 
@@ -130,13 +198,14 @@
 
 /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 
-       1 setlinecap 
-       1 setlinejoin 
        vert_start 0 eq { 
                0 0 moveto 
                0 volta_h lineto