(ly:stencil-add stencil
(ly:stencil-translate-axis
(annotate-spacing-spec layout
+ (symbol->string sym)
spacing-spec
(- top-margin)
(car header-extent)
(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))))
#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))
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
;; 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))
(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