From 98494a11739e7e8ce921c7c9ae43a63b66a9c34b Mon Sep 17 00:00:00 2001 From: Werner Lemberg Date: Thu, 20 Nov 2014 14:24:29 +0100 Subject: [PATCH] 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). --- scm/page.scm | 1 + scm/paper-system.scm | 40 ++++++++++++++++++++++++---------------- scm/stencil.scm | 39 +++++++++++++++++++++++---------------- 3 files changed, 48 insertions(+), 32 deletions(-) diff --git a/scm/page.scm b/scm/page.scm index 8fa1f0e10e..d1f81d0a8b 100644 --- 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 97d70d75b3..75f7b9f62e 100644 --- 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 db5ff186c3..7598d1d9eb 100644 --- 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 -- 2.39.5