- (let*
- ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
- (append-stencil
- (lambda (a b)
- (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
-
- (annotate-property
- (lambda (name extent is-length?)
- (set! annotations
- (append-stencil annotations
- (annotate-y-interval layout
- name extent is-length?)))))
+ (let* ((annotations (list))
+ (annotate-extent-and-space
+ (lambda (extent-accessor next-space
+ extent-name next-space-name after-space-name)
+ (let* ((extent-annotations (list))
+ (this-extent (extent-accessor system))
+ (next-extent (and next-system (extent-accessor next-system)))
+ (push-annotation (lambda (stil)
+ (set! extent-annotations
+ (cons stil extent-annotations))))
+ (color (if (paper-system-title? system) darkblue blue))
+ (space-color (if (paper-system-title? system) darkred red)))
+ (if (and (number-pair? this-extent)
+ (not (= (interval-start this-extent)
+ (interval-end this-extent))))
+ (push-annotation (annotate-y-interval
+ layout extent-name this-extent #f
+ #:color color)))
+ (if next-system
+ (push-annotation (annotate-y-interval
+ layout next-space-name
+ (interval-translate (cons (- next-space) 0)
+ (if (number-pair? this-extent)
+ (interval-start this-extent)
+ 0))
+ #t
+ #:color color)))
+ (if (and next-system
+ (number-pair? this-extent)
+ (number-pair? next-extent))
+ (let ((space-after
+ (- (+ (ly:prob-property next-system 'Y-offset)
+ (interval-start this-extent))
+ (ly:prob-property system 'Y-offset)
+ (interval-end next-extent)
+ next-space)))
+ (if (> space-after 0.01)
+ (push-annotation (annotate-y-interval
+ layout
+ after-space-name
+ (interval-translate
+ (cons (- space-after) 0)
+ (- (interval-start this-extent)
+ next-space))
+ #t
+ #:color space-color)))))
+ (if (not (null? extent-annotations))
+ (set! annotations
+ (stack-stencils X RIGHT 0.5
+ (list annotations
+ (ly:make-stencil '() (cons 0 1) (cons 0 0))
+ (apply ly:stencil-add
+ extent-annotations))))))))