]> git.donarmstrong.com Git - lilypond.git/commitdiff
''
authorHan-Wen Nienhuys <hanwen@xs4all.nl>
Mon, 1 Apr 2002 13:48:04 +0000 (13:48 +0000)
committerHan-Wen Nienhuys <hanwen@xs4all.nl>
Mon, 1 Apr 2002 13:48:04 +0000 (13:48 +0000)
22 files changed:
ChangeLog
buildscripts/lilypond-profile.sh
flower/include/interval.hh
input/regression/tup.ly
lily/bar-line.cc
lily/box.cc
lily/include/box.hh
lily/include/lookup.hh
lily/include/tuplet-bracket.hh
lily/lookup.cc
lily/system.cc
lily/tuplet-bracket.cc
ps/lilyponddefs.ps
scm/ascii-script.scm
scm/basic-properties.scm
scm/grob-description.scm
scm/grob-property-description.scm
scm/pdf.scm
scm/pdftex.scm
scm/ps.scm
scm/sketch.scm
scm/tex.scm

index 9c4ac9eb611fcfd0ccd7192dbb74c8ad968eb918..764e93139006efd03deba33b27f8f062160cf0f2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2002-04-01  Han-Wen  <hanwen@cs.uu.nl>
+
+       * lily/tuplet-bracket.cc (make_bracket): new function
+       (get_x_offset): new function; make tuplet brackets align on stems
+       if stem has same direction.
+       (parallel_beam): be anal about matching bracket to tuplet.
+
+       * lily/lookup.cc (line): new function Lookup::line(). 
+
+       * scm/tex.scm (dashed-line): change -line to -system in names.
+
+       * lily/box.cc (add_point): new function.
+
+       * flower/include/interval.hh: new function add_point ().
+       new function widen()
+       
 2002-04-01  Jan Nieuwenhuizen  <janneke@gnu.org>
 
        * .cvsignore: Ignore all kinds of lilypond input and output.
 2002-04-01  Jan Nieuwenhuizen  <janneke@gnu.org>
 
        * .cvsignore: Ignore all kinds of lilypond input and output.
index 1e03ea439a024d72d408d3dea040a44b2276d1b7..a68c2a784a7dbb81bd448a632f8315ea8ccab0c4 100644 (file)
@@ -9,8 +9,10 @@
 
 datadir=`echo "@datadir@" | sed 's!//!/!g'`
 
 
 datadir=`echo "@datadir@" | sed 's!//!/!g'`
 
+
 # For direct ps output: ps/lilyponddefs.ps
 GS_LIB="$datadir/ps:"${GS_LIB:=""}
 # For direct ps output: ps/lilyponddefs.ps
 GS_LIB="$datadir/ps:"${GS_LIB:=""}
+export GS_LIB
 
 # bit silly. for ly2dvi, overrules compiled-in datadir...
 # Better comment this out.  Compiled-in datadir serves exactly the
 
 # bit silly. for ly2dvi, overrules compiled-in datadir...
 # Better comment this out.  Compiled-in datadir serves exactly the
@@ -21,16 +23,14 @@ GS_LIB="$datadir/ps:"${GS_LIB:=""}
 # Add the installation directory to the teTeX system tree, 
 # see Documentation/misc/fontinstallation
 TEXMF="{$datadir,"`kpsexpand  \\$TEXMF`"}"
 # Add the installation directory to the teTeX system tree, 
 # see Documentation/misc/fontinstallation
 TEXMF="{$datadir,"`kpsexpand  \\$TEXMF`"}"
+export TEXMF
 
 # LILYPONDPREFIX="$datadir"
 # export LILYPONDPREFIX
 
 # For direct ps output fonts. Add all available TeX Type1 fonts
 
 # LILYPONDPREFIX="$datadir"
 # export LILYPONDPREFIX
 
 # For direct ps output fonts. Add all available TeX Type1 fonts
-GS_FONTPATH=`kpsewhich -expand-path=\$T1FONTS`:${GS_FONTPATH:=""}
-
-
-
-export GS_LIB GS_FONTPATH TEXMF
+GS_FONTPATH=`kpsewhich -expand-path=\\$T1FONTS`:${GS_FONTPATH:=""}
+export GS_FONTPATH
 
        
 
 
        
 
index 12d940c048cab3a132476ccd795a2c96a51e6edf..261a1c37afb99ae1f7e64a5aa980fdc5d792144d 100644 (file)
@@ -33,6 +33,11 @@ struct Interval_t : public Drul_array<T> {
       elem (LEFT) += t;
       elem (RIGHT) += t;
     }
       elem (LEFT) += t;
       elem (RIGHT) += t;
     }
+  void widen (T t)
+  {
+    elem (LEFT) -= t;
+    elem (RIGHT) += t;    
+  }
   
   /**
     PRE
   
   /**
     PRE
@@ -40,7 +45,10 @@ struct Interval_t : public Drul_array<T> {
     */
   void unite (Interval_t<T> h);
   void intersect (Interval_t<T> h);
     */
   void unite (Interval_t<T> h);
   void intersect (Interval_t<T> h);
-
+  void add_point (T p) {
+    elem(LEFT) = elem (LEFT) <? p;
+    elem(RIGHT) = elem (RIGHT) >? p;
+  }
   T length () const;
   T delta () const;
   void set_empty () ;
   T length () const;
   T delta () const;
   void set_empty () ;
index 9df691672b2e27bc5d7baa353250dbaaecaf7516..970f0e80c26587c13dbd948da94df653af152f0a 100644 (file)
@@ -1,12 +1,20 @@
 \version "1.3.146"
 \header{
 \version "1.3.146"
 \header{
+    
 texidoc="
 Tuplets are indicated by a bracket with a number.  There should be no
 texidoc="
 Tuplets are indicated by a bracket with a number.  There should be no
-bracket if there is one beam that matches  the length of the tuplet.
+bracket if there is a beam exactly  matching  the length of the tuplet.
 The bracket does not interfere with the stafflines, and the number is
 centered in the gap in the bracket.
 The bracket does not interfere with the stafflines, and the number is
 centered in the gap in the bracket.
+
+The bracket stops at the end of the stems, if the stems have the same
+direction as the
+
+
 "
 "
+
 }
 }
+
 \score{
        \notes \context Voice \relative c'' {
                 \times 2/3 { \times 2/3 { a8 b c}  c }
 \score{
        \notes \context Voice \relative c'' {
                 \times 2/3 { \times 2/3 { a8 b c}  c }
index 61a1095250dfb1edba7a38a17b47c740294bc79c..c6fb214fce1ee2e97281ae50829ed3b4d4679d7e 100644 (file)
@@ -5,6 +5,7 @@
 
   (c)  1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 */
 
   (c)  1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 */
+
 #include <math.h>
 
 #include "lookup.hh"
 #include <math.h>
 
 #include "lookup.hh"
index 03be5e9a0ab69f830553eeedb91f5d89a88ea01e..a74a6a7ad0fe9ec1d10a84fe87a2fe95bd458bb7 100644 (file)
@@ -61,3 +61,10 @@ Box::scale (Real s)
   interval_a_[X_AXIS] *= s;
   interval_a_[Y_AXIS] *= s;
 }
   interval_a_[X_AXIS] *= s;
   interval_a_[Y_AXIS] *= s;
 }
+
+void
+Box::add_point (Offset o)
+{
+  interval_a_[X_AXIS].add_point (o[X_AXIS]);
+  interval_a_[Y_AXIS].add_point (o[Y_AXIS]);  
+}
index 3c0b533ffb19c7adf763b7f0efff868f8bbd218a..8e7b57417b5cc2db3fd6bc64358244733ae0f841 100644 (file)
@@ -26,6 +26,7 @@ struct Box
   void translate (Offset o);
   /// smallest box enclosing #b#
   void set_empty ();
   void translate (Offset o);
   /// smallest box enclosing #b#
   void set_empty ();
+  void add_point (Offset);
   void scale (Real r);
   void unite (Box b);
   Box ();
   void scale (Real r);
   void unite (Box b);
   Box ();
index fca7ccea693ff45fbe48d5ff38e89830b1436556..246cf4ba21f76e65eedbab35adb2415fd2d0beff 100644 (file)
@@ -30,6 +30,7 @@ struct Lookup
   static Molecule filledbox (Box b);
   static Molecule roundfilledbox (Box b, Real blotdiameter);
   static Molecule repeat_slash (Real w, Real slope, Real th);
   static Molecule filledbox (Box b);
   static Molecule roundfilledbox (Box b, Real blotdiameter);
   static Molecule repeat_slash (Real w, Real slope, Real th);
+  static Molecule line (Real th, Offset from, Offset to);
 };
 
 #endif // LOOKUP_HH
 };
 
 #endif // LOOKUP_HH
index b50780aba6f7415f4b9d684afe2c815a2bbdacb4..86a89262f79284295efd8f9cc3b2463c21ac7b34 100644 (file)
@@ -1,4 +1,3 @@
-
 /*
   tuplet-bracket.hh -- part of GNU LilyPond
 
 /*
   tuplet-bracket.hh -- part of GNU LilyPond
 
@@ -25,12 +24,17 @@ public:
 
   static void add_column (Grob*me,Item*);
   static void add_beam (Grob*me,Grob*);
 
   static void add_column (Grob*me,Item*);
   static void add_beam (Grob*me,Grob*);
-
+  static Grob *parallel_beam (Grob *me, Link_array<Grob> cols, bool *equally_long);
   static void calc_dy (Grob*,Real *) ;
   static void calc_position_and_height (Grob*,Real*,Real *dy);
   
   DECLARE_SCHEME_CALLBACK (after_line_breaking, (SCM ));
 
   static void calc_dy (Grob*,Real *) ;
   static void calc_position_and_height (Grob*,Real*,Real *dy);
   
   DECLARE_SCHEME_CALLBACK (after_line_breaking, (SCM ));
 
+  DECLARE_SCHEME_CALLBACK (before_line_breaking, (SCM ));
+  static Molecule make_bracket (Axis protusion_axis,
+                               Real dx, Real dy, Real thick, Real lprotrusion,
+                               Real rprotrusion, Real gap, Real left_widen,
+                               Real right_widen);
   static Direction get_default_dir (Grob*);
 };
 
   static Direction get_default_dir (Grob*);
 };
 
index e8f5bb03fc9d09b50a2ce6d1e657e41b29ca58db..7c26235b3728aa39137c1ec269ddb405b605b604 100644 (file)
@@ -65,6 +65,28 @@ Lookup::dashed_slur (Bezier b, Real thick, Real dash)
   return   Molecule (box, at);
 }
 
   return   Molecule (box, at);
 }
 
+Molecule
+Lookup::line (Real th, Offset f, Offset t)
+{
+  SCM at = (scm_list_n (ly_symbol2scm ("draw-line"),
+                       gh_double2scm (th), 
+                       gh_double2scm (f[X_AXIS]),
+                       gh_double2scm (f[Y_AXIS]),
+                       gh_double2scm (t[X_AXIS]),
+                       gh_double2scm (t[Y_AXIS]),
+                       SCM_UNDEFINED));
+
+  Box box;
+  box.add_point (f);
+  box.add_point (t);
+
+  box[X_AXIS].widen (th/2);
+  box[Y_AXIS].widen (th/2);  
+
+  return Molecule (box, at);
+}
+
+
 Molecule
 Lookup::blank (Box b) 
 {
 Molecule
 Lookup::blank (Box b) 
 {
index 75f0bf4916b1b472889402d8deb8333bd0960ada..d4e81941323315296761dd92b0d75189db4106d9 100644 (file)
@@ -428,7 +428,7 @@ System::post_processing (bool last_line)
   /*
     line preamble.
    */
   /*
     line preamble.
    */
-  output_scheme (scm_list_n (ly_symbol2scm ("start-line"),
+  output_scheme (scm_list_n (ly_symbol2scm ("start-system"),
                          gh_double2scm (height),
                          SCM_UNDEFINED));
   
                          gh_double2scm (height),
                          SCM_UNDEFINED));
   
@@ -472,11 +472,11 @@ System::post_processing (bool last_line)
   
   if (last_line)
     {
   
   if (last_line)
     {
-      output_scheme (scm_list_n (ly_symbol2scm ("stop-last-line"), SCM_UNDEFINED));
+      output_scheme (scm_list_n (ly_symbol2scm ("stop-last-system"), SCM_UNDEFINED));
     }
   else
     {
     }
   else
     {
-      output_scheme (scm_list_n (ly_symbol2scm ("stop-line"), SCM_UNDEFINED));
+      output_scheme (scm_list_n (ly_symbol2scm ("stop-system"), SCM_UNDEFINED));
     }
 }
 
     }
 }
 
index 4b857da02f9413ef73805dcd9e446c083282c3e1..bfcc48bfdb3e160938ba1c05b5db9e4babe600a0 100644 (file)
@@ -6,6 +6,22 @@
   (c)  1997--2002 Jan Nieuwenhuizen <janneke@gnu.org>
 */
 
   (c)  1997--2002 Jan Nieuwenhuizen <janneke@gnu.org>
 */
 
+/*
+  TODO:
+
+  - tuplet bracket should probably be subject to the same rules as
+  beam sloping/quanting.
+
+  - There is no support for kneed brackets, or nested brackets.
+
+  - number placement for parallel beams should be much more advanced:
+    for sloped beams some extra horizontal offset must be introduced.
+
+  - number placement is usually done over the center note, not the
+    graphical center.
+  
+ */
+
 #include <math.h>
 
 #include "beam.hh"
 #include <math.h>
 
 #include "beam.hh"
 #include "debug.hh"
 #include "font-interface.hh"
 #include "molecule.hh"
 #include "debug.hh"
 #include "font-interface.hh"
 #include "molecule.hh"
-#include "paper-column.hh"
 #include "paper-def.hh"
 #include "text-item.hh"
 #include "tuplet-bracket.hh"
 #include "stem.hh"
 #include "note-column.hh"
 #include "paper-def.hh"
 #include "text-item.hh"
 #include "tuplet-bracket.hh"
 #include "stem.hh"
 #include "note-column.hh"
-#include "dimensions.hh"
 #include "group-interface.hh"
 #include "directional-element-interface.hh"
 #include "spanner.hh"
 #include "staff-symbol-referencer.hh"
 #include "group-interface.hh"
 #include "directional-element-interface.hh"
 #include "spanner.hh"
 #include "staff-symbol-referencer.hh"
+#include "lookup.hh"
+
+
+static Real
+get_x_offset (Grob *g, Grob *common, Direction my_dir)
+{
+  if (Note_column::stem_l (g)
+      && Note_column::dir (g) == my_dir)
+    {
+      g = Note_column::stem_l (g);
+    }
+  return g->relative_coordinate (common, X_AXIS);
+}
+
+
+
+Grob*
+Tuplet_bracket::parallel_beam (Grob *me, Link_array<Grob> cols, bool *equally_long)
+{
+  /*
+    ugh: code dup. 
+  */
+  Grob *s1 = Note_column::stem_l (cols[0]); 
+  Grob *s2 = Note_column::stem_l (cols.top());    
+
+  Grob*b1 = s1 ? Stem::beam_l (s1) : 0;
+  Grob*b2 = s2 ? Stem::beam_l (s2) : 0;
+  
+  Spanner*sp = dynamic_cast<Spanner*> (me);  
+
+  *equally_long= false;
+  if (! ( b1 && (b1 == b2) && !sp->broken_b() ))
+      return 0;
+
+  Link_array<Grob> beam_stems = Pointer_group_interface__extract_grobs
+    (b1, (Grob*)0, "stems");
+
+  
+  *equally_long = (beam_stems[0] == s1 && beam_stems.top() == s2);
+  return b1;
+}
+
 
 /*
   TODO:
 
 /*
   TODO:
@@ -39,29 +95,23 @@ Tuplet_bracket::brew_molecule (SCM smob)
   Grob *me= unsmob_grob (smob);
   Molecule  mol;
   Link_array<Grob> column_arr=
   Grob *me= unsmob_grob (smob);
   Molecule  mol;
   Link_array<Grob> column_arr=
-    Pointer_group_interface__extract_grobs (me, (Grob*)0, "columns");
-
+    Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
 
   if (!column_arr.size ())
     return mol.smobbed_copy ();
 
 
   if (!column_arr.size ())
     return mol.smobbed_copy ();
 
+  bool equally_long = false;
+  Grob * par_beam = parallel_beam (me, column_arr, &equally_long);
 
 
-  Grob *b1 = Note_column::stem_l (column_arr[0]); 
-  Grob *b2 = Note_column::stem_l (column_arr.top());    
-
-  b1 = b1 ? Stem::beam_l (b1) : 0;
-  b2 = b2 ? Stem::beam_l (b2) : 0;
-
-  
   Spanner*sp = dynamic_cast<Spanner*> (me);  
 
   Spanner*sp = dynamic_cast<Spanner*> (me);  
 
-  // Default behaviour: number always, bracket when no beam!
-  bool par_beam = b1 && (b1 == b2) && !sp->broken_b() ;
-  
-  bool bracket_visibility = !par_beam;
+  bool bracket_visibility = !(par_beam && equally_long);
   bool number_visibility = true;
 
   bool number_visibility = true;
 
-  SCM bracket = me->get_grob_property ("tuplet-bracket-visibility");
+  /*
+    Fixme: the type of this prop is sucky.
+   */
+  SCM bracket = me->get_grob_property ("bracket-visibility");
   if (gh_boolean_p (bracket))
     {
       bracket_visibility = gh_scm2bool (bracket);
   if (gh_boolean_p (bracket))
     {
       bracket_visibility = gh_scm2bool (bracket);
@@ -69,21 +119,25 @@ Tuplet_bracket::brew_molecule (SCM smob)
   else if (bracket == ly_symbol2scm ("if-no-beam"))
     bracket_visibility = !par_beam;
 
   else if (bracket == ly_symbol2scm ("if-no-beam"))
     bracket_visibility = !par_beam;
 
-  SCM numb = me->get_grob_property ("tuplet-number-visibility");  
+  SCM numb = me->get_grob_property ("number-visibility");  
   if (gh_boolean_p (numb))
     {
       number_visibility = gh_scm2bool (numb);
     }
   else if (numb == ly_symbol2scm ("if-no-beam"))
     number_visibility = !par_beam;
   if (gh_boolean_p (numb))
     {
       number_visibility = gh_scm2bool (numb);
     }
   else if (numb == ly_symbol2scm ("if-no-beam"))
     number_visibility = !par_beam;
-  
        
        
-  Real ncw = column_arr.top ()->extent (column_arr.top (), X_AXIS).length ();
-  Real w = sp->spanner_length () + ncw;
-
+  Grob * commonx = column_arr[0]->common_refpoint (column_arr.top (),X_AXIS);
   Direction dir = Directional_element_interface::get (me);
   Direction dir = Directional_element_interface::get (me);
-  Real dy = gh_scm2double (me->get_grob_property ("delta-y"));
+      
+  Real x0 = get_x_offset (column_arr[0], commonx, dir);
+  Real x1 = get_x_offset (column_arr.top(), commonx, dir);
+  Real w = x1 -x0;
+
+  Real ly = gh_scm2double (me->get_grob_property ("left-position"));
+  Real ry = gh_scm2double (me->get_grob_property ("right-position"));  
   SCM number = me->get_grob_property ("text");
   SCM number = me->get_grob_property ("text");
+  
   if (gh_string_p (number) && number_visibility)
     {
       SCM properties = Font_interface::font_alist_chain (me);
   if (gh_string_p (number) && number_visibility)
     {
       SCM properties = Font_interface::font_alist_chain (me);
@@ -92,7 +146,7 @@ Tuplet_bracket::brew_molecule (SCM smob)
       num.translate_axis (w/2, X_AXIS);
       num.align_to (Y_AXIS, CENTER);
        
       num.translate_axis (w/2, X_AXIS);
       num.align_to (Y_AXIS, CENTER);
        
-      num.translate_axis (dy/2, Y_AXIS);
+      num.translate_axis ((ry-ly)/2, Y_AXIS);
 
       mol.add_molecule (num);
     }
 
       mol.add_molecule (num);
     }
@@ -100,28 +154,68 @@ Tuplet_bracket::brew_molecule (SCM smob)
   if (bracket_visibility)      
     {
       Real  lt =  me->paper_l ()->get_var ("linethickness");
   if (bracket_visibility)      
     {
       Real  lt =  me->paper_l ()->get_var ("linethickness");
-         
-      SCM thick = me->get_grob_property ("thick");
-      SCM gap = me->get_grob_property ("number-gap");
-         
-      SCM at =scm_list_n (ly_symbol2scm ("tuplet"),
-                      gh_double2scm (1.0),
-                      gap,
-                      gh_double2scm (w),
-                      gh_double2scm (dy),
-                      gh_double2scm (gh_scm2double (thick)* lt),
-                      gh_int2scm (dir),
-                      SCM_UNDEFINED);
-
-      Box b;
-      mol.add_molecule (Molecule (b, at));
+  
+      SCM thick = me->get_grob_property ("thickness");
+      if (gh_number_p (thick))
+       lt *= gh_scm2double (thick);
+      
+      SCM gap = me->get_grob_property ("gap");
+
+      Real prot_size = 0.7;    // magic.
+
+      Molecule brack = make_bracket (Y_AXIS,
+                                    w, ry-ly, lt,
+                                    -prot_size*dir, -prot_size*dir,
+                                    gh_scm2double (gap),
+                                    0.0, 0.0);
+      mol.add_molecule (brack);
     }
 
     }
 
+  mol.translate_axis (ly, Y_AXIS);
+  mol.translate_axis (x0  - sp->get_bound (LEFT)->relative_coordinate (commonx,X_AXIS),X_AXIS);
   return mol.smobbed_copy ();
 }
 
   return mol.smobbed_copy ();
 }
 
+/*
+  should move to lookup?
+ */
+Molecule
+Tuplet_bracket::make_bracket (Axis protusion_axis,
+                             Real dx, Real dy, Real thick, Real lprotrusion,
+                             Real rprotrusion, Real gap, Real left_widen,
+                             Real right_widen)
+{
+  Real len = Offset (dx,dy).length ();
+  Real gapx = dx*  (gap /  len);
+  Real gapy = dy*  (gap /  len);
+  Axis other = other_axis (protusion_axis);
+
+  Molecule l1 = Lookup::line (thick, Offset(0,0),
+                             Offset ( (dx - gapx)/2, (dy - gapy)/2 ));
+  Molecule l2 = Lookup::line (thick, Offset((dx + gapx) / 2,(dy + gapy) / 2),
+                             
+                             Offset (dx,dy));
+
+  Offset protusion;
+  protusion[other] = left_widen;
+  protusion[protusion_axis] = lprotrusion;
+  
+  Molecule p1 = Lookup::line (thick, Offset(0,0), protusion);
+
+  protusion[other] = right_widen;
+  protusion[protusion_axis] = rprotrusion;
+  Molecule p2 = Lookup::line (thick, Offset(dx,dy),Offset(dx,dy) + protusion);  
 
 
 
 
+  Molecule m;
+  m.add_molecule (p1);
+  m.add_molecule (p2);
+  m.add_molecule (l1);
+  m.add_molecule (l2);
+
+  return m;  
+}
+
 
 /*
   use first -> last note for slope, and then correct for disturbing
 
 /*
   use first -> last note for slope, and then correct for disturbing
@@ -130,11 +224,11 @@ void
 Tuplet_bracket::calc_position_and_height (Grob*me,Real *offset, Real * dy) 
 {
   Link_array<Grob> column_arr=
 Tuplet_bracket::calc_position_and_height (Grob*me,Real *offset, Real * dy) 
 {
   Link_array<Grob> column_arr=
-    Pointer_group_interface__extract_grobs (me, (Grob*)0, "columns");
+    Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
 
 
 
 
-  Grob * commony = me->common_refpoint (me->get_grob_property ("columns"), Y_AXIS);
-  Grob * commonx = me->common_refpoint (me->get_grob_property ("columns"), X_AXIS);  
+  Grob * commony = me->common_refpoint (me->get_grob_property ("note-columns"), Y_AXIS);
+  Grob * commonx = me->common_refpoint (me->get_grob_property ("note-columns"), X_AXIS);  
   
   Direction d = Directional_element_interface::get (me);
 
   
   Direction d = Directional_element_interface::get (me);
 
@@ -162,10 +256,15 @@ Tuplet_bracket::calc_position_and_height (Grob*me,Real *offset, Real * dy)
 
   if (!column_arr.size ())
     return;
 
   if (!column_arr.size ())
     return;
+
+
   
   
-  Real x0 = column_arr[0]->relative_coordinate (commonx, X_AXIS);
-  Real x1 = column_arr.top ()->relative_coordinate (commonx, X_AXIS);
-  
+  Real x0 = get_x_offset (column_arr[0], commonx, d);
+  Real x1 = get_x_offset (column_arr.top(), commonx, d);
+
+    /*
+      Slope.
+    */
   Real factor = column_arr.size () > 1 ? 1/ (x1 - x0) : 1.0;
   
   for (int i = 0; i < column_arr.size ();  i++)
   Real factor = column_arr.size () > 1 ? 1/ (x1 - x0) : 1.0;
   
   for (int i = 0; i < column_arr.size ();  i++)
@@ -181,13 +280,11 @@ Tuplet_bracket::calc_position_and_height (Grob*me,Real *offset, Real * dy)
     }
 
   // padding
     }
 
   // padding
-  *offset +=  1.0 *d;
+  *offset +=  gh_scm2double (me->get_grob_property ("padding")) *d;
 
   
   /*
     horizontal brackets should not collide with staff lines.
 
   
   /*
     horizontal brackets should not collide with staff lines.
-
-    
    */
   if (*dy == 0)
     {
    */
   if (*dy == 0)
     {
@@ -211,7 +308,7 @@ void
 Tuplet_bracket::calc_dy (Grob*me,Real * dy)
 {
   Link_array<Grob> column_arr=
 Tuplet_bracket::calc_dy (Grob*me,Real * dy)
 {
   Link_array<Grob> column_arr=
-    Pointer_group_interface__extract_grobs (me, (Grob*)0, "columns");
+    Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
 
   /*
     ugh. refps.
 
   /*
     ugh. refps.
@@ -220,45 +317,113 @@ Tuplet_bracket::calc_dy (Grob*me,Real * dy)
   *dy = column_arr.top ()->extent (column_arr.top (), Y_AXIS) [d]
     - column_arr[0]->extent (column_arr[0], Y_AXIS) [d];
 }
   *dy = column_arr.top ()->extent (column_arr.top (), Y_AXIS) [d]
     - column_arr[0]->extent (column_arr[0], Y_AXIS) [d];
 }
+
+
+/*
+  We depend on the beams if there are any.
+ */
+MAKE_SCHEME_CALLBACK (Tuplet_bracket,before_line_breaking,1);
+SCM
+Tuplet_bracket::before_line_breaking (SCM smob)
+{
+  Grob *me = unsmob_grob (smob);
+  Link_array<Grob> column_arr=
+    Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
+
+
+  for (int i = column_arr.size(); i--;)
+    {
+      Grob * s =Note_column::stem_l (column_arr[i]);
+      Grob * b = s ? Stem::beam_l (s): 0;
+      if (b)
+       me->add_dependency (b);
+    }
+  return SCM_UNDEFINED;
+}
+
 MAKE_SCHEME_CALLBACK (Tuplet_bracket,after_line_breaking,1);
 
 SCM
 Tuplet_bracket::after_line_breaking (SCM smob)
 {
   Grob * me = unsmob_grob (smob);
 MAKE_SCHEME_CALLBACK (Tuplet_bracket,after_line_breaking,1);
 
 SCM
 Tuplet_bracket::after_line_breaking (SCM smob)
 {
   Grob * me = unsmob_grob (smob);
-  Link_array<Note_column> column_arr=
-    Pointer_group_interface__extract_grobs (me, (Note_column*)0, "columns");
+  Link_array<Grob> column_arr=
+    Pointer_group_interface__extract_grobs (me, (Grob*)0, "note-columns");
 
   if (!column_arr.size ())
     {
       me->suicide ();
       return SCM_UNSPECIFIED;
     }
 
   if (!column_arr.size ())
     {
       me->suicide ();
       return SCM_UNSPECIFIED;
     }
-
-  Direction d = Directional_element_interface::get (me);
-  if (!d)
+  if (dynamic_cast<Spanner*> (me)->broken_b ())
     {
     {
-      d = Tuplet_bracket::get_default_dir (me);
-      Directional_element_interface::set (me, d);
-
+      me->warning ( "Tuplet_bracket was across linebreak. Farewell cruel world.");
+      me->suicide();
+      return SCM_UNSPECIFIED;
     }
     }
+  
+  Direction dir = Directional_element_interface::get (me);
+  if (!dir)
+    {
+      dir = Tuplet_bracket::get_default_dir (me);
+      Directional_element_interface::set (me, dir);
+    }
+  
+  bool equally_long = false;
+  Grob * par_beam = parallel_beam (me, column_arr, &equally_long);
+
   Real dy, offset;
   Real dy, offset;
+  if (!par_beam)
+    {
+      calc_position_and_height (me,&offset,&dy);
+    }
+  else
+    {
+      SCM ps =  par_beam->get_grob_property ("positions"); 
 
 
-  calc_position_and_height (me,&offset,&dy);
+      Real lp = gh_scm2double (gh_car (ps));
+      Real rp = gh_scm2double (gh_cdr (ps));
 
 
-  if (!gh_number_p (me->get_grob_property ("delta-y")))
-    me->set_grob_property ("delta-y", gh_double2scm (dy));
+      /*
+       duh. magic.
+       */
+      offset = lp + dir * (0.5 + gh_scm2double (me->get_grob_property ("padding")));
+      dy = rp- lp;
+    }
+  
+  
+  SCM lp =  me->get_grob_property ("left-position");
+  SCM rp = me->get_grob_property ("right-position");  
+  
+  if (gh_number_p (lp) && !gh_number_p (rp))
+    {
+      rp = gh_double2scm (gh_scm2double (lp) + dy);
+    }
+  else if (gh_number_p (rp) && !gh_number_p (lp))
+    {
+      lp = gh_double2scm (gh_scm2double (rp) - dy);
+    }
+  else if (!gh_number_p (rp) && !gh_number_p (lp))
+    {
+      lp = gh_double2scm (offset);
+      rp = gh_double2scm (offset +dy);
+    }
+
+  me->set_grob_property ("left-position", lp);
+  me->set_grob_property ("right-position", rp);
 
 
-  me->translate_axis (offset, Y_AXIS);
   return SCM_UNSPECIFIED;
 }
 
 
   return SCM_UNSPECIFIED;
 }
 
 
+/*
+  similar to slur.
+ */
 Direction
 Tuplet_bracket::get_default_dir (Grob*me)
 {
   Direction d = UP;
 Direction
 Tuplet_bracket::get_default_dir (Grob*me)
 {
   Direction d = UP;
-  for (SCM s = me->get_grob_property ("columns"); gh_pair_p (s); s = ly_cdr (s))
+  for (SCM s = me->get_grob_property ("note-columns"); gh_pair_p (s); s = ly_cdr (s))
     {
       Grob * nc = unsmob_grob (ly_car (s));
       if (Note_column::dir (nc) < 0) 
     {
       Grob * nc = unsmob_grob (ly_car (s));
       if (Note_column::dir (nc) < 0) 
@@ -267,14 +432,13 @@ Tuplet_bracket::get_default_dir (Grob*me)
          break;
        }
     }
          break;
        }
     }
-  
   return d;
 }
 
 void
 Tuplet_bracket::add_column (Grob*me, Item*n)
 {
   return d;
 }
 
 void
 Tuplet_bracket::add_column (Grob*me, Item*n)
 {
-  Pointer_group_interface::add_grob (me, ly_symbol2scm ("columns"), n);
+  Pointer_group_interface::add_grob (me, ly_symbol2scm ("note-columns"), n);
   me->add_dependency (n);
 
   add_bound_item (dynamic_cast<Spanner*> (me), n);
   me->add_dependency (n);
 
   add_bound_item (dynamic_cast<Spanner*> (me), n);
@@ -292,5 +456,5 @@ Tuplet_bracket::has_interface (Grob*me)
 
 ADD_INTERFACE (Tuplet_bracket,"tuplet-bracket-interface",
   "A bracket with a number in the middle, used for tuplets.",
 
 ADD_INTERFACE (Tuplet_bracket,"tuplet-bracket-interface",
   "A bracket with a number in the middle, used for tuplets.",
-  "columns number-gap delta-y tuplet-bracket-visibility tuplet-number-visibility thick direction");
+  "note-columns padding gap left-position right-position bracket-visibility number-visibility thickness direction");
 
 
index ebde4b6a1b1e76fed1866c606bd296a7618494a0..991dc58caa7c5263f54dba3720469e3e9a6e6762 100644 (file)
@@ -5,7 +5,7 @@
 % hmm
 % /setgray { 1 add } bind def
 
 % hmm
 % /setgray { 1 add } bind def
 
-/staff-line-thickness lilypondpaperstafflinethickness def
+/staff-line-thickness lilypondpaperlinethickness def
 /staff-height lilypondpaperstaffheight def
 /line-width lilypondpaperlinewidth def
 
 /staff-height lilypondpaperstaffheight def
 /line-width lilypondpaperlinewidth def
 
@@ -56,7 +56,7 @@ output-scale output-scale scale
        grestore
 } bind def
 
        grestore
 } bind def
 
-/start-line % height
+/start-system % height
 {
        dup base-line-skip gt {
                /line-height exch def
 {
        dup base-line-skip gt {
                /line-height exch def
@@ -72,7 +72,7 @@ output-scale output-scale scale
        line-x line-y translate
 } bind def
 
        line-x line-y translate
 } bind def
 
-/stop-line
+/stop-system
 { 
        /the-line exch def
        the-line
 { 
        /the-line exch def
        the-line
index dc8f8f1d2075ad427b8d2c0a4879b971b414bc25..9adfa9f6c581f49f837fde6f358556b821ca40ac 100644 (file)
        "")                             ; issue no command
     (func "select-font" (car name-mag-pair))))
 
        "")                             ; issue no command
     (func "select-font" (car name-mag-pair))))
 
-(define (start-line height)
-  (func "start-line" height))
+(define (start-system height)
+  (func "start-system" height))
 
 
-(define (stop-line)
-  (func "stop-line"))
+(define (stop-system)
+  (func "stop-system"))
 
 
-(define (stop-last-line)
-  (func "stop-line"))
+(define (stop-last-system)
+  (func "stop-system"))
 
 
 (define (text s)
 
 
 (define (text s)
index fc67638e84bf142b2867d1c5bf858467bcd20c7a..be293a5b7609952c1a130f65274b7c3eef989ed7 100644 (file)
 (define (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
 
 
 (define (end-of-line-invisible d) (if (= d -1) '(#t . #t) '(#f . #f)))
 
 
-(define mark-visibility end-of-line-invisible)
-
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; Bar lines.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; Bar lines.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
index 74f73f50619281b8763e94a4de708f09add132b4..d5e27b3546da9a21cf2fa74a6a12dc37a322cf92 100644 (file)
 
     (TupletBracket
      . (
 
     (TupletBracket
      . (
-       (number-gap . 2.0)   
-       (thick . 1.0)
+       (gap . 2.0)
+       (padding . 0.9)
+       (thickness . 1.6)
+       (before-line-breaking-callback . ,Tuplet_bracket::before_line_breaking)
        (after-line-breaking-callback . ,Tuplet_bracket::after_line_breaking)
        (molecule-callback . ,Tuplet_bracket::brew_molecule)
        (font-family . roman)
        (font-shape . italic)
        (after-line-breaking-callback . ,Tuplet_bracket::after_line_breaking)
        (molecule-callback . ,Tuplet_bracket::brew_molecule)
        (font-family . roman)
        (font-shape . italic)
+
        (font-relative-size . -1)
        (meta .  ((interfaces . (text-interface tuplet-bracket-interface font-interface))))
        ))
        (font-relative-size . -1)
        (meta .  ((interfaces . (text-interface tuplet-bracket-interface font-interface))))
        ))
index 38a92f16a9f219e6c9a46b37fdb905e5331dd693..f2f98584f075709c9dd1d8b1def1550b345cb7b6 100644 (file)
@@ -102,7 +102,7 @@ square of the inner notes involved.")
 (grob-property-description 'bar-line-collapse-height number? "Minimum height of system start delimiter bar-line glyphs.  If equal or smaller, the bar-line is removed.")
 (grob-property-description 'brace-collapse-height number? "Minimum height of system start delimiter brace glyphs.  If equal or smaller, the brace is removed.")
 (grob-property-description 'bracket-collapse-height number? "Minimum height of system start delimiter bracket glyphs.  If equal or smaller, the bracket is removed.")
 (grob-property-description 'bar-line-collapse-height number? "Minimum height of system start delimiter bar-line glyphs.  If equal or smaller, the bar-line is removed.")
 (grob-property-description 'brace-collapse-height number? "Minimum height of system start delimiter brace glyphs.  If equal or smaller, the brace is removed.")
 (grob-property-description 'bracket-collapse-height number? "Minimum height of system start delimiter bracket glyphs.  If equal or smaller, the bracket is removed.")
-(grob-property-description 'columns list? "list of grobs, typically containing paper-columns, list of note-columns.")
+(grob-property-description 'columns list? "list of grobs, typically containing paper-columns.")
 (grob-property-description 'control-points list? "List of 4 offsets (number-pairs) that form control points for the  tie/slur shape.")
 (grob-property-description 'damping integer? "amount of beam slope damping should beam slope be damped? 0: no, 1: yes, 100000: horizontal beams .")
 (grob-property-description 'dash-length number? "the length of a dash.")
 (grob-property-description 'control-points list? "List of 4 offsets (number-pairs) that form control points for the  tie/slur shape.")
 (grob-property-description 'damping integer? "amount of beam slope damping should beam slope be damped? 0: no, 1: yes, 100000: horizontal beams .")
 (grob-property-description 'dash-length number? "the length of a dash.")
@@ -205,6 +205,8 @@ For text,  this is `relative'(?) to the current alignment.
 For barline, space after a thick line.")
 (grob-property-description 'layer number? "The output layer [0..2].  The default is 1.")
 
 For barline, space after a thick line.")
 (grob-property-description 'layer number? "The output layer [0..2].  The default is 1.")
 
+(grob-property-description 'left-position number? "position of left part of spanner.")
+(grob-property-description 'right-position number? "position of right part of spanner.")
 (grob-property-description 'left-padding number? "space left of accs.")
 (grob-property-description 'right-head ly-grob? "")
 (grob-property-description 'left-head ly-grob? "")
 (grob-property-description 'left-padding number? "space left of accs.")
 (grob-property-description 'right-head ly-grob? "")
 (grob-property-description 'left-head ly-grob? "")
@@ -256,7 +258,6 @@ FIXME: also pair? (cons LEFT RIGHT)
 (grob-property-description 'non-default boolean? "not set because of existence of a bar?.")
 (grob-property-description 'note-width number? "unit for horizontal translation, measured in staff-space.")
 (grob-property-description 'note-heads list? "List of note head grobs")
 (grob-property-description 'non-default boolean? "not set because of existence of a bar?.")
 (grob-property-description 'note-width number? "unit for horizontal translation, measured in staff-space.")
 (grob-property-description 'note-heads list? "List of note head grobs")
-(grob-property-description 'number-gap number? "size of the gap for tohe number in a tuplet.")
 (grob-property-description 'old-accidentals list? "list of (pitch, accidental) pairs.")
 (grob-property-description 'padding number? "add this much extra space between objects that are next to each other.")
 (grob-property-description 'paren-cautionaries boolean? "Whether to add parenthesis around cautionary accidentals.")
 (grob-property-description 'old-accidentals list? "list of (pitch, accidental) pairs.")
 (grob-property-description 'padding number? "add this much extra space between objects that are next to each other.")
 (grob-property-description 'paren-cautionaries boolean? "Whether to add parenthesis around cautionary accidentals.")
@@ -377,7 +378,6 @@ The following abbreviations are currently defined:
 @end table
 .")
 (grob-property-description 'text-start boolean? "Indicator for whether a piano pedal bracket has leading text, such as Ped.")
 @end table
 .")
 (grob-property-description 'text-start boolean? "Indicator for whether a piano pedal bracket has leading text, such as Ped.")
-(grob-property-description 'thick number? "thickness, in stafflinethickness.")
 (grob-property-description 'thick-thickness number? "thickness, measured in stafflinethickness.")
 (grob-property-description 'thickness number? "thickness, measured in stafflinethickness.")
 (grob-property-description 'thin-kern number? "space after a hair-line.")
 (grob-property-description 'thick-thickness number? "thickness, measured in stafflinethickness.")
 (grob-property-description 'thickness number? "thickness, measured in stafflinethickness.")
 (grob-property-description 'thin-kern number? "space after a hair-line.")
@@ -388,13 +388,13 @@ The following abbreviations are currently defined:
 same as setting molecule-callback to #f, but this retains the
 dimensions of this grob, which means that you can erase grobs
 individually. .")
 same as setting molecule-callback to #f, but this retains the
 dimensions of this grob, which means that you can erase grobs
 individually. .")
-(grob-property-description 'tuplet-bracket-visibility boolean-or-symbol? "
+(grob-property-description 'bracket-visibility boolean-or-symbol? "
 This controls the visibility of the tuplet bracket.
 Setting it to false will prevent printing of the
 bracket. Setting the property to #'if-no-beam will make it
 print only if there is no beam associated with this tuplet bracket.")
 This controls the visibility of the tuplet bracket.
 Setting it to false will prevent printing of the
 bracket. Setting the property to #'if-no-beam will make it
 print only if there is no beam associated with this tuplet bracket.")
-(grob-property-description 'tuplet-number-visibility boolean-or-symbol? "
-Like @code{tuplet-bracket-visibility}, but for the number.")
+(grob-property-description 'number-visibility boolean-or-symbol? "
+Like @code{bracket-visibility}, but for the number.")
 (grob-property-description 'type symbol? "one of: line, dashed-line or dotted-line.")
 (grob-property-description 'visibility-lambda procedure? "a function that takes the break direction and returns a  cons of booleans containing (TRANSPARENT . EMPTY).")
 (grob-property-description 'when moment? "when does this column happen?.")
 (grob-property-description 'type symbol? "one of: line, dashed-line or dotted-line.")
 (grob-property-description 'visibility-lambda procedure? "a function that takes the break direction and returns a  cons of booleans containing (TRANSPARENT . EMPTY).")
 (grob-property-description 'when moment? "when does this column happen?.")
@@ -440,8 +440,9 @@ columns.
 (grob-property-description 'chord pair? "?")
 (grob-property-description 'begin-of-line-visible boolean? "?")
 
 (grob-property-description 'chord pair? "?")
 (grob-property-description 'begin-of-line-visible boolean? "?")
 
-(grob-property-description 'quant-score number? "Beam quanting score")
-
+(grob-property-description 'quant-score number? "Beam quanting score
+-- can be stored for debugging")
 (grob-property-description 'least-squares-dy number? 
  "ideal beam slope, without damping.")
 (grob-property-description 'stem-info pair? "caching of stem parameters")
 (grob-property-description 'least-squares-dy number? 
  "ideal beam slope, without damping.")
 (grob-property-description 'stem-info pair? "caching of stem parameters")
+(grob-property-description 'note-columns pair? "list of NoteColumn grobs.")
index a47e67f4f88d4a70ff21e93e9a0ba9a1f1446f93..47552c9d225a4c40528b161face9649e9cc5df00 100644 (file)
 ;;; 
 ;;; (c) 2001 Stephen Peters <portnoy@portnoy.org>
 
 ;;; 
 ;;; (c) 2001 Stephen Peters <portnoy@portnoy.org>
 
-; currently no font commands; this is a helper for pdftex.scm.
-
-(define (pdf-scm action-name)
-  ; simple commands to store and update currentpoint.  This makes the
-  ; other procedures simple rewrites of the PostScript code.
-  (define currentpoint (cons 0 0))
-  (define (showcp) 
-    (string-append (ly-number->string (car currentpoint)) " " 
-                  (ly-number->string (cdr currentpoint)) " "))
-  (define (moveto x y)
-    (set! currentpoint (cons x y))
-    (string-append (showcp) "m "))
-  (define (moveto-pair pair)
-    (moveto (car pair) (cdr pair)))
-  (define (rmoveto x y)
-    (moveto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
-  (define (lineto x y)
-    (set! currentpoint (cons x y))
-    (string-append (showcp) "l "))
-  (define (lineto-pair pair)
-    (lineto (car pair) (cdr pair)))
-  (define (rlineto x y)
-    (lineto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
-  (define (curveto x1 y1 x2 y2 x y)
-    (set! currentpoint (cons x y))
-    (string-append (ly-number->string x1) (ly-number->string y1)
-                  (ly-number->string x2) (ly-number->string y2)
-                  (ly-number->string x) (ly-number->string y) "c "))
-  (define (curveto-pairs pt1 pt2 pt)
-    (curveto (car pt1) (cdr pt1) (car pt2) (cdr pt2) (car pt) (cdr pt)))
-  (define (closefill) "h f ")
-  (define (closestroke) "S ")
-  (define (setlinewidth w) (string-append (ly-number->string w) "w "))
-  (define (setgray g) (string-append (ly-number->string g) "g "))
-  (define (setlineparams) "1 j 1 J ")
-  
-  (define (beam width slope thick)
-    (let ((ht (* slope width)))
-      (string-append (moveto 0 (- (/ thick 2)))
-                    (rlineto width ht)
-                    (rlineto 0 thick)
-                    (lineto 0 (/ thick 2))
-                    (closefill))))
-
-  (define (comment s) 
-    (string-append "% " s "\n"))
-
-  (define (brack-traject pair ds alpha)
-    (let ((alpha-rad (* alpha (/ 3.141592654 180))))
-      (cons (+ (car pair) (* (cos alpha-rad) ds))
-           (+ (cdr pair) (* (sin alpha-rad) ds)))))
-    
-  (define (bracket arch_angle arch_width arch_height height arch_thick thick)
-    (let* ((halfht (+ (/ height 2) thick))
-          (farpt (cons (+ thick arch_height) 
-                       (+ (- halfht arch_thick) arch_width)))
-          (halfbrack 
-           (string-append (moveto 0 0)
-                          (lineto thick 0)
-                          (lineto thick (- halfht arch_thick))
-                          (curveto-pairs
-                           (brack-traject (cons thick 
-                                                (- halfht arch_thick))
-                                          (* 0.4 arch_height) 0)
-                           (brack-traject farpt 
-                                          (* -0.25 arch_height) 
-                                          arch_angle)
-                           farpt)
-                          (curveto-pairs 
-                           (brack-traject farpt
-                                          (* -0.15 arch_height)
-                                          arch_angle)
-                           (brack-traject (cons (/ thick 2) halfht)
-                                          (/ arch_height 2) 0)
-                           (cons 0 halfht))
-                          (lineto 0 0)
-                          (closefill))))
-      (string-append (setlinewidth (/ thick 2))
-                    (setlineparams)
-                    "q 1 0 0 -1 0 0 cm " ; flip coords
-                    halfbrack
-                    "Q " ; grestore
-                    halfbrack)))
-  
-  (define (char i)
-    (invoke-char " show" i))
-
-  (define (hairpin thick width starth endh )
-    (string-append (setlinewidth thick)
-                  (moveto 0 starth)
-                  (lineto width endh)
-                  (moveto 0 (- starth))
-                  (lineto width (- endh))
-                  (closestroke)))
-
-  (define (dashed-slur thick dash l)
-    (string-append (setlineparams)
-                  "[ " (ly-number->string dash) " "
-                  (ly-number->string (* 10 thick)) " ] 0 d "
-                  (setlinewidth thick)
-                  (moveto-pair (car l))
-                  (apply curveto (cdr l))
-                  (closestroke)))
-                  
-  (define (dashed-line thick on off dx dy)
-    (string-append (setlineparams)
-                  "[ " (ly-number->string on) " "
-                  (ly-number->string off) " ] 0 d "
-                  (setlinewidth thick)
-                  (moveto 0 0)
-                  (lineto dx dy)
-                  (closestroke)))
-
-  (define (repeat-slash width slope beamthick)
-    (let* ((height (/ beamthick slope))
-          (xwid (sqrt (+ (* beamthick beamthick) (* height height)))))
-      (string-append (moveto 0 0)
-                    (rlineto xwid 0)
-                    (rlineto width (* slope width))
-                    (rlineto (- xwid) 0)
-                    (closefill))))
-
-  (define (end-output) "")
-  
-  (define (experimental-on) "")
-  
-  (define (filledbox breadth width depth height) 
-    (string-append (ly-number->string (- breadth))
-                  (ly-number->string (- depth))
-                  (ly-number->string (+ breadth width))
-                  (ly-number->string (+ depth height))
-                  " re f "))
+
+;currently no font commands; this is a helper for pdftex.scm.
+
+(define-module (scm pdf)
+  )
+
+
+(define this-module (current-module))
+
+(use-modules
+ (guile)
+ )
+
+
+
+                                       ; simple commands to store and update currentpoint.  This makes the
+                                       ; other procedures simple rewrites of the PostScript code.
+(define currentpoint (cons 0 0))
+(define (showcp) 
+  (string-append (ly-number->string (car currentpoint)) " " 
+                (ly-number->string (cdr currentpoint)) " "))
+(define (moveto x y)
+  (set! currentpoint (cons x y))
+  (string-append (showcp) "m "))
+(define (moveto-pair pair)
+  (moveto (car pair) (cdr pair)))
+(define (rmoveto x y)
+  (moveto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
+(define (lineto x y)
+  (set! currentpoint (cons x y))
+  (string-append (showcp) "l "))
+(define (lineto-pair pair)
+  (lineto (car pair) (cdr pair)))
+(define (rlineto x y)
+  (lineto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
+(define (curveto x1 y1 x2 y2 x y)
+  (set! currentpoint (cons x y))
+  (string-append (ly-number->string x1) (ly-number->string y1)
+                (ly-number->string x2) (ly-number->string y2)
+                (ly-number->string x) (ly-number->string y) "c "))
+(define (curveto-pairs pt1 pt2 pt)
+  (curveto (car pt1) (cdr pt1) (car pt2) (cdr pt2) (car pt) (cdr pt)))
+(define (closefill) "h f ")
+(define (closestroke) "S ")
+(define (setlinewidth w) (string-append (ly-number->string w) "w "))
+(define (setgray g) (string-append (ly-number->string g) "g "))
+(define (setlineparams) "1 j 1 J ")
+
+(define (beam width slope thick)
+  (let ((ht (* slope width)))
+    (string-append (moveto 0 (- (/ thick 2)))
+                  (rlineto width ht)
+                  (rlineto 0 thick)
+                  (lineto 0 (/ thick 2))
+                  (closefill))))
+
+(define (comment s) 
+  (string-append "% " s "\n"))
+
+(define (brack-traject pair ds alpha)
+  (let ((alpha-rad (* alpha (/ 3.141592654 180))))
+    (cons (+ (car pair) (* (cos alpha-rad) ds))
+         (+ (cdr pair) (* (sin alpha-rad) ds)))))
+
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+  (let* ((halfht (+ (/ height 2) thick))
+        (farpt (cons (+ thick arch_height) 
+                     (+ (- halfht arch_thick) arch_width)))
+        (halfbrack 
+         (string-append (moveto 0 0)
+                        (lineto thick 0)
+                        (lineto thick (- halfht arch_thick))
+                        (curveto-pairs
+                         (brack-traject (cons thick 
+                                              (- halfht arch_thick))
+                                        (* 0.4 arch_height) 0)
+                         (brack-traject farpt 
+                                        (* -0.25 arch_height) 
+                                        arch_angle)
+                         farpt)
+                        (curveto-pairs 
+                         (brack-traject farpt
+                                        (* -0.15 arch_height)
+                                        arch_angle)
+                         (brack-traject (cons (/ thick 2) halfht)
+                                        (/ arch_height 2) 0)
+                         (cons 0 halfht))
+                        (lineto 0 0)
+                        (closefill))))
+    (string-append (setlinewidth (/ thick 2))
+                  (setlineparams)
+                  "q 1 0 0 -1 0 0 cm " ; flip coords
+                  halfbrack
+                  "Q " ; grestore
+                  halfbrack)))
+
+(define (char i)
+  (invoke-char " show" i))
+
+(define (hairpin thick width starth endh )
+  (string-append (setlinewidth thick)
+                (moveto 0 starth)
+                (lineto width endh)
+                (moveto 0 (- starth))
+                (lineto width (- endh))
+                (closestroke)))
+
+(define (dashed-slur thick dash l)
+  (string-append (setlineparams)
+                "[ " (ly-number->string dash) " "
+                (ly-number->string (* 10 thick)) " ] 0 d "
+                (setlinewidth thick)
+                (moveto-pair (car l))
+                (apply curveto (cdr l))
+                (closestroke)))
+
+(define (dashed-line thick on off dx dy)
+  (string-append (setlineparams)
+                "[ " (ly-number->string on) " "
+                (ly-number->string off) " ] 0 d "
+                (setlinewidth thick)
+                (moveto 0 0)
+                (lineto dx dy)
+                (closestroke)))
+
+(define (repeat-slash width slope beamthick)
+  (let* ((height (/ beamthick slope))
+        (xwid (sqrt (+ (* beamthick beamthick) (* height height)))))
+    (string-append (moveto 0 0)
+                  (rlineto xwid 0)
+                  (rlineto width (* slope width))
+                  (rlineto (- xwid) 0)
+                  (closefill))))
+
+(define (end-output) "")
+
+(define (experimental-on) "")
+
+(define (filledbox breadth width depth height) 
+  (string-append (ly-number->string (- breadth))
+                (ly-number->string (- depth))
+                (ly-number->string (+ breadth width))
+                (ly-number->string (+ depth height))
+                " re f "))
 
 ;; TODO:
 ;;
 
 ;; TODO:
 ;;
 ;;
 ;; WORKAROUND:
 ;;
 ;;
 ;; WORKAROUND:
 ;;
-  (define (roundfilledbox breadth width depth height) 
-    (filledbox breadth width depth height))
+(define (roundfilledbox breadth width depth height) 
+  (filledbox breadth width depth height))
 ;;
 
 ;;
 
-  (define (font-def i s) "")
+(define (font-def i s) "")
 
 
-  (define (font-switch i) "")
+(define (font-switch i) "")
 
 
-  (define (header-end) "")
-  
-  (define (lily-def key val) "")
+(define (header-end) "")
 
 
-  (define (header creator generate) "")
-  
-  (define (invoke-char s i)
-    (string-append 
-     "(\\" (inexact->string i 8) ") " s " " ))
-  
-  (define (placebox x y s) "")
+(define (lily-def key val) "")
 
 
-  (define (bezier-sandwich l thick)
-    (string-append (setlinewidth thick)
-                  (moveto-pair (list-ref l 7))
-                  (curveto-pairs (list-ref l 4)
-                                 (list-ref l 5)
-                                 (list-ref l 6))
-                  (lineto-pair (list-ref l 3))
-                  (curveto-pairs (list-ref l 0)
-                                 (list-ref l 1)
-                                 (list-ref l 2))
-                  "B "))
-
-  (define (start-line height) "")
-  
-  (define (stem breadth width depth height) 
-    (filledbox breadth width depth height))
-
-  (define (stop-line) "")
-
-  (define (text s) "")
-
-  (define (volta h w thick vert_start vert_end)
+(define (header creator generate) "")
+
+(define (invoke-char s i)
+  (string-append 
+   "(\\" (inexact->string i 8) ") " s " " ))
+
+(define (placebox x y s) "")
+
+(define (bezier-sandwich l thick)
+  (string-append (setlinewidth thick)
+                (moveto-pair (list-ref l 7))
+                (curveto-pairs (list-ref l 4)
+                               (list-ref l 5)
+                               (list-ref l 6))
+                (lineto-pair (list-ref l 3))
+                (curveto-pairs (list-ref l 0)
+                               (list-ref l 1)
+                               (list-ref l 2))
+                "B "))
+
+(define (start-system height) "")
+
+(define (stem breadth width depth height) 
+  (filledbox breadth width depth height))
+
+(define (stop-system) "")
+
+(define (text s) "")
+
+(define (volta h w thick vert_start vert_end)
+  (string-append (setlinewidth thick)
+                (setlineparams)
+                (if (= vert_start 0) 
+                    (string-append (moveto 0 0)
+                                   (lineto 0 h))
+                    (moveto 0 h))
+                (lineto w h)
+                (if (= vert_end 0) (lineto w 0) "")
+                (closestroke)))
+
+(define (tuplet ht gap dx dy thick dir)
+  (let ((gapy (* (/ dy dx) gap)))
     (string-append (setlinewidth thick)
                   (setlineparams)
     (string-append (setlinewidth thick)
                   (setlineparams)
-                  (if (= vert_start 0) 
-                      (string-append (moveto 0 0)
-                                     (lineto 0 h))
-                      (moveto 0 h))
-                  (lineto w h)
-                  (if (= vert_end 0) (lineto w 0) "")
-                  (closestroke)))
-
-  (define (tuplet ht gap dx dy thick dir)
-    (let ((gapy (* (/ dy dx) gap)))
-      (string-append (setlinewidth thick)
-                    (setlineparams)
-                    (moveto 0 (- (* ht dir)))
-                    (lineto 0 0)
-                    (lineto (/ (- dx gap) 2)
-                            (/ (- dy gapy) 2))
-                    (moveto (/ (+ dx gap) 2)
-                            (/ (+ dy gapy) 2))
-                    (lineto dx dy)
-                    (lineto dx (- dy (* ht dir)))
-                    (closestroke))))
-
-  (define (unknown) "\n unknown\n")
-
-  ; Problem here -- we're using /F18 for the font, but we don't know
-  ; for sure that that will exist.
-  (define (ez-ball ch letter-col ball-col)
-    (let ((origin (cons 0.45 0)))
-      (string-append (setgray 0)
-                    (setlinewidth 1.1)
-                    (moveto-pair origin) (lineto-pair origin)
-                    (closestroke)
-                    (setgray ball-col)
-                    (setlinewidth 0.9)
-                    (moveto-pair origin) (lineto-pair origin)
-                    (closestroke)
-                    (setgray letter-col)
-                    (moveto-pair origin)
-                    "BT "
-                    "/F18 0.85 Tf "
-                    "-0.28 -0.30 Td " ; move for text block
-                    "[(" ch ")] TJ ET ")))
-
-  (define (define-origin a b c ) "")
-  (define (no-origin) "")
-  
-  ;; PS
-  (cond ((eq? action-name 'all-definitions)
-        `(begin
-           (define beam ,beam)
-           (define tuplet ,tuplet)
-           (define bracket ,bracket)
-           (define char ,char)
-           (define volta ,volta)
-           (define bezier-sandwich ,bezier-sandwich)
-           (define dashed-line ,dashed-line) 
-           (define dashed-slur ,dashed-slur) 
-           (define hairpin ,hairpin) 
-           (define end-output ,end-output)
-           (define experimental-on ,experimental-on)
-           (define filledbox ,filledbox)
-           (define roundfilledbox ,roundfilledbox)
-           (define font-def ,font-def)
-           (define font-switch ,font-switch)
-           (define header-end ,header-end)
-           (define lily-def ,lily-def)
-           (define font-load-command ,font-load-command)
-           (define header ,header) 
-           (define invoke-char ,invoke-char) 
-
-           (define placebox ,placebox)
-           (define repeat-slash ,repeat-slash) 
-           (define select-font ,select-font)
-           (define start-line ,start-line)
-           (define stem ,stem)
-           (define stop-line ,stop-line)
-           (define stop-last-line ,stop-line)
-           (define text ,text)
-           (define no-origin ,no-origin)
-           (define define-origin ,define-origin)
-           (define ez-ball ,ez-ball)
-           ))
-       ((eq? action-name 'tuplet) tuplet)
-       ((eq? action-name 'beam) beam)
-       ((eq? action-name 'bezier-sandwich) bezier-sandwich)
-       ((eq? action-name 'bracket) bracket)
-       ((eq? action-name 'char) char)
-       ((eq? action-name 'dashed-line) dashed-line) 
-       ((eq? action-name 'dashed-slur) dashed-slur) 
-       ((eq? action-name 'hairpin) hairpin)
-       ((eq? action-name 'experimental-on) experimental-on)
-       ((eq? action-name 'ez-ball) ez-ball)    
-       ((eq? action-name 'filledbox) filledbox)
-       ((eq? action-name 'roundfilledbox) roundfilledbox)
-       ((eq? action-name 'repeat-slash) repeat-slash)
-       ((eq? action-name 'select-font) select-font)
-       ((eq? action-name 'volta) volta)
-       (else (error "unknown tag -- PDF-SCM " action-name))
-       )
-  )
+                  (moveto 0 (- (* ht dir)))
+                  (lineto 0 0)
+                  (lineto (/ (- dx gap) 2)
+                          (/ (- dy gapy) 2))
+                  (moveto (/ (+ dx gap) 2)
+                          (/ (+ dy gapy) 2))
+                  (lineto dx dy)
+                  (lineto dx (- dy (* ht dir)))
+                  (closestroke))))
+
+(define (unknown) "\n unknown\n")
+
+                                       ; Problem here -- we're using /F18 for the font, but we don't know
+                                       ; for sure that that will exist.
+(define (ez-ball ch letter-col ball-col)
+  (let ((origin (cons 0.45 0)))
+    (string-append (setgray 0)
+                  (setlinewidth 1.1)
+                  (moveto-pair origin) (lineto-pair origin)
+                  (closestroke)
+                  (setgray ball-col)
+                  (setlinewidth 0.9)
+                  (moveto-pair origin) (lineto-pair origin)
+                  (closestroke)
+                  (setgray letter-col)
+                  (moveto-pair origin)
+                  "BT "
+                  "/F18 0.85 Tf "
+                  "-0.28 -0.30 Td " ; move for text block
+                  "[(" ch ")] TJ ET ")))
+
+(define (define-origin a b c ) "")
+(define (no-origin) "")
+
 
 (define (scm-pdf-output)
   (primitive-eval (pdf-scm 'all-definitions)))
 
 (define (scm-pdf-output)
   (primitive-eval (pdf-scm 'all-definitions)))
index a40e208669ece44734e8ae389dbe1eaa714ceb93..39d109d74a5528b24d349d98ba0a84058126293f 100644 (file)
 
 ;; TODO: port this  to the new module framework.
 
 
 ;; TODO: port this  to the new module framework.
 
-(define (pdftex-scm action-name)
-  (define (unknown) 
-    "%\n\\unknown%\n")
-
-
-  (define (select-font name-mag-pair)
-    (let*
-       (
-        (c (assoc name-mag-pair font-name-alist))
-        )
-
-      (if (eq? c #f)
-         (begin
-           (display "FAILED\n")
-           (display (object-type (car name-mag-pair)))
-           (display (object-type (caaar font-name-alist)))
-
-           (ly-warn (string-append
-                     "Programming error: No such font known "
-                     (car name-mag-pair) " "
-                     (ly-number->string (cdr name-mag-pair))
-                     ))
-           "") ; issue no command
-         (string-append "\\" (cddr c)))
-      
-      
-      ))
-  
-  (define (beam width slope thick)
-    (embedded-pdf ((pdf-scm 'beam) width slope thick)))
-
-  (define (bracket arch_angle arch_width arch_height height arch_thick thick)
-    (embedded-pdf ((pdf-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick)))
-
-  (define (dashed-slur thick dash l)
-    (embedded-pdf ((pdf-scm 'dashed-slur)  thick dash l)))
-
-  (define (hairpin thick w sh eh)
-    (embedded-pdf ((pdf-scm 'hairpin) thick w sh eh)))
-
-  (define (char i)
-    (string-append "\\char" (inexact->string i 10) " "))
-  
-  (define (dashed-line thick on off dx dy)
-    (embedded-pdf ((pdf-scm 'dashed-line) thick on off dx dy)))
-
-  (define (font-load-command name-mag command)
-    (string-append
-     "\\font\\" command "="
-     (car name-mag)
-     " scaled "
-     (ly-number->string (inexact->exact (* 1000  (cdr name-mag))))
-     "\n"))
-
-  (define (ez-ball c l b)
-    (embedded-pdf ((pdf-scm 'ez-ball) c  l b)))
-
-  (define (embedded-pdf s)
-    (string-append "\\embeddedpdf{ " s "}"))
-
-  (define (comment s)
-    (string-append "% " s))
-  
-  (define (end-output) 
+(define-module (scm pdftex))
+
+(define (unknown) 
+  "%\n\\unknown%\n")
+
+
+(define (select-font name-mag-pair)
+  (let*
+      (
+       (c (assoc name-mag-pair font-name-alist))
+       )
+
+    (if (eq? c #f)
        (begin
        (begin
-; uncomment for some stats about lily memory     
-;              (display (gc-stats))
+         (display "FAILED\n")
+         (display (object-type (car name-mag-pair)))
+         (display (object-type (caaar font-name-alist)))
+
+         (ly-warn (string-append
+                   "Programming error: No such font known "
+                   (car name-mag-pair) " "
+                   (ly-number->string (cdr name-mag-pair))
+                   ))
+         "") ; issue no command
+       (string-append "\\" (cddr c)))
+    
+    
+    ))
+
+(define (beam width slope thick)
+  (embedded-pdf ((pdf-scm 'beam) width slope thick)))
+
+(define (bracket arch_angle arch_width arch_height height arch_thick thick)
+  (embedded-pdf ((pdf-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick)))
+
+(define (dashed-slur thick dash l)
+  (embedded-pdf ((pdf-scm 'dashed-slur)  thick dash l)))
+
+(define (hairpin thick w sh eh)
+  (embedded-pdf ((pdf-scm 'hairpin) thick w sh eh)))
+
+(define (char i)
+  (string-append "\\char" (inexact->string i 10) " "))
+
+(define (dashed-line thick on off dx dy)
+  (embedded-pdf ((pdf-scm 'dashed-line) thick on off dx dy)))
+
+(define (font-load-command name-mag command)
+  (string-append
+   "\\font\\" command "="
+   (car name-mag)
+   " scaled "
+   (ly-number->string (inexact->exact (* 1000  (cdr name-mag))))
+   "\n"))
+
+(define (ez-ball c l b)
+  (embedded-pdf ((pdf-scm 'ez-ball) c  l b)))
+
+(define (embedded-pdf s)
+  (string-append "\\embeddedpdf{ " s "}"))
+
+(define (comment s)
+  (string-append "% " s))
+
+(define (end-output) 
+  (begin
+                                       ; uncomment for some stats about lily memory      
+                                       ;               (display (gc-stats))
     (string-append "\n\\EndLilyPondOutput"
     (string-append "\n\\EndLilyPondOutput"
-                  ; Put GC stats here.
+                                       ; Put GC stats here.
                   )))
                   )))
-  
-  (define (experimental-on)
-    "")
-
-  (define (repeat-slash w a t)
-    (embedded-pdf ((pdf-scm 'repeat-slash) w a t)))
-  
-  (define (font-switch i)
-    (string-append
-     "\\" (font i) "\n"))
-
-  (define (font-def i s)
-    (string-append
-     "\\font" (font-switch i) "=" s "\n"))
-
-  (define (header-end)
-    (string-append
-     "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt"
-     "\\turnOnPostScript"
-     "\\pdfcompresslevel=0"))
-
-  ;; Note: this string must match the string in ly2dvi.py!!!
-  (define (header creator generate) 
-    (string-append
-     "% Generated automatically by: " creator generate "\n"))
-
-  (define (invoke-char s i)
-    (string-append 
-     "\n\\" s "{" (inexact->string i 10) "}" ))
-
-  ;;
-  ;; need to do something to make this really safe.
-  ;;
-  (define (output-tex-string s)
-      (if security-paranoia
-         (if use-regex
-             (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
-             (begin (display "warning: not paranoid") (newline) s))
-         s))
-      
-  (define (lily-def key val)
-    (let ((tex-key
-          (if use-regex
-              (regexp-substitute/global 
-               #f "_" (output-tex-string key) 'pre "X" 'post)      
-              (output-tex-string key)))
-         (tex-val (output-tex-string val)))
-      (if (equal? (sans-surrounding-whitespace tex-val) "")
-         (string-append "\\let\\" tex-key "\\undefined\n")
-         (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
-
-  (define (number->dim x)
-    (string-append
-     ;;ugh ly-* in backend needs compatibility func for standalone output
-     (ly-number->string x) " \\outputscale "))
-
-  (define (placebox x y s) 
-    (string-append 
-     "\\placebox{"
-     (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
-
-  (define (bezier-sandwich l thick)
-    (embedded-pdf ((pdf-scm 'bezier-sandwich) l thick)))
-
-  (define (start-line ht)
-      (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
-
-  (define (stop-line) 
-    "}\\vss}\\interscoreline\n")
-  (define (stop-last-line)
-    "}\\vss}")
-  (define (filledbox breapth width depth height) 
-    (string-append 
-     "\\kern" (number->dim (- breapth))
-     "\\vrule width " (number->dim (+ breapth width))
-     "depth " (number->dim depth)
-     "height " (number->dim height) " "))
-
-  (define (roundfilledbox x width y height blotdiam)
-    (embedded-pdf ((pdf-scm 'roundfilledbox) x width y height blotdiam)))
-
-  (define (text s)
-    (string-append "\\hbox{" (output-tex-string s) "}"))
-  
-  (define (tuplet ht gapx dx dy thick dir)
-    (embedded-pdf ((pdf-scm 'tuplet) ht gapx dx dy thick dir)))
-
-  (define (volta h w thick vert_start vert_end)
-    (embedded-pdf ((pdf-scm 'volta) h w thick vert_start vert_end)))
-
-  (define (define-origin file line col)
-    (if (procedure? point-and-click)
-       (string-append "\\special{src:\\string:"
-                      (point-and-click line col file)
-                      "}" )
-       "")
-    )
-
-  ; no-origin not supported in PDFTeX
-  (define (no-origin) "")
-
-  ;; The procedures listed below form the public interface of
-  ;; PDFTeX-scm.  (should merge the 2 lists)
-  (cond ((eq? action-name 'all-definitions)
-        `(begin
-           (define font-load-command ,font-load-command)
-           (define beam ,beam)
-           (define bezier-sandwich ,bezier-sandwich)
-           (define bracket ,bracket)
-           (define char ,char)
-           (define dashed-line ,dashed-line) 
-           (define dashed-slur ,dashed-slur) 
-           (define hairpin ,hairpin)
-           (define end-output ,end-output)
-           (define experimental-on ,experimental-on)
-           (define filledbox ,filledbox)
-           (define font-def ,font-def)
-           (define font-switch ,font-switch)
-           (define header-end ,header-end)
-           (define lily-def ,lily-def)
-           (define ez-ball ,ez-ball)
-           (define header ,header) 
-           (define invoke-char ,invoke-char) 
-
-           (define placebox ,placebox)
-           (define select-font ,select-font)
-           (define start-line ,start-line)
-           (define stop-line ,stop-line)
-           (define stop-last-line ,stop-last-line)
-           (define text ,text)
-           (define tuplet ,tuplet)
-           (define volta ,volta)
-           (define define-origin ,define-origin)
-           (define no-origin ,no-origin)
-           (define repeat-slash ,repeat-slash)
-           ))
-
-       ((eq? action-name 'beam) beam)
-       ((eq? action-name 'tuplet) tuplet)
-       ((eq? action-name 'bracket) bracket)
-       ((eq? action-name 'hairpin) hairpin)
-       ((eq? action-name 'dashed-line) dashed-line) 
-       ((eq? action-name 'dashed-slur) dashed-slur) 
-       ((eq? action-name 'end-output) end-output)
-       ((eq? action-name 'experimental-on) experimental-on)
-       ((eq? action-name 'font-def) font-def)
-       ((eq? action-name 'font-switch) font-switch)
-       ((eq? action-name 'header-end) header-end)
-       ((eq? action-name 'lily-def) lily-def)
-       ((eq? action-name 'header) header) 
-       ((eq? action-name 'invoke-char) invoke-char) 
-
-       ((eq? action-name 'placebox) placebox)
-       ((eq? action-name 'bezier-sandwich) bezier-sandwich)
-       ((eq? action-name 'start-line) start-line)
-       ((eq? action-name 'stem) stem)
-       ((eq? action-name 'stop-line) stop-line)
-       ((eq? action-name 'stop-last-line) stop-last-line)
-       ((eq? action-name 'volta) volta)
-       ((eq? action-name 'repeat-slash) repeat-slash)
-       (else (error "unknown tag -- PDFTEX " action-name))
-       )
+
+(define (experimental-on)
+  "")
+
+(define (repeat-slash w a t)
+  (embedded-pdf ((pdf-scm 'repeat-slash) w a t)))
+
+(define (font-switch i)
+  (string-append
+   "\\" (font i) "\n"))
+
+(define (font-def i s)
+  (string-append
+   "\\font" (font-switch i) "=" s "\n"))
+
+(define (header-end)
+  (string-append
+   "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt"
+   "\\turnOnPostScript"
+   "\\pdfcompresslevel=0"))
+
+;; Note: this string must match the string in ly2dvi.py!!!
+(define (header creator generate) 
+  (string-append
+   "% Generated automatically by: " creator generate "\n"))
+
+(define (invoke-char s i)
+  (string-append 
+   "\n\\" s "{" (inexact->string i 10) "}" ))
+
+;;
+;; need to do something to make this really safe.
+;;
+(define (output-tex-string s)
+  (if security-paranoia
+      (if use-regex
+         (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
+         (begin (display "warning: not paranoid") (newline) s))
+      s))
+
+(define (lily-def key val)
+  (let ((tex-key
+        (if use-regex
+            (regexp-substitute/global 
+             #f "_" (output-tex-string key) 'pre "X" 'post)      
+            (output-tex-string key)))
+       (tex-val (output-tex-string val)))
+    (if (equal? (sans-surrounding-whitespace tex-val) "")
+       (string-append "\\let\\" tex-key "\\undefined\n")
+       (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
+
+(define (number->dim x)
+  (string-append
+   ;;ugh ly-* in backend needs compatibility func for standalone output
+   (ly-number->string x) " \\outputscale "))
+
+(define (placebox x y s) 
+  (string-append 
+   "\\placebox{"
+   (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
+
+(define (bezier-sandwich l thick)
+  (embedded-pdf ((pdf-scm 'bezier-sandwich) l thick)))
+
+(define (start-system ht)
+  (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
+
+(define (stop-system) 
+  "}\\vss}\\interscoreline\n")
+(define (stop-last-system)
+  "}\\vss}")
+(define (filledbox breapth width depth height) 
+  (string-append 
+   "\\kern" (number->dim (- breapth))
+   "\\vrule width " (number->dim (+ breapth width))
+   "depth " (number->dim depth)
+   "height " (number->dim height) " "))
+
+(define (roundfilledbox x width y height blotdiam)
+  (embedded-pdf ((pdf-scm 'roundfilledbox) x width y height blotdiam)))
+
+(define (text s)
+  (string-append "\\hbox{" (output-tex-string s) "}"))
+
+(define (tuplet ht gapx dx dy thick dir)
+  (embedded-pdf ((pdf-scm 'tuplet) ht gapx dx dy thick dir)))
+
+(define (volta h w thick vert_start vert_end)
+  (embedded-pdf ((pdf-scm 'volta) h w thick vert_start vert_end)))
+
+(define (define-origin file line col)
+  (if (procedure? point-and-click)
+      (string-append "\\special{src:\\string:"
+                    (point-and-click line col file)
+                    "}" )
+      "")
   )
 
   )
 
+                                       ; no-origin not supported in PDFTeX
+(define (no-origin) "")
+
+
 (define (scm-pdftex-output)
   (primitive-eval (pdftex-scm 'all-definitions)))
 (define (scm-pdftex-output)
   (primitive-eval (pdftex-scm 'all-definitions)))
index de78697958001c5b410c397009738f92fdb3869d..0c2f662f18f8acb0bea6c4c3a254eeabee422389 100644 (file)
    (ly-number->string off)
    " ] 0 draw_dashed_line"))
 
    (ly-number->string off)
    " ] 0 draw_dashed_line"))
 
+(define (draw-line thick x1 y1 x2 y2)
+
+  (string-append 
+  "    1 setlinecap
+       1 setlinejoin "
+  (ly-number->string thick)
+       " setlinewidth "
+   (ly-number->string x1)
+   " "
+   (ly-number->string y1)
+   " moveto"
+   (ly-number->string x2)
+   " "
+   (ly-number->string y2)
+   " lineto stroke"
+
+  ))
+
 (define (repeat-slash wid slope thick)
   (string-append (numbers->string (list wid slope thick))
                 " draw_repeat_slash"))
 (define (repeat-slash wid slope thick)
   (string-append (numbers->string (list wid slope thick))
                 " draw_repeat_slash"))
 
                                        ; TODO: use HEIGHT argument
 
 
                                        ; TODO: use HEIGHT argument
 
-  (define (start-line height)
+  (define (start-system height)
   (string-append
    "\n"
    (ly-number->string height)
   (string-append
    "\n"
    (ly-number->string height)
-   " start-line {
+   " start-system {
 set-ps-scale-to-lily-scale
 
 "))
 set-ps-scale-to-lily-scale
 
 "))
@@ -250,11 +268,11 @@ set-ps-scale-to-lily-scale
   (string-append (numbers->string (list breapth width depth height))
                 " draw_box" ))
 
   (string-append (numbers->string (list breapth width depth height))
                 " draw_box" ))
 
-(define (stop-line)
-  "}\nstop-line\n")
+(define (stop-system)
+  "}\nstop-system\n")
 
 
-(define (stop-last-line)
-  "}\nstop-line\n")
+(define (stop-last-system)
+  "}\nstop-system\n")
 
 (define (text s)
   (string-append "(" s ") show  "))
 
 (define (text s)
   (string-append "(" s ") show  "))
index a76f79d5c36c2544181396c1a1cc3b891dcc68b8..8cc2529d790deb35ccd2e91bd3e04b53df8d2ea2 100644 (file)
@@ -240,7 +240,7 @@ layer('Layer 1',1,1,0,0,(0,0,0))
    sketch-beziers (list x y (primitive-eval l) thick)))
 
 ; TODO: use HEIGHT argument
    sketch-beziers (list x y (primitive-eval l) thick)))
 
 ; TODO: use HEIGHT argument
-(define (start-line height)
+(define (start-system height)
    "G()\n"
    )
 
    "G()\n"
    )
 
@@ -254,12 +254,12 @@ layer('Layer 1',1,1,0,0,(0,0,0))
 (define (stem x y z w) (filledbox x y z w))
 
 
 (define (stem x y z w) (filledbox x y z w))
 
 
-(define (stop-line)
+(define (stop-system)
     "G_()\n")
 
 ;; huh?
     "G_()\n")
 
 ;; huh?
-(define (stop-last-line)
-   (stop-line))
+(define (stop-last-system)
+   (stop-system))
 
 (define (text x y s)
   (string-append "txt('" s "',(" (sketch-numbers->string
 
 (define (text x y s)
   (string-append "txt('" s "',(" (sketch-numbers->string
index 9f0e65d857b11a3a8448d0005241dd4ca3c0bba1..ba98a067bd5f13d4f96a608a738adf85a5116680 100644 (file)
 (define (bezier-sandwich l thick)
   (embedded-ps (list 'bezier-sandwich  `(quote ,l) thick)))
 
 (define (bezier-sandwich l thick)
   (embedded-ps (list 'bezier-sandwich  `(quote ,l) thick)))
 
-(define (start-line ht)
+(define (start-system ht)
   (string-append "\\vbox to " (number->dim ht) "{\\hbox{"
                 "%\n"))
 
   (string-append "\\vbox to " (number->dim ht) "{\\hbox{"
                 "%\n"))
 
-(define (stop-line
+(define (stop-system
   "}\\vss}\\interscoreline\n")
   "}\\vss}\\interscoreline\n")
-(define (stop-last-line)
+(define (stop-last-system)
   "}\\vss}")
 
 (define (filledbox breapth width depth height)
   "}\\vss}")
 
 (define (filledbox breapth width depth height)
 (define (tuplet ht gapx dx dy thick dir)
   (embedded-ps (list 'tuplet  ht gapx dx dy thick dir)))
 
 (define (tuplet ht gapx dx dy thick dir)
   (embedded-ps (list 'tuplet  ht gapx dx dy thick dir)))
 
+(define (draw-line thick fx fy tx ty)
+  (embedded-ps (list 'draw-line thick fx fy tx ty)))
+
 (define (volta h w thick vert_start vert_end)
   (embedded-ps (list 'volta  h w thick vert_start vert_end)))
 (define (between-system-string string)
 (define (volta h w thick vert_start vert_end)
   (embedded-ps (list 'volta  h w thick vert_start vert_end)))
 (define (between-system-string string)