From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Mon, 25 Feb 2008 00:18:01 +0000 (-0300)
Subject: Fixes for score debugging: introduce a generic 'annotation variable,
X-Git-Tag: release/2.11.41-1~7
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=98311cc29e8664d281bcc40a808684e7553c8eaa;p=lilypond.git

Fixes for score debugging: introduce a generic 'annotation variable,
which defaults to quant-score if debug-XXX-scoring is set.
---

diff --git a/lily/beam.cc b/lily/beam.cc
index bc861aca14..3214fe4193 100644
--- a/lily/beam.cc
+++ b/lily/beam.cc
@@ -561,9 +561,15 @@ Beam::print (SCM grob)
     }
 	 
 #if (DEBUG_BEAM_SCORING)
-  SCM quant_score = me->get_property ("quant-score");
-  SCM debug = me->layout ()->lookup_variable (ly_symbol2scm ("debug-beam-scoring"));
-  if (to_boolean (debug) && scm_is_string (quant_score))
+  SCM annotation = me->get_property ("annotation");
+  if (!scm_is_string (annotation))
+    {
+      SCM debug = me->layout ()->lookup_variable (ly_symbol2scm ("debug-beam-scoring"));
+      if (to_boolean (debug))
+	annotation = me->get_property ("quant-score");
+    }
+  
+  if (scm_is_string (annotation))
     {
       extract_grob_set (me, "stems", stems);      
 
@@ -578,10 +584,13 @@ Beam::print (SCM grob)
       Direction stem_dir = stems.size () ? to_dir (stems[0]->get_property ("direction")) : UP;
 
       Stencil score = *unsmob_stencil (Text_interface::interpret_markup
-				    (me->layout ()->self_scm (), properties, quant_score));
+				    (me->layout ()->self_scm (), properties, annotation));
 
       if (!score.is_empty ())
-	the_beam.add_at_edge (Y_AXIS, stem_dir, score, 1.0);
+	{
+	  score.translate_axis (me->relative_coordinate(commonx, X_AXIS), X_AXIS);
+	  the_beam.add_at_edge (Y_AXIS, stem_dir, score, 1.0);
+	}
     }
 #endif
 
@@ -1524,6 +1533,7 @@ ADD_INTERFACE (Beam,
 	       ,
 	       
 	       /* properties */
+	       "annotation "
 	       "auto-knee-gap "
 	       "beamed-stem-shorten "
 	       "beaming "
diff --git a/lily/slur.cc b/lily/slur.cc
index a801281cd7..2e573ebf7c 100644
--- a/lily/slur.cc
+++ b/lily/slur.cc
@@ -130,23 +130,26 @@ Slur::print (SCM smob)
 		      line_thick);
 
 #if DEBUG_SLUR_SCORING
-  SCM quant_score = me->get_property ("quant-score");
-
-  if (to_boolean (me->layout ()
-		  ->lookup_variable (ly_symbol2scm ("debug-slur-scoring")))
-      && scm_is_string (quant_score))
+  SCM annotation = me->get_property ("annotation");
+  if (!scm_is_string (annotation))
+    {
+      SCM debug = me->layout ()->lookup_variable (ly_symbol2scm ("debug-slur-scoring"));
+      if (to_boolean (debug))
+	annotation = me->get_property ("quant-score");
+    }
+  
+  if (scm_is_string (annotation))
     {
       string str;
       SCM properties = Font_interface::text_font_alist_chain (me);
 
-
       if (!scm_is_number (me->get_property ("font-size")))
 	properties = scm_cons (scm_acons (ly_symbol2scm ("font-size"), scm_from_int (-6), SCM_EOL),
 			     properties);
       
       Stencil tm = *unsmob_stencil (Text_interface::interpret_markup
 				    (me->layout ()->self_scm (), properties,
-				     quant_score));
+				     annotation));
       a.add_at_edge (Y_AXIS, get_grob_direction (me), tm, 1.0);
     }
 #endif
@@ -388,6 +391,7 @@ ADD_INTERFACE (Slur,
 	       "A slur",
 	       
 	       /* properties */
+	       "annotation "
 	       "avoid-slur " 	/* UGH. */
 	       "control-points "
 	       "dash-fraction "
diff --git a/lily/tie.cc b/lily/tie.cc
index 87548a7056..9925aa428b 100644
--- a/lily/tie.cc
+++ b/lily/tie.cc
@@ -269,18 +269,21 @@ Tie::print (SCM smob)
 		      line_thick);
 
 #if DEBUG_TIE_SCORING
-  SCM quant_score = me->get_property ("quant-score");
-
-  if (to_boolean (me->layout ()
-		  ->lookup_variable (ly_symbol2scm ("debug-tie-scoring")))
-      && scm_is_string (quant_score))
+  SCM annotation = me->get_property ("annotation");
+  if (!scm_is_string (annotation))
+    {
+      SCM debug = me->layout ()->lookup_variable (ly_symbol2scm ("debug-tie-scoring"));
+      if (to_boolean (debug))
+	annotation = me->get_property ("quant-score");
+    }
+  if (scm_is_string (annotation))
     {
       string str;
       SCM properties = Font_interface::text_font_alist_chain (me);
 
       Stencil tm = *unsmob_stencil (Text_interface::interpret_markup
 				    (me->layout ()->self_scm (), properties,
-				     quant_score));
+				     annotation));
       tm.translate (Offset (b.control_[3][X_AXIS] + 0.5,
 			    b.control_[0][Y_AXIS] * 2));
       tm = tm.in_color (1, 0, 0);
@@ -302,6 +305,7 @@ ADD_INTERFACE (Tie,
 	       
 
 	       /* properties */
+	       "annotation "
 	       "avoid-slur " 	//  UGH.
 	       "control-points "
 	       "dash-fraction "
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 2ce60beece..4ec267019c 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -42,6 +42,7 @@ be created below this barline.")
      (alteration ,number? "Alteration numbers for accidental.")
      (alteration-alist ,list? "List of @code{(@var{pitch}
 . @var{accidental})} pairs for key signature.")
+     (annotation ,string? "Annotate a grob for debug purposes.")
      (arpeggio-direction ,ly:dir? "If set, put an arrow on the
 arpeggio squiggly line.")
      (arrow-length ,number? "Arrow length.")
@@ -731,7 +732,7 @@ entries @code{name} and @code{interfaces}.")
 did its job.  This ensures that a positioning is only done once.")
      (pure-Y-extent ,number-pair? "The estimated height of a system.")
 
-     (quant-score ,string? "The Beam quanting score -- can be stored for
+     (quant-score ,string? "The beam quanting score; stored for
 debugging.")
      (quantize-position ,boolean? "If set, a vertical alignment is aligned
 to be within staff spaces.")
diff --git a/scm/layout-beam.scm b/scm/layout-beam.scm
index ef5cde4778..9f1840dd33 100644
--- a/scm/layout-beam.scm
+++ b/scm/layout-beam.scm
@@ -28,10 +28,8 @@
 	(begin
 	  (ly:warning (_ "Error in beam quanting.  Expected (~S,~S) found ~S.")
 		      want-l want-r posns)
-	  (set! (ly:grob-property beam 'quant-score)
-		(format "(~S,~S)" want-l want-r)))
-	(set! (ly:grob-property beam 'quant-score) ""))
-
+	  (set! (ly:grob-property beam 'annotation)
+		(format "(~S,~S)" want-l want-r))))
     posns
     ))
 
@@ -40,15 +38,13 @@
   "Check whether the slope of BEAM is correct wrt. COMPARISON."
   (let* ((slope-sign (- (cdr posns) (car posns)))
 	 (correct (comparison slope-sign 0)))
-
     (if (not correct)
 	(begin
 	  (ly:warning (_ "Error in beam quanting.  Expected ~S 0, found ~S.")
-		      (procedure-name comparison) "0" slope-sign)
-	  (set! (ly:grob-property beam 'quant-score)
+		      (procedure-name comparison) slope-sign)
+	  (set! (ly:grob-property beam 'annotation)
 		(format "~S 0" (procedure-name comparison))))
-
-	(set! (ly:grob-property beam 'quant-score) ""))
+	(set! (ly:grob-property beam 'annotation) ""))
     posns))