(define-public (paper-system-stencil system)
(ly:prob-property system 'stencil))
+(define-public (paper-system-layout system)
+ (let*
+ ((g (paper-system-system-grob system)))
+
+ (if (ly:grob? g)
+ (ly:grob-layout g)
+ #f)))
+
+(define-public (paper-system-system-grob paper-system)
+ (ly:prob-property paper-system 'system-grob))
+
(define-public (paper-system-extent system axis)
(ly:stencil-extent (paper-system-stencil system) axis))
(define-public (paper-system-staff-extents ps)
- (ly:prob-property ps 'refpoint-Y-extent '(0 . 0)))
+ (ly:prob-property ps 'staff-refpoint-extent '(0 . 0)))
(define-public (paper-system-annotate-last system layout)
(let*
stencil)
))
-(define-public (paper-system-annotate system layout)
+(define-public (paper-system-annotate system next-system layout)
"Add arrows and texts to indicate which lengths are set."
-
- (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)))
+ (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))))))))
- (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)
- ))
- )
-
- (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)
- )))
-
- ))
+ (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)
+ "staff-refpoint-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)))
projects / lilypond.git / blobdiff