stencil)
))
-(define-public (paper-system-annotate system next-system layout)
+(define-public (paper-system-annotate system layout)
"Add arrows and texts to indicate which lengths are set."
- (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))))))))
+
+ (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?)))))
+
+ (bbox-extent (paper-system-extent system Y))
+ (refp-extent (ly:prob-property system 'refpoint-Y-extent))
+ (next-space (ly:prob-property system 'next-space
+ (ly:output-def-lookup layout 'between-system-space)
+ ))
+ (next-padding (ly:prob-property system 'next-padding
+ (ly:output-def-lookup layout 'between-system-padding)
+ ))
+ )
- (grob (ly:prob-property system 'system-grob))
- (estimate-extent (if (ly:grob? grob)
- (annotate-y-interval layout
- "extent-estimate"
- (ly:grob-property grob 'pure-Y-extent)
- #f)
- #f)))
- (let ((next-space (ly:prob-property
- system 'next-space
- (cond ((and next-system
- (paper-system-title? system)
- (paper-system-title? next-system))
- (ly:output-def-lookup layout 'between-title-space))
- ((paper-system-title? system)
- (ly:output-def-lookup layout 'after-title-space))
- ((and next-system
- (paper-system-title? next-system))
- (ly:output-def-lookup layout 'before-title-space))
- (else
- (ly:output-def-lookup layout 'between-system-space)))))
- (next-padding (ly:prob-property
- system 'next-padding
- (ly:output-def-lookup layout 'between-system-padding))))
- (annotate-extent-and-space (lambda (sys)
- (paper-system-extent sys Y))
- next-padding
- "Y-extent" "next-padding" "space after next-padding")
- (annotate-extent-and-space paper-system-staff-extents
- (+ next-space next-padding)
- "refpoint-Y-extent" "next-space+padding"
- "space after next-space+padding"))
- (if estimate-extent
- (set! annotations
- (stack-stencils X RIGHT 0.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)))
\ No newline at end of file
+ (if (number-pair? bbox-extent)
+ (begin
+ (annotate-property "Y-extent"
+ bbox-extent #f)
+ (annotate-property "next-padding"
+ (interval-translate (cons (- next-padding) 0) (car bbox-extent))
+ #t)))
+
+ ;; titles don't have a refpoint-Y-extent.
+ (if (number-pair? refp-extent)
+ (begin
+ (annotate-property "refpoint-Y-extent"
+ refp-extent #f)
+
+ (annotate-property "next-space"
+ (interval-translate (cons (- next-space) 0) (car refp-extent))
+ #t)))
+
+ (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)
+ )))
+
+ ))
projects / lilypond.git / blobdiff