Issue 4195: Improve spacing annotations.

Extend `annotate-spacing-spec' to also show the name of the used spacing
property, if possible.

Note that this patch is a Scheme hack only; to further improve the
annotation it would be necessary to make `ly:get-spacing-spec' return the
appropriate spacing property, too (if possible).

diff --git a/scm/page.scm b/scm/page.scm
index 8fa1f0e10e9f7e0188ed172e7a678e93886893c5..d1f81d0a8b0cb6d7a38e39fe9889fd4a0555185f 100644 (file)
--- a/scm/page.scm
+++ b/scm/page.scm
@@ -102,6 +102,7 @@
           (ly:stencil-add stencil
                           (ly:stencil-translate-axis
                            (annotate-spacing-spec layout
+                                                  (symbol->string sym)
                                                   spacing-spec
                                                   (- top-margin)
                                                   (car header-extent)

diff --git a/scm/paper-system.scm b/scm/paper-system.scm
index 97d70d75b3571af7ccd49c6e8df53dcd06516dcc..75f7b9f62ee20ab14588be94345246f88f287c68 100644 (file)
--- a/scm/paper-system.scm
+++ b/scm/paper-system.scm
@@ -144,6 +144,11 @@
                   (after-Y (ly:grob-relative-coordinate after-staff grob Y)))
               (annotate-spacing-spec
                layout
+               ;; FIXME: Improve `ly:get-spacing-spec' to return the
+               ;; name of the used `XXX-XXX-spacing' property, if
+               ;; possible.  Right now we have to use the empty
+               ;; string.
+               ""
                (ly:get-spacing-spec before-staff after-staff)
                before-Y
                after-Y))))
@@ -188,21 +193,22 @@
                                                    #f)
                               #f))
 
-         (spacing-spec (cond ((and next-system
-                                   (paper-system-title? system)
-                                   (paper-system-title? next-system))
-                              (ly:output-def-lookup layout 'markup-markup-spacing))
-                             ((paper-system-title? system)
-                              (ly:output-def-lookup layout 'markup-system-spacing))
-                             ((and next-system
-                                   (paper-system-title? next-system))
-                              (ly:output-def-lookup layout 'score-markup-spacing))
-                             ((not next-system)
-                              (ly:output-def-lookup layout 'last-bottom-spacing))
-                             ((ly:prob-property system 'last-in-score #f)
-                              (ly:output-def-lookup layout 'score-system-spacing))
-                             (else
-                              (ly:output-def-lookup layout 'system-system-spacing))))
+         (spacing-spec-sym (cond ((and next-system
+                                       (paper-system-title? system)
+                                       (paper-system-title? next-system))
+                                  'markup-markup-spacing)
+                                 ((paper-system-title? system)
+                                  'markup-system-spacing)
+                                 ((and next-system
+                                       (paper-system-title? next-system))
+                                  'score-markup-spacing)
+                                 ((not next-system)
+                                  'last-bottom-spacing)
+                                 ((ly:prob-property system 'last-in-score #f)
+                                  'score-system-spacing)
+                                 (else
+                                  'system-system-spacing)))
+         (spacing-spec (ly:output-def-lookup layout spacing-spec-sym))
          (last-staff-Y (car (paper-system-staff-extents system)))
          (system-Y (ly:prob-property system 'Y-offset 0.0))
          (system-X (ly:prob-property system 'X-offset 0.0))
@@ -237,7 +243,9 @@
                                  empty-stencil))
 
          (system-annotation (annotate-spacing-spec
-                             layout spacing-spec
+                             layout
+                             (symbol->string spacing-spec-sym)
+                             spacing-spec
                              last-staff-Y
                              first-staff-next-system-Y))
          (annotations (ly:stencil-add

diff --git a/scm/stencil.scm b/scm/stencil.scm
index db5ff186c37d659a863e9cb0d77e65a0d764c61d..7598d1d9ebbba6fbe5e1d776ddbeca7f36d5ae3d 100644 (file)
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -800,7 +800,8 @@ with optional arrows of @code{max-size} on start and end controlled by
 
 ;; 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
+(define*-public (annotate-spacing-spec layout name 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 'basic-distance))
@@ -809,21 +810,27 @@ with optional arrows of @code{max-size} on start and end controlled by
          (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))))
+         (name-string (if (string-null? name)
+                         ""
+                         (simple-format #f " (~a)" name)))
+         (basic-annotation
+          (annotate-y-interval layout
+                               (simple-format #f "basic-dist~a" name-string)
+                               (cons (- start-Y-offset space) start-Y-offset)
+                               #t
+                               #:color (map (lambda (x) (* x 0.25)) base-color)))
+         (min-annotation
+          (annotate-y-interval layout
+                               (simple-format #f "min-dist~a" name-string)
+                               (cons (- start-Y-offset min-dist) start-Y-offset)
+                               #t
+                               #:color min-dist-color))
+         (extra-annotation
+          (annotate-y-interval layout
+                               (simple-format #f "extra dist~a" name-string)
+                               (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