- (paper-height (ly:output-def-lookup layout 'paper-height))
- (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
- (top-margin (ly:output-def-lookup layout 'top-margin))
- (spaceable-staves (if (ly:grob? grob) (ly:system::get-spaceable-staves grob) '()))
- (all-staves (if (ly:grob? grob) (ly:system::get-staves grob) '()))
- (spaceable-staff-annotate
- (lambda (before-staff after-staff)
- (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
- (after-Y (ly:grob-relative-coordinate after-staff grob Y)))
- (annotate-spacing-spec
- layout
- (ly:get-spacing-spec before-staff after-staff)
- before-Y
- after-Y))))
-
- (staff-padding-annotate
- (lambda (before-staff after-staff)
- (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
- (before-X (ly:grob-relative-coordinate before-staff grob X))
- (before-X-ext (ly:grob-extent before-staff before-staff X))
- (after-Y (ly:grob-relative-coordinate after-staff grob Y))
- (after-X (ly:grob-relative-coordinate after-staff grob X))
- (after-X-ext (ly:grob-extent after-staff after-staff X))
- (skylines (ly:grob-property before-staff 'vertical-skylines))
- (after-skylines (ly:grob-property after-staff 'vertical-skylines))
- (padding (assoc-get 'padding
- (ly:get-spacing-spec before-staff after-staff)
- 0.0))
- (horizon-padding (ly:grob-property before-staff
- 'skyline-horizontal-padding
- 0.0)))
- (ly:stencil-translate
- (annotate-padding
- before-Y before-X skylines before-X-ext
- after-Y after-X after-skylines after-X-ext
- layout horizon-padding padding)
- (cons before-X before-Y)))))
-
- (staff-annotations (if (< 1 (length spaceable-staves))
- (map spaceable-staff-annotate
- (drop-right spaceable-staves 1)
- (drop spaceable-staves 1))
- '()))
- (staff-padding-annotations (if (< 1 (length all-staves))
- (map staff-padding-annotate
- (drop-right all-staves 1)
- (drop all-staves 1))
- '()))
- (estimate-extent (if (ly:grob? grob)
- (annotate-y-interval layout
- "extent-estimate"
- (ly:grob-property grob 'pure-Y-extent)
- #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))))
- (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))
- (next-system-Y (and next-system
- (ly:prob-property next-system 'Y-offset 0.0)))
- (next-system-X (and next-system
- (ly:prob-property next-system 'X-offset 0.0)))
- (first-staff-next-system-Y (if next-system
- (- (+ (cdr (paper-system-staff-extents next-system))
- system-Y)
- next-system-Y)
- (+ system-Y top-margin bottom-margin (- paper-height))))
-
- (skyline (or
- (ly:prob-property system 'vertical-skylines #f)
- (paper-system-extent system Y)))
- (next-skyline (and next-system
- (or
- (ly:prob-property next-system 'vertical-skylines #f)
- (paper-system-extent next-system Y))))
- (horizon-padding (and
- (ly:grob? grob)
- (ly:grob-property grob 'skyline-horizontal-padding 0)))
- (padding-annotation (if next-system
- (annotate-padding
- (- system-Y) system-X skyline (paper-system-extent system X)
- (- next-system-Y) next-system-X next-skyline (paper-system-extent next-system X)
- layout
- horizon-padding
- (assoc-get 'padding spacing-spec 0.0)
- #:base-color blue)
- empty-stencil))
-
- (system-annotation (annotate-spacing-spec
- layout spacing-spec
- last-staff-Y
- first-staff-next-system-Y))
- (annotations (ly:stencil-add
- padding-annotation
- (stack-stencils Y DOWN 0.0 staff-padding-annotations)
- (stack-stencils Y DOWN 0.0 (append staff-annotations (list system-annotation))))))
-
- (if estimate-extent
- (set! annotations
- (stack-stencils X RIGHT 5.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)))
+ (paper-height (ly:output-def-lookup layout 'paper-height))
+ (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
+ (top-margin (ly:output-def-lookup layout 'top-margin))
+ (spaceable-staves (if (ly:grob? grob) (ly:system::get-spaceable-staves grob) '()))
+ (all-staves (if (ly:grob? grob) (ly:system::get-staves grob) '()))
+ (spaceable-staff-annotate
+ (lambda (before-staff after-staff)
+ (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
+ (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))))
+
+ (staff-padding-annotate
+ (lambda (before-staff after-staff)
+ (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
+ (before-X (ly:grob-relative-coordinate before-staff grob X))
+ (before-X-ext (ly:grob-extent before-staff before-staff X))
+ (after-Y (ly:grob-relative-coordinate after-staff grob Y))
+ (after-X (ly:grob-relative-coordinate after-staff grob X))
+ (after-X-ext (ly:grob-extent after-staff after-staff X))
+ (skylines (ly:grob-property before-staff 'vertical-skylines))
+ (after-skylines (ly:grob-property after-staff 'vertical-skylines))
+ (padding (assoc-get 'padding
+ (ly:get-spacing-spec before-staff after-staff)
+ 0.0))
+ (horizon-padding (ly:grob-property before-staff
+ 'skyline-horizontal-padding
+ 0.0)))
+ (ly:stencil-translate
+ (annotate-padding
+ before-Y before-X skylines before-X-ext
+ after-Y after-X after-skylines after-X-ext
+ layout horizon-padding padding)
+ (cons before-X before-Y)))))
+
+ (staff-annotations (if (< 1 (length spaceable-staves))
+ (map spaceable-staff-annotate
+ (drop-right spaceable-staves 1)
+ (drop spaceable-staves 1))
+ '()))
+ (staff-padding-annotations (if (< 1 (length all-staves))
+ (map staff-padding-annotate
+ (drop-right all-staves 1)
+ (drop all-staves 1))
+ '()))
+ (estimate-extent (if (ly:grob? grob)
+ (annotate-y-interval layout
+ "extent-estimate"
+ (ly:grob-property grob 'pure-Y-extent)
+ #f)
+ #f))
+
+ (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))
+ (next-system-Y (and next-system
+ (ly:prob-property next-system 'Y-offset 0.0)))
+ (next-system-X (and next-system
+ (ly:prob-property next-system 'X-offset 0.0)))
+ (first-staff-next-system-Y (if next-system
+ (- (+ (cdr (paper-system-staff-extents next-system))
+ system-Y)
+ next-system-Y)
+ (+ system-Y top-margin bottom-margin (- paper-height))))
+
+ (skyline (or
+ (ly:prob-property system 'vertical-skylines #f)
+ (paper-system-extent system Y)))
+ (next-skyline (and next-system
+ (or
+ (ly:prob-property next-system 'vertical-skylines #f)
+ (paper-system-extent next-system Y))))
+ (horizon-padding (and
+ (ly:grob? grob)
+ (ly:grob-property grob 'skyline-horizontal-padding 0)))
+ (padding-annotation (if (skyline-pair-and-non-empty? next-system)
+ (annotate-padding
+ (- system-Y) system-X skyline (paper-system-extent system X)
+ (- next-system-Y) next-system-X next-skyline (paper-system-extent next-system X)
+ layout
+ horizon-padding
+ (assoc-get 'padding spacing-spec 0.0)
+ #:base-color blue)
+ empty-stencil))
+
+ (system-annotation (annotate-spacing-spec
+ layout
+ (symbol->string spacing-spec-sym)
+ spacing-spec
+ last-staff-Y
+ first-staff-next-system-Y))
+ (annotations (ly:stencil-add
+ padding-annotation
+ (stack-stencils Y DOWN 0.0 staff-padding-annotations)
+ (stack-stencils Y DOWN 0.0 (append staff-annotations (list system-annotation))))))
+
+ (if estimate-extent
+ (set! annotations
+ (stack-stencils X RIGHT 5.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)))