X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fstencil.scm;h=d492f17a1cfd8323ddfa301d216218382567dfc9;hb=07f7ea94c774c7b746a0e7b703bc4a709b73eabf;hp=84206422dcda99264a9f0f1e416a838f1d4d3ade;hpb=a459c72c77a6a40553263b959260a8bfa86f5053;p=lilypond.git

diff --git a/scm/stencil.scm b/scm/stencil.scm
index 84206422dc..d492f17a1c 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2003--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2003--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -15,62 +15,74 @@
 ;;;; You should have received a copy of the GNU General Public License
 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
+(define (make-bezier-sandwich-stencil coords thick xext yext)
+  (let* ((command-list `(moveto
+                         ,(car (list-ref coords 3))
+                         ,(cdr (list-ref coords 3))
+                         curveto
+                         ,(car (list-ref coords 0))
+                         ,(cdr (list-ref coords 0))
+                         ,(car (list-ref coords 1))
+                         ,(cdr (list-ref coords 1))
+                         ,(car (list-ref coords 2))
+                         ,(cdr (list-ref coords 2))
+                         curveto
+                         ,(car (list-ref coords 4))
+                         ,(cdr (list-ref coords 4))
+                         ,(car (list-ref coords 5))
+                         ,(cdr (list-ref coords 5))
+                         ,(car (list-ref coords 6))
+                         ,(cdr (list-ref coords 6))
+                         closepath)))
+  (ly:make-stencil
+    `(path ,thick `(,@' ,command-list) 'round 'round #t)
+    xext
+    yext)))
+
 (define-public (stack-stencils axis dir padding stils)
-  "Stack stencils STILS in direction AXIS, DIR, using PADDING."
-  (cond
-   ((null? stils) empty-stencil)
-   ((null? (cdr stils)) (car stils))
-   (else (ly:stencil-combine-at-edge
-	  (car stils) axis dir (stack-stencils axis dir padding (cdr stils))
-	  padding))))
-
-(define-public (stack-stencils-padding-list axis dir padding stils)
-  "Stack stencils STILS in direction AXIS, DIR, using a list of PADDING."
-  (cond
-   ((null? stils) empty-stencil)
-   ((null? (cdr stils)) (car stils))
-   (else (ly:stencil-combine-at-edge
-	  (car stils)
-	  axis dir
-	  (stack-stencils-padding-list axis dir (cdr padding) (cdr stils))
-	  (car padding)))))
+  "Stack stencils @var{stils} in direction @var{axis}, @var{dir}, using
+@var{padding}."
+  (reduce
+   (lambda (next front)
+     (ly:stencil-stack front axis dir next padding))
+   empty-stencil
+   stils))
+
+(define-public (stack-stencils-padding-list axis dir paddings stils)
+  "Stack stencils @var{stils} in direction @var{axis}, @var{dir}, using
+a list of @var{paddings}."
+  (if (null? stils)
+      empty-stencil
+      (fold
+       (lambda (next padding front)
+         (ly:stencil-stack front axis dir next padding))
+       (car stils)
+       (cdr stils)
+       paddings)))
 
 (define-public (centered-stencil stencil)
-  "Center stencil @var{stencil} in both the X and Y directions"
+  "Center stencil @var{stencil} in both the X and Y directions."
   (ly:stencil-aligned-to (ly:stencil-aligned-to stencil X CENTER) Y CENTER))
 
 (define-public (stack-lines dir padding baseline stils)
-  "Stack vertically with a baseline-skip."
-  (define result empty-stencil)
-  (define last-y #f)
-  (do
-      ((last-stencil #f (car p))
-       (p stils (cdr p)))
-
-      ((null? p))
-
-    (if (number? last-y)
-	(begin
-	  (let* ((dy (max (+ (* dir (interval-bound (ly:stencil-extent last-stencil Y) dir))
-			     padding
-			     (* (- dir) (interval-bound (ly:stencil-extent (car p) Y) (- dir))))
-			  baseline))
-		 (y (+ last-y  (* dir dy))))
-
-
-
-	    (set! result
-		  (ly:stencil-add result (ly:stencil-translate-axis (car p) y Y)))
-	    (set! last-y y)))
-	(begin
-	  (set! last-y 0)
-	  (set! result (car p)))))
-
-  result)
-
+  "Stack vertically with a baseline skip."
+  (reduce-right
+   (lambda (next back) (ly:stencil-stack next Y dir back padding baseline))
+   empty-stencil
+   (map
+    (lambda (s)
+      ;; X-empty stencils may add vertical space.  A stencil that is
+      ;; merely Y-empty counts as horizontal spacing.  Since we want
+      ;; those to register as lines of their own (is this a good
+      ;; idea?), we make them a separately visible line.
+      (if (and (ly:stencil-empty? s Y)
+               (not (ly:stencil-empty? s X)))
+          (ly:make-stencil (ly:stencil-expr s) (ly:stencil-extent s X) '(0 . 0))
+          s))
+    stils)))
 
 (define-public (bracketify-stencil stil axis thick protrusion padding)
-  "Add brackets around STIL, producing a new stencil."
+  "Add brackets around @var{stil}, producing a new stencil."
 
   (let* ((ext (ly:stencil-extent stil axis))
 	 (lb (ly:bracket axis ext thick protrusion))
@@ -78,7 +90,7 @@
     (set! stil
 	  (ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding))
     (set! stil
-	  (ly:stencil-combine-at-edge lb (other-axis axis) 1 stil padding))
+	  (ly:stencil-combine-at-edge stil (other-axis axis) -1 lb padding))
     stil))
 
 (define (make-parenthesis-stencil
@@ -95,6 +107,10 @@ the more angular the shape of the parenthesis."
 	  (if (< width 0)
 	      (- width)
 	      0))
+         ;; X value farthest from baseline on outside  of curve
+         (outer-x (+ base-x width))
+         ;; X extent of bezier sandwich centerline curves
+         (x-extent (ordered-cons base-x outer-x))
 	 (bottom-y (interval-start y-extent))
 	 (top-y (interval-end y-extent))
 
@@ -106,7 +122,6 @@ the more angular the shape of the parenthesis."
 			     (if (< width 0)
 				 half-thickness
 				 (- half-thickness))))
-	 (x-extent (ordered-cons base-x outer-control-x))
 
 	 ;; Vertical distance between a control point
 	 ;; and the end point it connects to.
@@ -123,26 +138,25 @@ the more angular the shape of the parenthesis."
 	 (lower-inner-control-point
 	  (cons inner-control-x lower-control-y)))
 
-    (ly:make-stencil
-     (list 'bezier-sandwich
-	   `(quote ,(list
-		     ;; Step 4: curve through inner control points
-		     ;; to lower end point.
-		     upper-inner-control-point
-		     lower-inner-control-point
-		     lower-end-point
-		     ;; Step 3: move to upper end point.
-		     upper-end-point
-		     ;; Step 2: curve through outer control points
-		     ;; to upper end point.
-		     lower-outer-control-point
-		     upper-outer-control-point
-		     upper-end-point
-		     ;; Step 1: move to lower end point.
-		     lower-end-point))
-	   line-width)
-     (interval-widen x-extent (/ line-width 2))
-     (interval-widen y-extent (/ line-width 2)))))
+    (make-bezier-sandwich-stencil
+      (list
+	     ;; Step 4: curve through inner control points
+	     ;; to lower end point.
+	     upper-inner-control-point
+	     lower-inner-control-point
+	     lower-end-point
+	     ;; Step 3: move to upper end point.
+	     upper-end-point
+	     ;; Step 2: curve through outer control points
+	     ;; to upper end point.
+	     lower-outer-control-point
+	     upper-outer-control-point
+	     upper-end-point
+	     ;; Step 1: move to lower end point.
+	     lower-end-point)
+      line-width
+      (interval-widen x-extent (/ line-width 2))
+      (interval-widen y-extent (/ line-width 2)))))
 
 (define-public (parenthesize-stencil
 		stencil half-thickness width angularity padding)
@@ -152,18 +166,18 @@ the more angular the shape of the parenthesis."
 	      y-extent half-thickness (- width) angularity))
 	 (rp (make-parenthesis-stencil
 	      y-extent half-thickness width angularity)))
-    (set! stencil (ly:stencil-combine-at-edge lp X RIGHT stencil padding))
+    (set! stencil (ly:stencil-combine-at-edge stencil X LEFT lp padding))
     (set! stencil (ly:stencil-combine-at-edge stencil X RIGHT rp padding))
     stencil))
 
 (define-public (make-line-stencil width startx starty endx endy)
-  "Make a line stencil of given linewidth and set its extents accordingly"
+  "Make a line stencil of given linewidth and set its extents accordingly."
   (let ((xext (cons (min startx endx) (max startx endx)))
         (yext (cons (min starty endy) (max starty endy))))
     (ly:make-stencil
       (list 'draw-line width startx starty endx endy)
-      ; Since the line has rounded edges, we have to / can safely add half the
-      ; width to all coordinates!
+      ;; Since the line has rounded edges, we have to / can safely add half the
+      ;; width to all coordinates!
       (interval-widen xext (/ width 2))
       (interval-widen yext (/ width 2)))))
 
@@ -177,7 +191,7 @@ the more angular the shape of the parenthesis."
       xext yext))
 
 (define-public (make-circle-stencil radius thickness fill)
-  "Make a circle of radius @var{radius} and thickness @var{thickness}"
+  "Make a circle of radius @var{radius} and thickness @var{thickness}."
   (let*
       ((out-radius (+ radius (/ thickness 2.0))))
 
@@ -187,21 +201,285 @@ the more angular the shape of the parenthesis."
    (cons (- out-radius) out-radius))))
 
 (define-public (make-oval-stencil x-radius y-radius thickness fill)
-  "Make an oval from two Bezier curves, of x radius @var{x-radius},
-    y radius @code{y-radius},
-    and thickness @var{thickness} with fill defined by @code{fill}."
+  "Make an oval from two Bezier curves, of x@tie{}radius @var{x-radius},
+y@tie{}radius @code{y-radius}, and thickness @var{thickness} with fill
+defined by @code{fill}."
   (let*
       ((x-out-radius (+ x-radius (/ thickness 2.0)))
-       (y-out-radius (+ y-radius (/ thickness 2.0))) )
+       (y-out-radius (+ y-radius (/ thickness 2.0)))
+       (x-max x-radius)
+       (x-min (- x-radius))
+       (y-max y-radius)
+       (y-min (- y-radius))
+       (commands `(,(list 'moveto x-max 0)
+                   ,(list 'curveto x-max y-max x-min y-max x-min 0)
+                   ,(list 'curveto x-min y-min x-max y-min x-max 0)
+                   ,(list 'closepath)))
+       (command-list (fold-right append '() commands)))
+  (ly:make-stencil
+    `(path ,thickness `(,@',command-list) 'round 'round ,fill)
+    (cons (- x-out-radius) x-out-radius)
+    (cons (- y-out-radius) y-out-radius))))
+
+(define-public
+  (make-partial-ellipse-stencil
+    x-radius y-radius start-angle end-angle thick connect fill)
+  "Create an elliptical arc
+@var{x-radius} is the X radius of the arc.
+@var{y-radius} is the Y radius of the arc.
+@var{start-angle} is the starting angle of the arc in degrees.
+@var{end-angle} is the ending angle of the arc in degrees.
+@var{thick} is the thickness of the line.
+@var{connect} is a boolean flag indicating if the end should
+be connected to the start by a line.
+@var{fill} is a boolean flag indicating if the shape should be filled."
+  (define (make-radius-list x-radius y-radius)
+    "Makes a list of angle/radius pairs at intervals of PI/2 for
+the partial ellipse until 7*PI/2.  For example, in pseudo-code:
+> (make-radius-list 2 3)
+((0.0 . 2) (PI/2 . 3) (PI . -2) (3*PI/2 . -3)
+(2*PI . 2) (5*PI/2 . 3) (3*PI . -2) (7*PI/2 . -3))
+"
+    (apply append
+           (map (lambda (adder)
+                  (map (lambda (quadrant)
+                         (cons (+ adder (car quadrant))
+                               (cdr quadrant)))
+                       `((0.0 . (,x-radius . 0.0))
+                         (,PI-OVER-TWO . (0.0 . ,y-radius))
+                         (,PI . (,(- x-radius) . 0.0))
+                         (,THREE-PI-OVER-TWO . (0.0 . ,(- y-radius))))))
+                `(0.0 ,TWO-PI))))
+
+  (define
+    (insert-in-ordered-list ordering-function value inlist cutl? cutr?)
+    "Insert @var{value} in ordered list @var{inlist}. If @var{cutl?}, we
+cut away any parts of @var{inlist} before @var{value}. @var{cutr?} works
+the same way but for the right side. For example:
+> (insert-in-ordered-list < 4 '(1 2 3 6 7) #f #f)
+'(1 2 3 4 6 7)
+> (insert-in-ordered-list < 4 '(1 2 3 6 7) #t #f)
+'(4 6 7)
+> (insert-in-ordered-list < 4 '(1 2 3 6 7) #f #t)
+'(1 2 3 4)
+"
+    (define
+      (helper ordering-function value left-list right-list cutl? cutr?)
+      (if (null? right-list)
+          (append
+            (if cutl? '() left-list)
+            (list value)
+            (if cutr? '() right-list))
+          (if (ordering-function value (car right-list))
+              (append
+                (if cutl? '() left-list)
+                (list value)
+                (if cutr? '() right-list))
+              (helper
+                ordering-function
+                value
+                (append left-list (list (car right-list)))
+                (cdr right-list)
+                cutl?
+                cutr?))))
+    (helper ordering-function value '() inlist cutl? cutr?))
+
+  (define (ordering-function-1 a b) (car< a b))
+
+  (define (ordering-function-2 a b) (car<= a b))
+
+  (define (min-max-crawler min-max side l)
+    "Apply function @var{side} to each member of list and
+then reduce using @var{min-max}:
+> (min-max-crawler min car '((0 . 3) (-1 . 4) (1 . 2)))
+-1
+> (min-max-crawler min cdr '((0 . 3) (-1 . 4) (1 . 2)))
+2
+"
+    (reduce min-max
+            (if (eq? min-max min) 100000 -100000)
+            (map (lambda (x) (side x)) l)))
 
+  (let*
+      (;; the outside limit of the x-radius
+       (x-out-radius (+ x-radius (/ thick 2.0)))
+       ;; the outside limit of the y-radius
+       (y-out-radius (+ y-radius (/ thick 2.0)))
+       ;; end angle to radians
+       (new-end-angle (angle-0-2pi (degrees->radians end-angle)))
+       ;; length of the radius at the end angle
+       (end-radius (ellipse-radius x-out-radius y-out-radius new-end-angle))
+       ;; start angle to radians
+       (new-start-angle (angle-0-2pi (degrees->radians start-angle)))
+       ;; length of the radius at the start angle
+       (start-radius (ellipse-radius x-out-radius y-out-radius new-start-angle))
+       ;; points that the arc passes through at 90 degree intervals
+       (radius-list (make-radius-list x-out-radius y-out-radius))
+       ;; rectangular coordinates of arc endpoint
+       (rectangular-end-radius (polar->rectangular end-radius end-angle))
+       ;; rectangular coordinates of arc begin point
+       (rectangular-start-radius (polar->rectangular start-radius start-angle))
+       ;; we want the end angle to always be bigger than the start angle
+       ;; so we redefine it here just in case it is less
+       (new-end-angle
+         (if (<= new-end-angle new-start-angle)
+             (+ TWO-PI new-end-angle)
+             new-end-angle))
+       ;; all the points that may be extrema of the arc
+       ;; this is the 90 degree points plus the beginning and end points
+       ;; we use this to calculate extents
+       (possible-extrema
+         (insert-in-ordered-list
+           ordering-function-2
+           (cons new-end-angle rectangular-end-radius)
+           (insert-in-ordered-list
+             ordering-function-1
+             (cons new-start-angle rectangular-start-radius)
+             radius-list
+             #t
+             #f)
+           #f
+           #t)))
+    (ly:make-stencil
+      (list
+        'partial-ellipse
+        x-radius
+        y-radius
+        start-angle
+        end-angle
+        thick
+        connect
+        fill)
+      ;; we know the extrema points by crawling through the
+      ;; list of possible extrema and finding the min and max
+      ;; for x and y
+      (cons (min-max-crawler min cadr possible-extrema)
+            (min-max-crawler max cadr possible-extrema))
+      (cons (min-max-crawler min cddr possible-extrema)
+            (min-max-crawler max cddr possible-extrema)))))
+
+(define (line-part-min-max x1 x2)
+  (list (min x1 x2) (max x1 x2)))
+
+(define (bezier-part-min-max x1 x2 x3 x4)
+  ((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
+    (map
+      (lambda (x)
+        (+ (* x1 (expt (- 1 x) 3))
+           (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
+              (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
+                 (* x4 (expt x 3))))))
+      (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
+             (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
+          (list 0.0 1.0)
+          (filter
+            (lambda (x) (and (>= x 0) (<= x 1)))
+            (append
+              (list 0.0 1.0)
+              (map (lambda (op)
+                     (if (not (eqv? 0.0
+                                    (exact->inexact (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))))
+                         ;; Zeros of the bezier curve
+                         (/ (+ (- x1 (* 2 x2))
+                               (op x3
+                                   (sqrt (- (+ (expt x2 2)
+                                               (+ (expt x3 2) (* x1 x4)))
+                                            (+ (* x1 x3)
+                                               (+ (* x2 x4) (* x2 x3)))))))
+                            (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
+                         ;; Apply L'hopital's rule to get the zeros if 0/0
+                         (* (op 0 1)
+                            (/ (/ (- x4 x3) 2)
+                               (sqrt (- (+ (* x2 x2)
+                                           (+ (* x3 x3) (* x1 x4)))
+                                        (+ (* x1 x3)
+                                           (+ (* x2 x4) (* x2 x3)))))))))
+                   (list + -))))))))
+
+(define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
+  (map (lambda (x)
+         (apply bezier-part-min-max x))
+       `((,x1 ,x2 ,x3 ,x4) (,y1 ,y2 ,y3 ,y4))))
+
+(define (line-min-max x1 y1 x2 y2)
+  (map (lambda (x)
+         (apply line-part-min-max x))
+       `((,x1 ,x2) (,y1 ,y2))))
+
+(define (path-min-max origin pointlist)
+
+  ((lambda (x)
+     (list
+       (reduce min +inf.0 (map caar x))
+       (reduce max -inf.0 (map cadar x))
+       (reduce min +inf.0 (map caadr x))
+       (reduce max -inf.0 (map cadadr x))))
+    (map (lambda (x)
+	   (if (= (length x) 8)
+	       (apply bezier-min-max x)
+	       (apply line-min-max x)))
+	 (map (lambda (x y)
+		(append (list (cadr (reverse x)) (car (reverse x))) y))
+	      (append (list origin)
+		      (reverse (cdr (reverse pointlist)))) pointlist))))
+
+(define-public (make-connected-path-stencil pointlist thickness
+					    x-scale y-scale connect fill)
+  "Make a connected path described by the list @var{pointlist}, with
+thickness @var{thickness}, and scaled by @var{x-scale} in the X direction
+and @var{y-scale} in the Y direction.  @var{connect} and @var{fill} are
+boolean arguments that specify if the path should be connected or filled,
+respectively."
+
+  ;; paths using this routine are designed to begin at point '(0 . 0)
+  (let* ((origin (list 0 0))
+	 (boundlist (path-min-max origin pointlist))
+	 ;; modify pointlist to scale the coordinates
+	 (path (map (lambda (x)
+		      (apply
+			(if (= 6 (length x))
+			    (lambda (x1 x2 x3 x4 x5 x6)
+			      (list 'curveto
+				    (* x1 x-scale)
+				    (* x2 y-scale)
+				    (* x3 x-scale)
+				    (* x4 y-scale)
+				    (* x5 x-scale)
+				    (* x6 y-scale)))
+			    (lambda (x1 x2)
+			      (list 'lineto
+				    (* x1 x-scale)
+				    (* x2 y-scale))))
+			x))
+		    pointlist))
+	 ;; a path must begin with a `moveto'
+	 (prepend-origin (apply list (cons 'moveto origin) path))
+	 ;; if this path is connected, add closepath to the end
+	 (final-path (if connect
+			 (append prepend-origin (list 'closepath))
+			 prepend-origin))
+	 (command-list (fold-right append '() final-path)))
   (ly:make-stencil
-   (list 'oval x-radius y-radius thickness fill)
-   (cons (- x-out-radius) x-out-radius)
-   (cons (- y-out-radius) y-out-radius))))
+    `(path ,thickness
+	   `(,@',command-list)
+	   'round
+	   'round
+	   ,(if fill #t #f))
+    (coord-translate
+      ((if (< x-scale 0) reverse-interval identity)
+        (cons (* x-scale (list-ref boundlist 0))
+              (* x-scale (list-ref boundlist 1))))
+        `(,(/ thickness -2) . ,(/ thickness 2)))
+    (coord-translate
+      ((if (< y-scale 0) reverse-interval identity)
+        (cons (* y-scale (list-ref boundlist 2))
+              (* y-scale (list-ref boundlist 3))))
+        `(,(/ thickness -2) . ,(/ thickness 2))))))
 
 (define-public (make-ellipse-stencil x-radius y-radius thickness fill)
-  "Make an ellipse of x radius @var{x-radius}, y radius @code{y-radius},
-    and thickness @var{thickness} with fill defined by @code{fill}."
+  "Make an ellipse of x@tie{}radius @var{x-radius}, y@tie{}radius
+@code{y-radius}, and thickness @var{thickness} with fill defined by
+@code{fill}."
   (let*
       ((x-out-radius (+ x-radius (/ thickness 2.0)))
        (y-out-radius (+ y-radius (/ thickness 2.0))) )
@@ -213,8 +491,7 @@ the more angular the shape of the parenthesis."
 
 (define-public (box-grob-stencil grob)
   "Make a box of exactly the extents of the grob.  The box precisely
-encloses the contents.
-"
+encloses the contents."
   (let* ((xext (ly:grob-extent grob grob 0))
 	 (yext (ly:grob-extent grob grob 1))
 	 (thick 0.01))
@@ -227,7 +504,7 @@ encloses the contents.
 
 ;; TODO merge this and prev function.
 (define-public (box-stencil stencil thickness padding)
-  "Add a box around STENCIL, producing a new stencil."
+  "Add a box around @var{stencil}, producing a new stencil."
   (let* ((x-ext (interval-widen (ly:stencil-extent stencil 0) padding))
 	 (y-ext (interval-widen (ly:stencil-extent stencil 1) padding))
 	 (y-rule (make-filled-box-stencil (cons 0 thickness) y-ext))
@@ -240,7 +517,7 @@ encloses the contents.
     stencil))
 
 (define-public (circle-stencil stencil thickness padding)
-  "Add a circle around STENCIL, producing a new stencil."
+  "Add a circle around @var{stencil}, producing a new stencil."
   (let* ((x-ext (ly:stencil-extent stencil X))
 	 (y-ext (ly:stencil-extent stencil Y))
 	 (diameter (max (interval-length x-ext)
@@ -257,7 +534,7 @@ encloses the contents.
 
 (define-public (oval-stencil stencil thickness x-padding y-padding)
   "Add an oval around @code{stencil}, padded by the padding pair,
-   producing a new stencil."
+producing a new stencil."
   (let* ((x-ext (ly:stencil-extent stencil X))
 	 (y-ext (ly:stencil-extent stencil Y))
          (x-length (+ (interval-length x-ext) x-padding thickness))
@@ -274,18 +551,18 @@ encloses the contents.
 			    (interval-center y-ext))))))
 
 (define-public (ellipse-stencil stencil thickness x-padding y-padding)
-  "Add an ellipse around STENCIL, padded by the padding pair,
-   producing a new stencil."
+  "Add an ellipse around @var{stencil}, padded by the padding pair,
+producing a new stencil."
   (let* ((x-ext (ly:stencil-extent stencil X))
 	 (y-ext (ly:stencil-extent stencil Y))
          (x-length (+ (interval-length x-ext) x-padding thickness))
          (y-length (+ (interval-length y-ext) y-padding thickness))
-         ;(aspect-ratio (/ x-length y-length))
+         ;; (aspect-ratio (/ x-length y-length))
          (x-radius (* 0.707 x-length) )
          (y-radius (* 0.707 y-length) )
-	 ;(diameter (max (- (cdr x-ext) (car x-ext))
-	 ;		(- (cdr y-ext) (car y-ext))))
-	 ;(radius (+ (/ diameter 2) padding thickness))
+	 ;; (diameter (max (- (cdr x-ext) (car x-ext))
+	 ;;  		(- (cdr y-ext) (car y-ext))))
+	 ;; radius (+ (/ diameter 2) padding thickness))
 	 (ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
 
     (ly:stencil-add
@@ -296,7 +573,7 @@ encloses the contents.
 			    (interval-center y-ext))))))
 
 (define-public (rounded-box-stencil stencil thickness padding blot)
-   "Add a rounded box around STENCIL, producing a new stencil."
+   "Add a rounded box around @var{stencil}, producing a new stencil."
 
   (let* ((xext (interval-widen (ly:stencil-extent stencil 0) padding))
 	 (yext (interval-widen (ly:stencil-extent stencil 1) padding))
@@ -313,21 +590,6 @@ encloses the contents.
     (set! stencil (ly:stencil-add outer inner))
     stencil))
 
-
-(define-public (fontify-text font-metric text)
-  "Set TEXT with font FONT-METRIC, returning a stencil."
-  (let* ((b (ly:text-dimension font-metric text)))
-    (ly:make-stencil
-     `(text ,font-metric ,text) (car b) (cdr b))))
-
-(define-public (fontify-text-white scale font-metric text)
-  "Set TEXT with scale factor SCALE"
-  (let* ((b (ly:text-dimension font-metric text))
-	 ;;urg -- workaround for using ps font
-         (c `(white-text ,(* 2 scale) ,text)))
-    ;;urg -- extent is not from ps font, but we hope it's close
-    (ly:make-stencil c (car b) (cdr b))))
-
 (define-public (stencil-with-color stencil color)
   (ly:make-stencil
    (list 'color color (ly:stencil-expr stencil))
@@ -347,9 +609,11 @@ encloses the contents.
      stencil)
     ))
 
-(define-public (dimension-arrows destination max-size)
-  "Draw twosided arrow from here to @var{destination}"
-
+(define-public (arrow-stencil-maker start? end?)
+  "Return a function drawing a line from current point to @code{destination},
+with optional arrows of @code{max-size} on start and end controlled by
+@var{start?} and @var{end?}."
+  (lambda (destination max-size)
   (let*
       ((e_x 1+0i)
        (e_y 0+1i)
@@ -400,10 +664,15 @@ encloses the contents.
 	      (cons (max 0 (car destination))
 		    (max 0 (cdr destination)))))
 
-       (result (ly:stencil-add arrow-2 arrow-1 line)))
+       (result
+         (ly:stencil-add
+           (if start? arrow-2 empty-stencil)
+           (if end? arrow-1 empty-stencil)
+           line)))
 
+    result)))
 
-    result))
+(define-public dimension-arrows (arrow-stencil-maker #t #t))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ANNOTATIONS
@@ -435,7 +704,7 @@ encloses the contents.
                             (markup #:whiteout
                                     #:simple (cond
                                               ((interval-empty? extent)
-                                               (format "empty"))
+                                               "empty")
                                               (is-length
                                                (ly:format "~$" (interval-length extent)))
                                               (else
@@ -453,43 +722,43 @@ encloses the contents.
                                             (center-stencil-on-extent dim-stencil)
                                             0.5))
 	  (set! annotation
-		(ly:make-stencil (list 'color color (ly:stencil-expr annotation))
-				 (ly:stencil-extent annotation X)
-				 (cons 10000 -10000)))))
+		(stencil-with-color annotation color))))
     annotation))
 
 
-(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end
+;; TODO: figure out how to annotate padding nicely
+;; TODO: emphasize either padding or min-dist depending on which constraint was active
+(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset next-staff-Y
 				      #:key (base-color blue))
-  (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
-	 (space (get-spacing-var 'space))
+   (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
+	 (space (get-spacing-var 'basic-distance))
 	 (padding (get-spacing-var 'padding))
 	 (min-dist (get-spacing-var 'minimum-distance))
-	 (contrast-color (append (cdr base-color) (list (car base-color)))))
+	 (contrast-color (append (cdr base-color) (list (car base-color))))
+	 (min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y))
+	 (min-dist-color (if min-dist-blocks contrast-color base-color))
+	 (basic-annotation (annotate-y-interval layout
+						"basic-dist"
+						(cons (- start-Y-offset space) start-Y-offset)
+						#t
+						#:color (map (lambda (x) (* x 0.25)) base-color)))
+	 (min-annotation (annotate-y-interval layout
+					      "min-dist"
+					      (cons (- start-Y-offset min-dist) start-Y-offset)
+					      #t
+					      #:color min-dist-color))
+	 (extra-annotation (annotate-y-interval layout
+						"extra dist"
+						(cons next-staff-Y (- start-Y-offset min-dist))
+						#t
+						#:color (map (lambda (x) (* x 0.5)) min-dist-color))))
+
     (stack-stencils X RIGHT 0.0
 		    (list
-		     (annotate-y-interval layout
-					  "space"
-					  (cons (- start-Y-offset space) start-Y-offset)
-					  #t
-					  #:color (map (lambda (x) (* x 0.25)) base-color))
-		     (annotate-y-interval layout
-					  "min-dist"
-					  (cons (- start-Y-offset min-dist) start-Y-offset)
-					  #t
-					  #:color (map (lambda (x) (* x 0.5)) base-color))
-		     (ly:stencil-add
-		      (annotate-y-interval layout
-					   "bottom-of-extent"
-					   (cons prev-system-end start-Y-offset)
-					   #t
-					   #:color base-color)
-		      (annotate-y-interval layout
-					   "padding"
-					   (cons (- prev-system-end padding) prev-system-end)
-					   #t
-					   #:color contrast-color))))))
-
+		     basic-annotation
+		     (if min-dist-blocks
+			 min-annotation
+			 (ly:stencil-add min-annotation extra-annotation))))))
 
 (define-public (eps-file->stencil axis size file-name)
   (let*
@@ -504,8 +773,8 @@ encloses the contents.
 		   0))
        (scaled-bbox
 	(map (lambda (x) (* factor x)) bbox))
-       ; We need to shift the whole eps to (0,0), otherwise it will appear
-       ; displaced in lilypond (displacement will depend on the scaling!)
+       ;; We need to shift the whole eps to (0,0), otherwise it will appear
+       ;; displaced in lilypond (displacement will depend on the scaling!)
        (translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
        (clip-rect-string (ly:format
 			  "~a ~a ~a ~a rectclip"
@@ -538,8 +807,8 @@ BeginEPSF
 EndEPSF
 grestore
 "))
-	 ; Stencil starts at (0,0), since we have shifted the eps, and its
-         ; size is exactly the size of the scaled bounding box
+	 ;; Stencil starts at (0,0), since we have shifted the eps, and its
+         ;; size is exactly the size of the scaled bounding box
 	 (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0)))
 	 (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1))))