]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/stem.cc
*** empty log message ***
[lilypond.git] / lily / stem.cc
index 2061caf1c2d2e0db5d20984b43b6107c298f8d1f..b4de3c1ce5c2a03e0c49a6aa86fabd71d7a43c10 100644 (file)
 
   source file of the GNU LilyPond music typesetter
 
-  (c) 1996, 1997--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  (c) 1996--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
     Jan Nieuwenhuizen <janneke@gnu.org>
 
   TODO: This is way too hairy
+
+  TODO: fix naming.
+
+  Stem-end, chord-start, etc. is all confusing naming.
 */
-#include <math.h>              // m_pi
 
-#include "directional-element-interface.hh"
-#include "dimension-cache.hh"
 #include "stem.hh"
-#include "debug.hh"
-#include "paper-def.hh"
-#include "note-head.hh"
+
+#include <math.h>              // rint
+
 #include "lookup.hh"
-#include "molecule.hh"
+#include "directional-element-interface.hh"
+#include "note-head.hh"
+#include "warn.hh"
+#include "output-def.hh"
+#include "rhythmic-head.hh"
+#include "font-interface.hh"
 #include "paper-column.hh"
 #include "misc.hh"
 #include "beam.hh"
 #include "rest.hh"
 #include "group-interface.hh"
-#include "cross-staff.hh"
 #include "staff-symbol-referencer.hh"
-#include "lily-guile.icc"
-
+#include "side-position-interface.hh"
+#include "dot-column.hh"
+#include "stem-tremolo.hh"
 
 void
-Stem::set_beaming (int i,  Direction d )
+Stem::set_beaming (Grob *me, int beam_count, Direction d)
 {
-  SCM pair = get_elt_property ("beaming");
-  
-  if (!gh_pair_p (pair))
+  SCM pair = me->get_property ("beaming");
+
+  if (!scm_is_pair (pair))
     {
-      pair = gh_cons (gh_int2scm (0),gh_int2scm (0));
-      set_elt_property ("beaming", pair);
+      pair = scm_cons (SCM_EOL, SCM_EOL);
+      me->set_property ("beaming", pair);
     }
-  index_set_cell (pair, d, gh_int2scm (i));
+
+  SCM lst = index_get_cell (pair, d);
+  for (int i = 0; i < beam_count; i++)
+    lst = scm_cons (scm_int2num (i), lst);
+  index_set_cell (pair, d, lst);
 }
 
 int
-Stem::beam_count (Direction d) const
+Stem::get_beaming (Grob *me, Direction d)
 {
-  SCM p=get_elt_property ("beaming");
-  if (gh_pair_p (p))
-    return gh_scm2int (index_cell (p,d));
-  else
+  SCM pair = me->get_property ("beaming");
+  if (!scm_is_pair (pair))
     return 0;
+
+  SCM lst = index_get_cell (pair, d);
+  return scm_ilength (lst);
 }
 
+
 Interval
-Stem::head_positions () const
+Stem::head_positions (Grob *me)
 {
-  if (!heads_i ())
+  if (head_count (me))
     {
-      Interval iv;
-      return iv;
+      Drul_array<Grob*> e (extremal_heads (me));
+      return Interval (Staff_symbol_referencer::get_position (e[DOWN]),
+                      Staff_symbol_referencer::get_position (e[UP]));
     }
-
-  
-  Drul_array<Note_head*> e (extremal_heads ());
-
-  return Interval (staff_symbol_referencer (e[DOWN]).position_f (),
-                  staff_symbol_referencer( e[UP]).position_f ()); 
+  return Interval ();
 }
 
-
 Real
-Stem::chord_start_f () const
+Stem::chord_start_y (Grob *me)
 {
-  return head_positions()[get_direction ()]
-    * Staff_symbol_referencer_interface (this).staff_space ()/2.0;
+  Interval hp = head_positions (me);
+  if (!hp.is_empty ())
+    return hp[get_direction (me)] * Staff_symbol_referencer::staff_space (me)
+      * 0.5;
+  return 0;
 }
 
 Real
-Stem::stem_end_position () const
+Stem::stem_end_position (Grob *me)
 {
-  SCM p =get_elt_property ("stem-end-position");
+  SCM p = me->get_property ("stem-end-position");
   Real pos;
-  if (!gh_number_p (p))
+  if (!scm_is_number (p))
     {
-      Stem * me = (Stem*) this;
-      pos = get_default_stem_end_position ();
-      me->set_elt_property ("stem-end-position", gh_double2scm (pos));
+      pos = get_default_stem_end_position (me);
+      me->set_property ("stem-end-position", scm_make_real (pos));
     }
   else
-    pos = gh_scm2double (p);
+    pos = scm_to_double (p);
 
   return pos;
 }
 
 Direction
-Stem::get_direction () const
+Stem::get_direction (Grob *me)
 {
-  Direction d = directional_element (this).get ();
+  Direction d = get_grob_direction (me);
 
   if (!d)
     {
-       Stem * me = (Stem*) this;
-       d = get_default_dir ();
-       directional_element (me).set (d);
+      d = get_default_dir (me);
+      // urg, AAARGH!
+      set_grob_direction (me, d);
     }
-  return d ;
+  return d;
 }
 
-
 void
-Stem::set_stemend (Real se)
+Stem::set_stemend (Grob *me, Real se)
 {
   // todo: margins
-  Direction d= get_direction ();
-  
-  if (d && d * head_positions()[get_direction ()] >= se*d)
-    warning (_ ("Weird stem size; check for narrow beams"));
+  Direction d = get_direction (me);
+
+  if (d && d * head_positions (me)[get_direction (me)] >= se*d)
+    me->warning (_ ("Weird stem size; check for narrow beams"));
 
-  set_elt_property ("stem-end-position", gh_double2scm (se));
+  me->set_property ("stem-end-position", scm_make_real (se));
 }
 
-int
-Stem::type_i () const
+/* Note head that determines hshift for upstems
+   WARNING: triggers direction  */
+Grob *
+Stem::support_head (Grob *me)
 {
-  return first_head () ?  first_head ()->balltype_i () : 2;
+  if (head_count (me) == 1)
+    /* UGH. */
+    return unsmob_grob (scm_car (me->get_property ("note-heads")));
+  return first_head (me);
 }
 
-/*
-  Note head that determines hshift for upstems
- */ 
-Score_element*
-Stem::support_head ()const
-{
-  SCM h = get_elt_property ("support-head");
-  Score_element * nh = unsmob_element (h);
-  if (nh)
-    return nh;
-  else if (heads_i () == 1)
-    {
-      /*
-       UGH.
-       */
-      
-      return unsmob_element (gh_car (get_elt_property ("heads")));
-    }
-  else
-    return first_head ();
+int
+Stem::head_count (Grob *me)
+{
+  return Pointer_group_interface::count (me, ly_symbol2scm ("note-heads"));
 }
 
-
-int
-Stem::heads_i ()const
+/* The note head which forms one end of the stem.
+   WARNING: triggers direction  */
+Grob *
+Stem::first_head (Grob *me)
 {
-  Group_interface gi (this, "heads");
-  return gi.count ();
+  Direction d = get_direction (me);
+  if (d)
+    return extremal_heads (me)[-d];
+  return 0;
 }
 
-/*
-  The note head which forms one end of the stem.  
- */
-Note_head*
-Stem::first_head () const
+/* The note head opposite to the first head.  */
+Grob *
+Stem::last_head (Grob *me)
 {
-  return extremal_heads ()[-get_direction ()];
+  Direction d = get_direction (me);
+  if (d)
+    return extremal_heads (me)[d];
+  return 0;  
 }
 
 /*
-  START is part where stem reaches `last' head. 
- */
-Drul_array<Note_head*>
-Stem::extremal_heads () const
+  START is part where stem reaches `last' head.
+
+  This function returns a drul with (bottom-head, top-head). 
+
+*/
+Drul_array<Grob*>
+Stem::extremal_heads (Grob *me)
 {
   const int inf = 1000000;
   Drul_array<int> extpos;
   extpos[DOWN] = inf;
-  extpos[UP] = -inf;  
-  
-  Drul_array<Note_head *> exthead;
-  exthead[LEFT] = exthead[RIGHT] =0;
-  
-  for (SCM s = get_elt_property ("heads"); gh_pair_p (s); s = gh_cdr (s))
+  extpos[UP] = -inf;
+
+  Drul_array<Grob *> exthead (0, 0);
+  for (SCM s = me->get_property ("note-heads"); scm_is_pair (s);
+       s = scm_cdr (s))
     {
-      Note_head * n = dynamic_cast<Note_head*> (unsmob_element (gh_car (s)));
-      Staff_symbol_referencer_interface si (n);
-      
-      int p = int(si.position_f ());
+      Grob *n = unsmob_grob (scm_car (s));
+      int p = Staff_symbol_referencer::get_rounded_position (n);
 
       Direction d = LEFT;
-      do {
-      if (d* p > d* extpos[d])
+      do
        {
-         exthead[d] = n;
-         extpos[d] = p;
-       }
-      } while (flip (&d) != DOWN);
+         if (d * p > d * extpos[d])
+           {
+             exthead[d] = n;
+             extpos[d] = p;
+           }
+       } while (flip (&d) != DOWN);
     }
-
   return exthead;
 }
 
-void
-Stem::add_head (Rhythmic_head *n)
+static int
+integer_compare (int const &a, int const &b)
 {
-  n->set_elt_property ("stem", this->self_scm_);
-  n->add_dependency (this);
+  return a - b;
+}
 
-  Group_interface gi (this);
-  if (Note_head *nh = dynamic_cast<Note_head *> (n))
-    gi.name_ = "heads";
-  else
-    gi.name_ = "rests";
+/* The positions, in ascending order.  */
+Array<int>
+Stem::note_head_positions (Grob *me)
+{
+  Array<int> ps ;
+  for (SCM s = me->get_property ("note-heads"); scm_is_pair (s);
+       s = scm_cdr (s))
+    {
+      Grob *n = unsmob_grob (scm_car (s));
+      int p = Staff_symbol_referencer::get_rounded_position (n);
 
-  gi.add_element (n);
+      ps.push (p);
+    }
+
+  ps.sort (integer_compare);
+  return ps;
 }
 
-Stem::Stem ()
+void
+Stem::add_head (Grob *me, Grob *n)
 {
-  set_elt_property ("heads", SCM_EOL);
-  set_elt_property ("rests", SCM_EOL);
+  n->set_property ("stem", me->self_scm ());
+  n->add_dependency (me);
 
-  dim_cache_[X_AXIS]->off_callbacks_.push ( &Stem::off_callback);
+  if (Note_head::has_interface (n))
+    Pointer_group_interface::add_grob (me, ly_symbol2scm ("note-heads"), n);
+  else if (Rest::has_interface (n))
+    Pointer_group_interface::add_grob (me, ly_symbol2scm ("rests"), n);
 }
 
 bool
-Stem::invisible_b () const
+Stem::is_invisible (Grob *me)
 {
-  /*
-    UGH. Who determines balltype for stem?
-   */
-  Note_head * nh = dynamic_cast<Note_head*> (support_head ());
-  return !(heads_i () && nh->balltype_i () >= 1);
+  Real stemlet_length = robust_scm2double (me->get_property ("stemlet-length"),
+                                          0.0);
+  
+  return !((head_count (me)
+           || stemlet_length > 0.0)
+          && scm_to_int (me->get_property ("duration-log")) >= 1);
 }
 
-int
-Stem::get_center_distance (Direction d) const
+Direction
+Stem::get_default_dir (Grob *me)
 {
   int staff_center = 0;
-  int distance = (int) (d*(head_positions()[d] - staff_center));
-  return distance >? 0;
-}
+  Interval hp = head_positions (me);
+  if (hp.is_empty ())
+    return CENTER;
 
-Direction
-Stem::get_default_dir () const
-{
-  int du = get_center_distance (UP);
-  int dd = get_center_distance (DOWN);
+  int udistance = (int) (UP * hp[UP] - staff_center);
+  int ddistance = (int) (DOWN * hp[DOWN] - staff_center);
 
-  if (sign (dd - du))
-    return Direction (sign (dd -du));
+  if (sign (ddistance - udistance))
+    return Direction (sign (ddistance - udistance));
 
-  return Direction (int(paper_l ()->get_var ("stem_default_neutral_direction")));
+  return to_dir (me->get_property ("neutral-direction"));
 }
 
 Real
-Stem::get_default_stem_end_position () const
+Stem::get_default_stem_end_position (Grob *me)
 {
-  bool grace_b = to_boolean (get_elt_property ("grace"));
-  String type_str = grace_b ? "grace-" : "";
+  Real ss = Staff_symbol_referencer::staff_space (me);
+  int durlog = duration_log (me);
   SCM s;
   Array<Real> a;
 
-  Real length_f = 0.;
-  SCM scm_len = get_elt_property("length");
-  if (gh_number_p (scm_len))
-    {
-      length_f = gh_scm2double (scm_len);
-    }
+  /* WARNING: IN HALF SPACES */
+  Real length = 7;
+  SCM scm_len = me->get_property ("length");
+  if (scm_is_number (scm_len))
+    length = scm_to_double (scm_len);
   else
     {
-      s = ly_eval_str (type_str + "stem-length");
-      scm_to_array (s, &a);
-      // stem uses half-spaces
-      length_f = a[((flag_i () - 2) >? 0) <? (a.size () - 1)] * 2;
+      s = me->get_property ("lengths");
+      if (scm_is_pair (s))
+       length = 2 * scm_to_double (robust_list_ref (durlog - 2, s));
     }
 
+  /* URGURGURG
+     'set-default-stemlen' sets direction too.   */
+  Direction dir = get_direction (me);
+  if (!dir)
+    {
+      dir = get_default_dir (me);
+      set_grob_direction (me, dir);
+    }
 
-  s = ly_eval_str (type_str + "stem-shorten");
-  scm_to_array (s, &a);
+  /* Stems in unnatural (forced) direction should be shortened,
+     according to [Roush & Gourlay] */
+  Interval hp = head_positions (me);
+  if (dir && dir * hp[dir] >= 0)
+    {
+      SCM sshorten = me->get_property ("stem-shorten");
+      SCM scm_shorten = scm_is_pair (sshorten) ?
+       robust_list_ref ((duration_log (me) - 2) >? 0, sshorten): SCM_EOL;
+      Real shorten = 2* robust_scm2double (scm_shorten, 0);
 
-  // stem uses half-spaces
+      /* On boundary: shorten only half */
+      if (abs (head_positions (me)[dir]) <= 1)
+       shorten *= 0.5;
 
-  // fixme: use gh_list_ref () iso. array[]
-  Real shorten_f = a[((flag_i () - 2) >? 0) <? (a.size () - 1)] * 2;
+      length -= shorten;
+    }
 
-  /* URGURGURG
-     'set-default-stemlen' sets direction too
-   */
-  Direction dir = get_direction ();
-  if (!dir)
+  /* Tremolo stuff.  */
+  Grob *t_flag = unsmob_grob (me->get_property ("tremolo-flag"));
+  if (t_flag && !unsmob_grob (me->get_property ("beam")))
     {
-      dir = get_default_dir ();
-      directional_element (this).set (dir);
+      /* Crude hack: add extra space if tremolo flag is there.
+
+       We can't do this for the beam, since we get into a loop
+       (Stem_tremolo::raw_stencil () looks at the beam.) --hwn  */
+
+      Real minlen = 1.0
+       + 2 * Stem_tremolo::raw_stencil (t_flag).extent (Y_AXIS).length  ()
+       / ss;
+
+      if (durlog >= 3)
+       {
+         Interval flag_ext = flag (me).extent (Y_AXIS);
+         if (!flag_ext.is_empty ())
+           minlen += 2 * flag_ext.length () / ss;
+
+         /* The clash is smaller for down stems (since the tremolo is
+            angled up.) */
+         if (dir == DOWN)
+           minlen -= 1.0;
+       }
+      length = length >? (minlen + 1.0);
     }
-  
-  /* 
-    stems in unnatural (forced) direction should be shortened, 
-    according to [Roush & Gourlay]
-   */
-  if (((int)chord_start_f ())
-      && (get_direction () != get_default_dir ()))
-    length_f -= shorten_f;
 
+  Real st = dir ? hp[dir] + dir * length : 0;
 
-   Real st = head_positions()[dir] + dir * length_f;
-  
-   bool no_extend_b = to_boolean (get_elt_property ("no-stem-extend"));
-    if (!grace_b && !no_extend_b && dir * st < 0)
-      st = 0.0;
+  /* TODO: change name  to extend-stems to staff/center/'()  */
+  bool no_extend_b = to_boolean (me->get_property ("no-stem-extend"));
+  if (!no_extend_b && dir * st < 0)
+    st = 0.0;
+
+  /* Make a little room if we have a upflag and there is a dot.
+     previous approach was to lengthen the stem. This is not
+     good typesetting practice.  */
+  if (!get_beam (me) && dir == UP
+      && durlog > 2)
+    {
+      Grob * closest_to_flag = extremal_heads (me)[dir];
+      Grob * dots = closest_to_flag
+       ? Rhythmic_head::get_dots (closest_to_flag ) : 0;
+
+      if (dots)
+       {
+         Real dp = Staff_symbol_referencer::get_position (dots);
+         Real flagy = flag (me).extent (Y_AXIS)[-dir] * 2 / ss;
+
+         /* Very gory: add myself to the X-support of the parent,
+            which should be a dot-column. */
+         if (dir * (st + flagy - dp) < 0.5)
+           {
+             Grob *par = dots->get_parent (X_AXIS);
 
+             if (Dot_column::has_interface (par))
+               {
+                 Side_position_interface::add_support (par, me);
+
+                 /* TODO: apply some better logic here. The flag is
+                    curved inwards, so this will typically be too
+                    much. */
+               }
+           }
+       }
+    }
   return st;
 }
 
-/*
-  FIXME: wrong name
- */
+/* The log of the duration (Number of hooks on the flag minus two)  */
 int
-Stem::flag_i () const
+Stem::duration_log (Grob *me)
 {
-  SCM s = get_elt_property ("duration-log");
-  return  (gh_number_p (s)) ? gh_scm2int (s) : 2;
+  SCM s = me->get_property ("duration-log");
+  return (scm_is_number (s)) ? scm_to_int (s) : 2;
 }
 
 void
-Stem::position_noteheads ()
+Stem::position_noteheads (Grob *me)
 {
-  if (!heads_i ())
+  if (!head_count (me))
     return;
-  
-  Link_array<Score_element> heads =
-    Group_interface__extract_elements (this, (Score_element*)0, "heads");
+
+  Link_array<Grob> heads =
+    Pointer_group_interface__extract_grobs (me, (Grob*) 0, "note-heads");
 
   heads.sort (compare_position);
-  Direction dir =get_direction ();
-  
+  Direction dir = get_direction (me);
+
   if (dir < 0)
     heads.reverse ();
 
+  Real thick = thickness (me);
 
-  Real w = support_head ()->extent (X_AXIS)[dir];
-  for (int i=0; i < heads.size (); i++)
-    {
-      heads[i]->translate_axis (w - heads[i]->extent (X_AXIS)[dir], X_AXIS);
-    }
-  
-  bool parity= true;           // todo: make this settable.
-  int lastpos = int (Staff_symbol_referencer_interface (heads[0]).position_f ());
-  for (int i=1; i < heads.size (); i ++)
+  Grob *hed = support_head (me);
+  Real w = hed->extent (hed, X_AXIS)[dir];
+  for (int i = 0; i < heads.size (); i++)
+    heads[i]->translate_axis (w - heads[i]->extent (heads[i], X_AXIS)[dir],
+                             X_AXIS);
+
+  bool parity = true;
+  Real lastpos = Real (Staff_symbol_referencer::get_position (heads[0]));
+  for (int i = 1; i < heads.size (); i ++)
     {
-      Real p = Staff_symbol_referencer_interface (heads[i]).position_f ();
-      int dy =abs (lastpos- (int)p);
+      Real p = Staff_symbol_referencer::get_position (heads[i]);
+      Real dy = fabs (lastpos- p);
 
-      if (dy <= 1)
+      /*
+       dy should always be 0.5, 0.0, 1.0, but provide safety margin
+       for rounding errors.
+      */
+      if (dy < 1.1)            
        {
          if (parity)
            {
-             Real l  = heads[i]->extent (X_AXIS).length ();
-             heads[i]->translate_axis (l * get_direction (), X_AXIS);
+             Real ell = heads[i]->extent (heads[i], X_AXIS).length ();
+
+             Direction d = get_direction (me);
+             /*
+               Reversed head should be shifted ell-thickness, but this
+               looks too crowded, so we only shift ell-0.5*thickness.
+
+               This leads to assymetry: Normal heads overlap the
+               stem 100% whereas reversed heads only overlaps the
+               stem 50%
+             */
+
+             Real reverse_overlap = 0.5;
+             heads[i]->translate_axis ((ell - thick * reverse_overlap) * d,
+                                       X_AXIS);
+
+             if (is_invisible (me))
+               heads[i]->translate_axis (-thick * (2 - reverse_overlap) * d,
+                                         X_AXIS);
+
+            /* TODO:
+               
+             For some cases we should kern some more: when the
+             distance between the next or prev note is too large, we'd
+             get large white gaps, eg.
+       
+               |
+              X|
+              |X  <- kern this.
+              |
+             X
+       
+             */
            }
          parity = !parity;
        }
       else
        parity = true;
-      
+
       lastpos = int (p);
     }
 }
 
-void
-Stem::do_pre_processing ()
+MAKE_SCHEME_CALLBACK (Stem, before_line_breaking, 1);
+SCM
+Stem::before_line_breaking (SCM smob)
 {
-  stem_end_position ();        // ugh. Trigger direction calc.
-  position_noteheads ();
+  Grob *me = unsmob_grob (smob);
 
-  if (invisible_b ())
+  /*
+    Do the calculations for visible stems, but also for invisible stems
+    with note heads (i.e. half notes.)
+   */
+  if (head_count (me))
     {
-      set_elt_property ("transparent", SCM_BOOL_T);
-      set_empty (Y_AXIS);      
-      set_empty (X_AXIS);      
+      stem_end_position (me);  // ugh. Trigger direction calc.
+      position_noteheads (me);
     }
-
-  set_spacing_hints ();
+  
+  return SCM_UNSPECIFIED;
 }
 
-
-
-/**
-   set stem directions for hinting the optical spacing correction.
-
-   Modifies DIR_LIST property of the Stem's Paper_column
-
-   TODO: more advanced: supply height of noteheads as well, for more advanced spacing possibilities
+/*
+  ugh.
+  When in a beam with tuplet brackets, brew_mol is called early,
+  caching a wrong value.
  */
-void
-Stem::set_spacing_hints () 
+MAKE_SCHEME_CALLBACK (Stem, height, 2);
+SCM
+Stem::height (SCM smob, SCM ax)
 {
-  if (!invisible_b ())
+  Axis a = (Axis)scm_to_int (ax);
+  Grob *me = unsmob_grob (smob);
+  assert (a == Y_AXIS);
+
+  /*
+    ugh. - this dependency should be automatic.
+  */
+  Grob *beam = get_beam (me);
+  if (beam)
     {
-      SCM scmdir  = gh_int2scm (get_direction ());
-      SCM dirlist = column_l ()->get_elt_property ("dir-list");
-      if (dirlist == SCM_UNDEFINED)
-       dirlist = SCM_EOL;
+      Beam::after_line_breaking (beam->self_scm ());
+    }
 
-      if (scm_sloppy_memq (scmdir, dirlist) == SCM_EOL)
+  SCM mol = me->get_uncached_stencil ();
+  Interval iv;
+  if (mol != SCM_EOL)
+    iv = unsmob_stencil (mol)->extent (a);
+  if (Grob *b = get_beam (me))
+    {
+      Direction d = get_direction (me);
+      if (d == CENTER)
        {
-         dirlist = gh_cons (scmdir, dirlist);
-         column_l ()->set_elt_property ("dir-list", dirlist);
+         programming_error ("No stem direction");
+         d = UP;
        }
+      iv[d] += d * Beam::get_thickness (b) * 0.5 ;
     }
+
+  return ly_interval2scm (iv);
 }
 
-Molecule
-Stem::flag () const
+
+Stencil
+Stem::flag (Grob *me)
 {
-  String style;
-  SCM st = get_elt_property ("flag-style");
-  if ( gh_string_p (st))
+  /* TODO: maybe property stroke-style should take different values,
+     e.g. "" (i.e. no stroke), "single" and "double" (currently, it's
+     '() or "grace").  */
+  String flag_style;
+
+  SCM flag_style_scm = me->get_property ("flag-style");
+  if (scm_is_symbol (flag_style_scm))
+    flag_style = ly_symbol2string (flag_style_scm);
+  
+  if (flag_style == "no-flag")
+    return Stencil ();
+
+  bool adjust = true;
+
+  String staffline_offs;
+  if (String::compare (flag_style, "mensural") == 0)
+    /* Mensural notation: For notes on staff lines, use different
+       flags than for notes between staff lines.  The idea is that
+       flags are always vertically aligned with the staff lines,
+       regardless if the note head is on a staff line or between two
+       staff lines.  In other words, the inner end of a flag always
+       touches a staff line.
+    */
     {
-      style = ly_scm2string (st);
+      if (adjust)
+       {
+         int p = (int)(rint (stem_end_position (me)));
+         staffline_offs =
+           Staff_symbol_referencer::on_staffline (me, p) ? "0" : "1";
+       }
+      else
+       {
+         staffline_offs = "2";
+       }
+    }
+  else
+    {
+      staffline_offs = "";
+    }
+
+  char dir = (get_direction (me) == UP) ? 'u' : 'd';
+  String font_char = flag_style
+    + to_string (dir) + staffline_offs + to_string (duration_log (me));
+  Font_metric *fm = Font_interface::get_default_font (me);
+  Stencil flag = fm->find_by_name ("flags." + font_char);
+  if (flag.is_empty ())
+    me->warning (_f ("flag `%s' not found", font_char));
+
+  SCM stroke_style_scm = me->get_property ("stroke-style");
+  if (scm_is_string (stroke_style_scm))
+    {
+      String stroke_style = ly_scm2string (stroke_style_scm);
+      if (!stroke_style.is_empty ())
+       {
+         String font_char = to_string (dir) + stroke_style;
+         Stencil stroke = fm->find_by_name ("flags." + font_char);
+         if (stroke.is_empty ())
+           me->warning (_f ("flag stroke `%s' not found", font_char));
+         else
+           flag.add_stencil (stroke);
+       }
     }
 
-  char c = (get_direction () == UP) ? 'u' : 'd';
-  Molecule m = lookup_l ()->afm_find (String ("flags-") + to_str (c) + 
-                                     to_str (flag_i ()));
-  if (!style.empty_b ())
-    m.add_molecule(lookup_l ()->afm_find (String ("flags-") + to_str (c) + style));
-  return m;
+  return flag;
 }
 
-Interval
-Stem::dim_callback (Dimension_cache const* c) 
+MAKE_SCHEME_CALLBACK (Stem, width_callback, 2);
+SCM
+Stem::width_callback (SCM e, SCM ax)
 {
-  Stem * s = dynamic_cast<Stem*> (c->element_l ());
+  Axis a = (Axis) scm_to_int (ax);
+  assert (a == X_AXIS);
+  Grob *me = unsmob_grob (e);
+
+  Interval r;
   
-  Interval r (0, 0);
-  if (unsmob_element (s->get_elt_property ("beam")) || abs (s->flag_i ()) <= 2)
-    ;  // TODO!
-  else
+  if (is_invisible (me))
     {
-      r = s->flag ().dim_.x ();
+      r.set_empty ();
+    }    
+  else if (unsmob_grob (me->get_property ("beam")) || abs (duration_log (me)) <= 2)
+    {
+      r = Interval (-1, 1);
+      r *= thickness (me)/2; 
     }
-  return r;
+  else
+    {
+      r = flag (me).extent (X_AXIS)
+       + thickness (me)/2;
+    }  
+  return ly_interval2scm (r);
 }
 
+Real
+Stem::thickness (Grob *me)
+{
+  return scm_to_double (me->get_property ("thickness"))
+    * Staff_symbol_referencer::line_thickness (me);
+}
 
-const Real ANGLE = 20* (2.0*M_PI/360.0); // ugh!
-
-Molecule*
-Stem::do_brew_molecule_p () const
+MAKE_SCHEME_CALLBACK (Stem, print, 1);
+SCM
+Stem::print (SCM smob)
 {
-  Molecule *mol_p =new Molecule;
+  Grob *me = unsmob_grob (smob);
+  Stencil mol;
+  Direction d = get_direction (me);
 
-  Staff_symbol_referencer_interface si (first_head ());
+  Real stemlet_length = robust_scm2double (me->get_property ("stemlet-length"),
+                                          0.0);
+  bool stemlet = stemlet_length > 0.0;
   
-  Real y1 = si.position_f();
-  Real y2 = stem_end_position ();
-  
-  Interval stem_y(y1,y2);
-  stem_y.unite (Interval (y2,y1));
-
-  Real dy = staff_symbol_referencer (this).staff_space ()/2.0;
-  Real head_wid = 0;
-  if (support_head ())
-    head_wid = support_head ()->extent (X_AXIS).length ();
-  stem_y[Direction(-get_direction ())] += get_direction () * head_wid * tan(ANGLE)/(2*dy);
-  
-  if (!invisible_b ())
+  /* TODO: make the stem start a direction ?
+     This is required to avoid stems passing in tablature chords.  */
+  Grob *lh =
+    to_boolean (me->get_property ("avoid-note-head"))
+    ? last_head (me)
+    : lh = first_head (me);
+  Grob *beam = get_beam (me);
+
+  if (!lh && !stemlet)
+    return SCM_EOL;
+
+  if (stemlet && !beam)
+    return SCM_EOL;
+    
+  if (is_invisible (me))
+    return SCM_EOL;
+
+  Real y2 = stem_end_position (me);
+  Real y1 = y2;
+  Real half_space = Staff_symbol_referencer::staff_space (me) * 0.5;
+
+
+  if (lh)
+    y2 = Staff_symbol_referencer::get_position (lh);
+  else if (stemlet)
     {
-      Real stem_width = paper_l ()->get_var ("stemthickness");
-      Molecule ss =lookup_l ()->filledbox (Box (Interval (-stem_width/2, stem_width/2),
-                                                Interval (stem_y[DOWN]*dy, stem_y[UP]*dy)));
-      mol_p->add_molecule (ss);
+      Real beam_translation = Beam::get_beam_translation (beam);
+      Real beam_thickness = Beam::get_thickness (beam);
+      int beam_count = beam_multiplicity (me).length () + 1;
+
+      y2 -= d
+       * (0.5 * beam_thickness
+          + beam_translation * (0 >? (beam_count - 1))
+          + stemlet_length) / half_space;
     }
 
-  if (!beam_l () && abs (flag_i ()) > 2)
+  Interval stem_y (y1 <? y2, y2 >? y1);
+
+  if (Grob *hed = support_head (me))
     {
-      Molecule fl = flag ();
-      fl.translate_axis(stem_y[get_direction ()]*dy, Y_AXIS);
-      mol_p->add_molecule (fl);
+      /*
+       must not take ledgers into account.
+       */
+      Interval head_height = hed->extent (hed, Y_AXIS);
+      Real y_attach = Note_head::stem_attachment_coordinate (hed, Y_AXIS);
+
+      y_attach = head_height.linear_combination (y_attach);
+      stem_y[Direction (-d)] += d * y_attach/half_space;
     }
 
-  return mol_p;
-}
 
-Real
-Stem::off_callback (Dimension_cache const * c)
-{
-  Stem * st = dynamic_cast<Stem*> (c->element_l ());
+  // URG
+  Real stem_width = thickness (me);
+  Real blot =
+       me->get_layout ()->get_dimension (ly_symbol2scm ("blotdiameter"));
+
+  Box b = Box (Interval (-stem_width/2, stem_width/2),
+              Interval (stem_y[DOWN]*half_space, stem_y[UP]*half_space));
 
-  Real r=0;
-  if (Note_head * f = st->first_head ())
+  Stencil ss = Lookup::round_filled_box (b, blot);
+  mol.add_stencil (ss);
+
+  if (!get_beam (me) && abs (duration_log (me)) > 2)
     {
-      Interval head_wid(0, f->extent (X_AXIS).length ());
-
-      if (to_boolean (st->get_elt_property ("stem-centered")))
-       return head_wid.center ();
-      
-      Real rule_thick = st->paper_l ()->get_var ("stemthickness");
-      Direction d = st->get_direction ();
-      r = head_wid[d] - d * rule_thick ;
+      Stencil fl = flag (me);
+      fl.translate_axis (stem_y[d]*half_space - d * blot/2, Y_AXIS);
+      fl.translate_axis (stem_width/2, X_AXIS);
+      mol.add_stencil (fl);
     }
-  return r;
+
+  return mol.smobbed_copy ();
 }
 
+/*
+  move the stem to right of the notehead if it is up.
+ */
+MAKE_SCHEME_CALLBACK (Stem, offset_callback, 2);
+SCM
+Stem::offset_callback (SCM element_smob, SCM)
+{
+  Grob *me = unsmob_grob (element_smob);
+  Real r = 0.0;
+  
+  if (Grob *f = first_head (me))
+    {
+      Interval head_wid = f->extent (f, X_AXIS);
+      Real attach = 0.0;
+       
+      if (is_invisible (me))
+       attach = 0.0;
+      else
+       attach = Note_head::stem_attachment_coordinate (f, X_AXIS);
+       
+      Direction d = get_direction (me);
+      Real real_attach = head_wid.linear_combination (d * attach);
+      r = real_attach;
+       
+      /* If not centered: correct for stem thickness.  */
+      if (attach)
+       {
+         Real rule_thick = thickness (me);
+         r += - d * rule_thick * 0.5;
+       }
+    }
+  else
+    {
+      SCM rests = me->get_property ("rests");
+      if (scm_is_pair (rests))
+       {
+         Grob * rest = unsmob_grob (scm_car (rests));
+         r = rest->extent (rest, X_AXIS).center ();
+       }
+    }
+  return scm_make_real (r);
+}
 
+Spanner *
+Stem::get_beam (Grob *me)
+{
+  SCM b = me->get_property ("beam");
+  return dynamic_cast<Spanner*> (unsmob_grob (b));
+}
 
-Beam*
-Stem::beam_l ()const
+Stem_info
+Stem::get_stem_info (Grob *me)
 {
-  SCM b=  get_elt_property ("beam");
-  return dynamic_cast<Beam*> (unsmob_element (b));
+  /* Return cached info if available */
+  SCM scm_info = me->get_property ("stem-info");
+  if (!scm_is_pair (scm_info))
+    {
+      calc_stem_info (me);
+      scm_info = me->get_property ("stem-info");
+    }
+
+  Stem_info si;
+  si.dir_ = get_grob_direction (me);
+  si.ideal_y_ = scm_to_double (scm_car (scm_info));
+  si.shortest_y_ = scm_to_double (scm_cadr (scm_info));
+  return si;
 }
 
 
-// ugh still very long.
-Stem_info
-Stem::calc_stem_info () const
+/* TODO: add extra space for tremolos!  */
+void
+Stem::calc_stem_info (Grob *me)
 {
-  assert (beam_l ());
+  Direction my_dir = get_grob_direction (me);
 
-  Direction beam_dir = directional_element (beam_l ()).get ();
-  if (!beam_dir)
+  if (!my_dir)
     {
-      programming_error ("Beam dir not set.");
-      beam_dir = UP;
+      programming_error ("No stem dir set?");
+      my_dir  = UP;
     }
-    
-  Staff_symbol_referencer_interface st (this);
-  Real staff_space = st.staff_space ();
-  Real half_space = staff_space / 2;
-  Real interbeam_f = paper_l ()->interbeam_f (beam_l ()->get_multiplicity ());
-  Real thick = gh_scm2double (beam_l ()->get_elt_property ("beam-thickness"));
-  int multiplicity = beam_l ()->get_multiplicity ();
 
-  Stem_info info; 
-  info.idealy_f_ = chord_start_f ();
+  Real staff_space = Staff_symbol_referencer::staff_space (me);
+  Grob *beam = get_beam (me);
+  Real beam_translation = Beam::get_beam_translation (beam);
+  Real beam_thickness = Beam::get_thickness (beam);
+  int beam_count = Beam::get_direction_beam_count (beam, my_dir);
 
-  // for simplicity, we calculate as if dir == UP
-  info.idealy_f_ *= beam_dir;
-  SCM grace_prop = get_elt_property ("grace");
 
-  bool grace_b = to_boolean (grace_prop);
-  
-  Array<Real> a;
-  SCM s;
-  String type_str = grace_b ? "grace-" : "";
-  
-  s = ly_eval_str (type_str + "beamed-stem-minimum-length");
-  scm_to_array (s, &a);
-  Real minimum_length = a[multiplicity <? (a.size () - 1)] * staff_space;
+  /* Simple standard stem length */
+  SCM lengths = me->get_property ("beamed-lengths");
+  Real ideal_length =
+    scm_to_double (robust_list_ref (beam_count - 1, lengths))
+               
+    * staff_space
+    /* stem only extends to center of beam
+    */
+    - 0.5 * beam_thickness
+    ;
 
-  s = ly_eval_str (type_str + "beamed-stem-length");
-  scm_to_array (s, &a);
-  Real stem_length =  a[multiplicity <? (a.size () - 1)] * staff_space;
+  /* Condition: sane minimum free stem length (chord to beams) */
+  lengths = me->get_property ("beamed-minimum-free-lengths");
+  Real ideal_minimum_free =
+    scm_to_double (robust_list_ref (beam_count - 1, lengths))
+    * staff_space;
 
-  if (!beam_dir || (beam_dir == directional_element (this).get ()))
-    /* normal beamed stem */
-    {
-      if (multiplicity)
-       {
-         info.idealy_f_ += thick + (multiplicity - 1) * interbeam_f;
-       }
-      info.miny_f_ = info.idealy_f_;
-      info.maxy_f_ = INT_MAX;
 
-      info.idealy_f_ += stem_length;
-      info.miny_f_ += minimum_length;
+  /* UGH
+     It seems that also for ideal minimum length, we must use
+     the maximum beam count (for this direction):
 
-      /*
-       lowest beam of (UP) beam must never be lower than second staffline
+     \score{ \notes\relative c''{ [a8 a32] }}
 
-       Hmm, reference (Wanske?)
+     must be horizontal. */
+  Real height_of_my_beams = beam_thickness
+    + (beam_count - 1) * beam_translation;
 
-       Although this (additional) rule is probably correct,
-       I expect that highest beam (UP) should also never be lower
-       than middle staffline, just as normal stems.
-       
-      */
-      bool no_extend_b = to_boolean (get_elt_property ("no-stem-extend"));
-      if (!grace_b && !no_extend_b)
-       {
-         /* highest beam of (UP) beam must never be lower than middle
-            staffline
-            lowest beam of (UP) beam must never be lower than second staffline
-          */
-         info.miny_f_ =
-           info.miny_f_ >? 0
-           >? (- 2 * half_space - thick
-               + (multiplicity > 0) * thick
-               + interbeam_f * (multiplicity - 1));
-       }
-    }
-  else
-    /* knee */
-    {
-      info.idealy_f_ -= thick;
-      info.maxy_f_ = info.idealy_f_;
-      info.miny_f_ = -INT_MAX;
+  Real ideal_minimum_length = ideal_minimum_free
+    + height_of_my_beams
+    /* stem only extends to center of beam */
+    - 0.5 * beam_thickness;
+
+  ideal_length = ideal_length >? ideal_minimum_length;
+
+  /* Convert to Y position, calculate for dir == UP */
+  Real note_start =
+    /* staff positions */
+    head_positions (me)[my_dir] * 0.5
+    * my_dir * staff_space;
+  Real ideal_y = note_start + ideal_length;
+
+
+  /* Conditions for Y position */
+
+  /* Lowest beam of (UP) beam must never be lower than second staffline
+
+     Reference?
+
+     Although this (additional) rule is probably correct,
+     I expect that highest beam (UP) should also never be lower
+     than middle staffline, just as normal stems.
+
+     Reference?
+
+     Obviously not for grace beams.
 
-      info.idealy_f_ -= stem_length;
-      info.maxy_f_ -= minimum_length;
+     Also, not for knees.  Seems to be a good thing. */
+  bool no_extend_b = to_boolean (me->get_property ("no-stem-extend"));
+  bool is_knee = to_boolean (beam->get_property ("knee"));
+  if (!no_extend_b && !is_knee)
+    {
+      /* Highest beam of (UP) beam must never be lower than middle
+        staffline */
+      ideal_y =        ideal_y >? 0;
+      /* Lowest beam of (UP) beam must never be lower than second staffline */
+      ideal_y =        ideal_y >? (-staff_space
+                           - beam_thickness + height_of_my_beams);
     }
-  
-  info.idealy_f_ = (info.maxy_f_ <? info.idealy_f_) >? info.miny_f_;
 
-  s = beam_l ()->get_elt_property ("shorten");
-  if (gh_number_p (s))
-    info.idealy_f_ -= gh_double2scm (s);
 
-  Real interstaff_f = -beam_dir* calc_interstaff_dist (this, beam_l ());
+  ideal_y -= robust_scm2double (beam->get_property ("shorten"), 0);
+
+  Real minimum_free =
+    scm_to_double (robust_list_ref
+                  (beam_count - 1,
+                   me->get_property
+                   ("beamed-extreme-minimum-free-lengths")))
+    * staff_space;
+
+  Real minimum_length = minimum_free
+    + height_of_my_beams
+    /* stem only extends to center of beam */
+    - 0.5 * beam_thickness;
+
+  ideal_y *= my_dir;
+  Real minimum_y = note_start + minimum_length;
+  Real shortest_y = minimum_y * my_dir;
+
+  me->set_property ("stem-info",
+                   scm_list_2 (scm_make_real (ideal_y),
+                               scm_make_real (shortest_y)));
+}
+
+Slice
+Stem::beam_multiplicity (Grob *stem)
+{
+  SCM beaming = stem->get_property ("beaming");
+  Slice le = int_list_to_slice (scm_car (beaming));
+  Slice ri = int_list_to_slice (scm_cdr (beaming));
+  le.unite (ri);
+  return le;
+}
 
-  info.idealy_f_ += interstaff_f;
-  info.miny_f_ += interstaff_f;
-  info.maxy_f_ += interstaff_f ;
 
-  return info;
+/* FIXME:  Too many properties  */
+ADD_INTERFACE (Stem, "stem-interface",
+              "The stem represent the graphical stem.  "
+              "In addition, it internally connects note heads, beams and"
+              "tremolos. "
+              "Rests and whole notes have invisible stems.",
+              "tremolo-flag french-beaming "
+              "avoid-note-head thickness "
+              "stemlet-length rests "
+              "stem-info beamed-lengths beamed-minimum-free-lengths "
+              "beamed-extreme-minimum-free-lengths lengths beam stem-shorten "
+              "duration-log beaming neutral-direction stem-end-position "
+              "note-heads direction length flag-style "
+              "no-stem-extend stroke-style");
+
+/****************************************************************/
+
+Stem_info::Stem_info ()
+{
+  ideal_y_ = shortest_y_ = 0;
+  dir_ = CENTER;
 }
 
+void
+Stem_info::scale (Real x)
+{
+  ideal_y_ *= x;
+  shortest_y_ *= x;
+}