X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpaper-system.scm;h=d414285d9df3d75a5dde138f8905343f5f7164a7;hb=9f3572d98bb948c9689cd1f75401a029451fa001;hp=d3a140531fac845276815dc18dccb11426bbdac3;hpb=04265f11d1f21416ccebd2dcaa1d903dc781b36e;p=lilypond.git

diff --git a/scm/paper-system.scm b/scm/paper-system.scm
index d3a140531f..d414285d9d 100644
--- a/scm/paper-system.scm
+++ b/scm/paper-system.scm
@@ -49,105 +49,57 @@
 	  stencil)
   ))
   
-(define-public (paper-system-annotate system next-system layout)
+(define-public (paper-system-annotate system layout)
   "Add arrows and texts to indicate which lengths are set."
-  (let* ((annotations (list))
-	 (annotate-extent-and-space
-	  (lambda (extent-accessor next-space
-				   extent-name next-space-name after-space-name)
-	    (let* ((extent-annotations (list))
-		   (this-extent (extent-accessor system))
-		   (next-extent (and next-system (extent-accessor next-system)))
-		   (push-annotation (lambda (stil)
-				      (set! extent-annotations
-					    (cons stil extent-annotations))))
-		   (color (if (paper-system-title? system) darkblue blue))
-		   (space-color (if (paper-system-title? system) darkred red)))
-	      (if (and (number-pair? this-extent)
-		       (not (= (interval-start this-extent)
-			       (interval-end this-extent))))
-		  (push-annotation (annotate-y-interval
-				    layout extent-name this-extent #f
-				    #:color color)))
-	      (if next-system
-		  (push-annotation (annotate-y-interval
-				    layout next-space-name
-				    (interval-translate (cons (- next-space) 0)
-							(if (number-pair? this-extent)
-							    (interval-start this-extent)
-							    0))
-				    #t
-				    #:color color)))
-	      (if (and next-system
-		       (number-pair? this-extent)
-		       (number-pair? next-extent))
-		  (let ((space-after
-			 (- (+ (ly:prob-property next-system 'Y-offset)
-			       (interval-start this-extent))
-			    (ly:prob-property system 'Y-offset)
-			    (interval-end next-extent)
-			    next-space)))
-		    (if (> space-after 0.01)
-			(push-annotation (annotate-y-interval
-					  layout
-					  after-space-name
-					  (interval-translate
-					   (cons (- space-after) 0)
-					   (- (interval-start this-extent)
-					      next-space))
-					  #t
-					  #:color space-color)))))
-	      (if (not (null? extent-annotations))
-		  (set! annotations
-			(stack-stencils X RIGHT 0.5
-					(list annotations
-					      (ly:make-stencil '() (cons 0 1) (cons 0 0))
-					      (apply ly:stencil-add
-						     extent-annotations))))))))
+  
+  (let*
+      ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
+       (append-stencil
+	(lambda (a b)
+	  (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
+
+       (annotate-property
+	(lambda (name extent is-length?)
+	  (set! annotations
+		(append-stencil annotations
+				(annotate-y-interval layout
+						     name extent is-length?)))))
+
+       (bbox-extent (paper-system-extent system Y))
+       (refp-extent (ly:prob-property system 'refpoint-Y-extent))
+       (next-space (ly:prob-property system 'next-space
+					     (ly:output-def-lookup layout 'between-system-space)
+					     ))
+       (next-padding (ly:prob-property system 'next-padding
+					       (ly:output-def-lookup layout 'between-system-padding)
+					       ))
+       )
 
-	 (grob (ly:prob-property system 'system-grob))
-	 (estimate-extent (if (ly:grob? grob)
-			      (annotate-y-interval layout
-						   "extent-estimate"
-						   (ly:grob-property grob 'pure-Y-extent)
-						   #f)
-			      #f)))
-    (let ((next-space (ly:prob-property
-		       system 'next-space
-		       (cond ((and next-system
-				   (paper-system-title? system)
-				   (paper-system-title? next-system))
-			      (ly:output-def-lookup layout 'between-title-space))
-			     ((paper-system-title? system)
-			      (ly:output-def-lookup layout 'after-title-space))
-			     ((and next-system
-				   (paper-system-title? next-system))
-			      (ly:output-def-lookup layout 'before-title-space))
-			     (else
-			      (ly:output-def-lookup layout 'between-system-space)))))
-	  (next-padding (ly:prob-property
-			 system 'next-padding
-			 (ly:output-def-lookup layout 'between-system-padding))))
-      (annotate-extent-and-space (lambda (sys)
-				   (paper-system-extent sys Y))
-				 next-padding
-				 "Y-extent" "next-padding" "space after next-padding")
-      (annotate-extent-and-space paper-system-staff-extents
-				 (+ next-space next-padding)
-				 "refpoint-Y-extent" "next-space+padding"
-				 "space after next-space+padding"))
-    (if estimate-extent
-	(set! annotations
-	      (stack-stencils X RIGHT 0.5
-			      (list annotations
-				    estimate-extent))))
-				
-    (if (not (null? annotations))
-	(set! (ly:prob-property system 'stencil)
-	      (ly:stencil-add
-	       (ly:prob-property system 'stencil)
-	       (ly:make-stencil
-		(ly:stencil-expr annotations)
-		(ly:stencil-extent empty-stencil X)
-		(ly:stencil-extent empty-stencil Y)))))
-    (ly:prob-property system 'stencil)))
\ No newline at end of file
+    (if (number-pair? bbox-extent)
+	(begin
+	  (annotate-property  "Y-extent"
+			       bbox-extent #f)
+	  (annotate-property  "next-padding"
+			     (interval-translate (cons (- next-padding) 0) (car bbox-extent))
+			     #t)))
+    
+    ;; titles don't have a refpoint-Y-extent.
+    (if (number-pair? refp-extent)
+	(begin
+	  (annotate-property "refpoint-Y-extent"
+			     refp-extent #f)
+	
+	  (annotate-property "next-space"
+			     (interval-translate (cons (- next-space) 0) (car refp-extent))
+		       #t)))
+
+    (set! (ly:prob-property system 'stencil)
+	  (ly:stencil-add
+	   (ly:prob-property system 'stencil)
+	   (ly:make-stencil
+	    (ly:stencil-expr annotations)
+	    (ly:stencil-extent empty-stencil X)
+	    (ly:stencil-extent empty-stencil Y)
+	    )))
+    
+    ))