* scm/stencil.scm (annotate-y-interval): robustify: print nan/inf

markers when necessary.

* lily/program-option.cc (internal_set_option): add
strict_infinity_checking option.

9 files changed, 64 insertions, 42 deletions

diff --git a/ChangeLog b/ChangeLog
index d04e7cd6ea..75233cb455 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2006-02-19  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 
+	* scm/stencil.scm (annotate-y-interval): robustify: print nan/inf
+	markers when necessary.
+
+	* lily/program-option.cc (internal_set_option): add
+	strict_infinity_checking option.
+
 	* scm/output-lib.scm (cyan): swap yellow and cyan.
 
 2006-02-19  Graham Percival  <gpermus@gmail.com>
diff --git a/lily/include/main.hh b/lily/include/main.hh
index bd396a16f7..329be3f77b 100644
--- a/lily/include/main.hh
+++ b/lily/include/main.hh
@@ -37,7 +37,7 @@ extern bool is_TeX_format_global;
 extern bool point_and_click_global;
 extern string prefix_directory;
 extern bool use_object_keys;
-
+extern bool strict_infinity_checking;
 /*
   todo: collect in Output_option struct?
 */
diff --git a/lily/program-option.cc b/lily/program-option.cc
index 4ec7b2d3e4..215bcfe0b9 100644
--- a/lily/program-option.cc
+++ b/lily/program-option.cc
@@ -32,6 +32,8 @@ bool profile_property_accesses = false;
   crash if internally the wrong type is used for a grob property.
 */
 bool do_internal_type_checking_global;
+bool strict_infinity_checking = false; 
+
 
 static SCM option_hash;
 
@@ -78,6 +80,11 @@ void internal_set_option (SCM var, SCM val)
       use_object_keys = to_boolean (val);
       val = scm_from_bool (to_boolean (val));
     }
+  else if (var == ly_symbol2scm ("strict-infinity-checking"))
+    {
+      strict_infinity_checking = to_boolean (val);
+      val = scm_from_bool (to_boolean (val));
+    }
 }
 
 ssize const HELP_INDENT = 30;
diff --git a/lily/side-position-interface.cc b/lily/side-position-interface.cc
index 72dfbb8380..f5f51bced2 100644
--- a/lily/side-position-interface.cc
+++ b/lily/side-position-interface.cc
@@ -14,8 +14,7 @@ using namespace std;
 
 #include "note-head.hh"
 #include "warn.hh"
-#include "warn.hh"
-#include "dimensions.hh"
+#include "main.hh"
 #include "staff-symbol-referencer.hh"
 #include "pointer-group-interface.hh"
 #include "directional-element-interface.hh"
@@ -107,11 +106,12 @@ Side_position_interface::general_side_position (Grob *me, Axis a, bool use_exten
   if (fabs (total_off) > 1000)
     {
       string msg
-	= String_convert::form_string ("Improbable offset for grob %s: %f%s",
-				       me->name ().c_str (), total_off,
-				       INTERNAL_UNIT);
+	= String_convert::form_string ("Improbable offset for grob %s: %f",
+				       me->name ().c_str (), total_off);
 
       programming_error (msg);
+      if (strict_infinity_checking)
+	scm_misc_error (__FUNCTION__, "Improbable offset.", SCM_EOL);
     }
   return scm_from_double (total_off);
 }
diff --git a/lily/stencil.cc b/lily/stencil.cc
index a9693e7a7c..2fad44274d 100644
--- a/lily/stencil.cc
+++ b/lily/stencil.cc
@@ -8,8 +8,7 @@
 
 #include "stencil.hh"
 
-
-#include "dimensions.hh"
+#include "main.hh"
 #include "font-metric.hh"
 #include "input-smob.hh"
 #include "string-convert.hh"
@@ -95,6 +94,8 @@ Stencil::translate (Offset o)
 			     + "\n"
 			     + "Setting to zero.");
 	  o[a] = 0.0;
+	  if (strict_infinity_checking)
+	    scm_misc_error (__FUNCTION__, "Improbable offset.", SCM_EOL);
 	}
       incr (a);
     }
diff --git a/scm/framework-scm.scm b/scm/framework-scm.scm
index d20e5dea35..e4895ae2e0 100644
--- a/scm/framework-scm.scm
+++ b/scm/framework-scm.scm
@@ -10,6 +10,7 @@
 	     (srfi srfi-1)
 	     (ice-9 pretty-print)
 	     (srfi srfi-13)
+	     (scm page)
 	     (lily))
 
 (define-public (output-framework basename book scopes fields )
diff --git a/scm/lily.scm b/scm/lily.scm
index 43d1176ebb..5f9e364b7f 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -34,6 +34,7 @@ similar to chord syntax")
 					 "delete unusable PostScript files")
 	      (safe #f "Run safely")
 	      (verbose ,(ly:command-line-verbose?) "value for the --verbose flag")
+	      (strict-infinity-checking #f "If yes, crash on encountering Inf/NaN")
 	      (ttf-verbosity 0
 			   "how much verbosity for TTF font embedding?")
 	      (debug-gc #f
diff --git a/scm/page.scm b/scm/page.scm
index 9274eef3fd..616efe3469 100644
--- a/scm/page.scm
+++ b/scm/page.scm
@@ -365,7 +365,7 @@ create offsets.
     page-stencil))
               
 
-(define (page-stencil page)
+(define-public (page-stencil page)
   (if (not (ly:stencil? (page-property page 'stencil)))
 
       ;; todo: make tweakable.
diff --git a/scm/stencil.scm b/scm/stencil.scm
index 58b1934618..541b4bf28e 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -178,47 +178,53 @@ encloses the contents.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (annotate-y-interval layout name extent is-length)
-  ;; do something sensible for 0,0 intervals. 
-  (set! extent (interval-widen extent 0.001))
   (let*
       ((text-props (cons
 		    '((font-size . -3)
 		      (font-family . typewriter))
 		    (layout-extract-page-properties layout)))
-       (annotation (interpret-markup
-		    layout text-props
-		    (make-column-markup
-		     (list
-		      (make-whiteout-markup (make-simple-markup name))
-		      (make-whiteout-markup
-		       (make-simple-markup
-			(begin
-			  (display extent)
-			(cond
-			 ((interval-empty? extent) "empty")
-			 ((not (interval-sane? extent)) "insane")
-			 (is-length (format "~$" (interval-length extent)))
-			 (else
-			  (format "(~$,~$)" (car extent)
-				    (cdr extent)))))))))))
-       (arrows
-	(ly:stencil-translate-axis 
-	 (dimension-arrows (cons 0 (interval-length extent)))
-	 (interval-start extent) Y)))
+       (annotation #f)
+       )
 
-    (set! annotation
-	  (ly:stencil-aligned-to annotation Y CENTER))
-    
-    (set! annotation (ly:stencil-translate annotation
-			  (cons 0 (interval-center extent))))
+    ;; do something sensible for 0,0 intervals. 
+    (set! extent (interval-widen extent 0.001))
+    (if (not (interval-sane? extent))
+	(set! annotation (interpret-markup layout text-props
+					   (make-simple-markup (format "~a: NaN/inf" name))))
+	(let*
+	    ((text-stencil (interpret-markup
+			    layout text-props
+			    (make-column-markup
+			     (list
+			      (make-whiteout-markup (make-simple-markup name))
+			      (make-whiteout-markup
+			       (make-simple-markup
+				(cond
+				 ((interval-empty? extent) "empty")
+				 (is-length (format "~$" (interval-length extent)))
+				 (else
+				  (format "(~$,~$)" (car extent)
+					  (cdr extent))))))))))
+	     (arrows
+	      (ly:stencil-translate-axis 
+	       (dimension-arrows (cons 0 (interval-length extent)))
+	       (interval-start extent) Y)))
+	  
+	  (set! annotation
+		(ly:stencil-aligned-to text-stencil Y CENTER))
+	  
+	  (set! annotation (ly:stencil-translate
+			    annotation
+			    (cons 0 (interval-center extent))))
+	  
 
-    (set! annotation
-	  (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0))
+	  (set! annotation
+		(ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0))
 
-    (set! annotation
-	  (ly:make-stencil (ly:stencil-expr annotation)
-			   (ly:stencil-extent annotation X)
-			   (cons 10000 -10000)))
+	  (set! annotation
+		(ly:make-stencil (ly:stencil-expr annotation)
+				 (ly:stencil-extent annotation X)
+				 (cons 10000 -10000)))))
     annotation))