patch::: 1.3.96.jcn9

[lilypond.git] / lily / score-element.cc

diff --git a/lily/score-element.cc b/lily/score-element.cc
index 39405a43242dfaf84288fd5d41c950e1a4605ba1..4a4c59d60da5972de8767809233786472562ac12 100644 (file)
--- a/lily/score-element.cc
+++ b/lily/score-element.cc
@@ -48,8 +48,6 @@ Score_element::Score_element(SCM basicprops)
   /*
     fixme: default should be no callback.
    */
-  set_extent_callback (molecule_extent_proc, X_AXIS);
-  set_extent_callback (molecule_extent_proc, Y_AXIS) ;   
 
   pscore_l_=0;
   lookup_l_ =0;
@@ -60,21 +58,37 @@ Score_element::Score_element(SCM basicprops)
 
   smobify_self ();
 
-  dim_cache_[X_AXIS].offset_callbacks_
-    = get_elt_property ("X-offset-callbacks");
-  dim_cache_[Y_AXIS].offset_callbacks_
-    = get_elt_property ("Y-offset-callbacks");
-
-  dim_cache_[X_AXIS].offsets_left_ = scm_ilength (dim_cache_[X_AXIS].offset_callbacks_);
-  dim_cache_[Y_AXIS].offsets_left_ = scm_ilength (dim_cache_[Y_AXIS].offset_callbacks_);  
-
-  SCM cb = get_elt_property ("X-extent-callback");
-  if (cb !=  SCM_EOL)
-    dim_cache_[X_AXIS].dimension_ = cb;
+  char const*onames[] = {"X-offset-callbacks", "Y-offset-callbacks"};
+  char const*enames[] = {"X-extent-callback", "Y-extent-callback"};
+  
+  for (int a = X_AXIS; a <= Y_AXIS; a++){
+    SCM l = get_elt_property (onames[a]);
+
+    if (scm_ilength (l) >=0)
+      {
+       dim_cache_[a].offset_callbacks_ = l;
+       dim_cache_[a].offsets_left_ = scm_ilength (l);
+      }
+    else
+      {
+       programming_error ("[XY]-offset-callbacks must be a list");
+      }
+
+    SCM cb = get_elt_property (enames[a]);
+
+    /*
+      Should change default to be empty? 
+     */
+    if (!gh_procedure_p (cb) && !gh_pair_p (cb))
+      cb = molecule_extent_proc;
+    
+    dim_cache_[a].dimension_ = cb;
+  }
 
-  cb = get_elt_property ("Y-extent-callback");  
-  if (cb != SCM_EOL)
-    dim_cache_[Y_AXIS].dimension_ = cb;
+  SCM meta = get_elt_property ("meta");
+  SCM ifs = scm_assoc (ly_symbol2scm ("interfaces"), meta);
+  
+  set_elt_property ("interfaces",gh_cdr (ifs));
 }
 
 
@@ -338,8 +352,8 @@ Score_element::add_dependency (Score_element*e)
 {
   if (e)
     {
-      Pointer_group_interface gi (this, "dependencies");
-      gi.add_element (e);
+      Pointer_group_interface ::add_element (this, "dependencies",e);
+
     }
   else
     programming_error ("Null dependency added");
@@ -569,9 +583,19 @@ Score_element::empty_b (Axis a)const
            gh_procedure_p (dim_cache_[a].dimension_ ));
 }
 
+/*
+  TODO: add
+
+    Score_element *refpoint
+
+  to arguments?
+ */
 Interval
-Score_element::extent (Axis a) const
+Score_element::extent (Score_element * refp, Axis a) const
 {
+  Real x = relative_coordinate (refp, a);
+
+  
   Dimension_cache * d = (Dimension_cache *)&dim_cache_[a];
   Interval ext ;   
   if (gh_pair_p (d->dimension_))
@@ -586,6 +610,9 @@ Score_element::extent (Axis a) const
   else
     return ext;
 
+  if (!gh_pair_p (d->dimension_))
+    return ext;
+  
   ext = ly_scm2interval (d->dimension_);
 
   SCM extra = get_elt_property (a == X_AXIS
@@ -610,6 +637,8 @@ Score_element::extent (Axis a) const
       ext.unite (Interval (s * gh_scm2double (gh_car (extra)),
                           s * gh_scm2double (gh_cdr (extra))));
     }
+
+  ext.translate (x);
   
   return ext;
 }
@@ -654,9 +683,10 @@ Score_element::common_refpoint (SCM elist, Axis a) const
 String
 Score_element::name () const
 {
-  SCM nm = get_elt_property ("name");
-  
-  return  nm == SCM_EOL ? classname (this) :ly_scm2string (nm) ;  
+  SCM meta = get_elt_property ("meta");
+  SCM nm = scm_assoc (ly_symbol2scm ("name"), meta);
+  nm =  (gh_pair_p (nm)) ? gh_cdr (nm) : SCM_EOL;
+  return  gh_string_p (nm) ?ly_scm2string (nm) :  classname (this);  
 }
 
 void
@@ -857,7 +887,7 @@ static void
 init_functions ()
 {
   interfaces_sym = scm_permanent_object (ly_symbol2scm ("interfaces"));
-  
+
   scm_make_gsubr ("ly-get-elt-property", 2, 0, 0, (Scheme_function_unknown)ly_get_elt_property);
   scm_make_gsubr ("ly-set-elt-property", 3, 0, 0, (Scheme_function_unknown)ly_set_elt_property);
   scm_make_gsubr ("ly-get-spanner-bound", 2 , 0, 0, (Scheme_function_unknown) spanner_get_bound);
@@ -885,4 +915,4 @@ Score_element::set_interface (SCM k)
 
 
 ADD_SCM_INIT_FUNC(scoreelt, init_functions);
-
+IMPLEMENT_TYPE_P(Score_element, "ly-element?");