2 ;; paper-system.scm -- implement paper-system objects.
4 ;; source file of the GNU LilyPond music typesetter
6 ;; (c) 2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
9 (define-module (scm paper-system))
13 (define-public (paper-system-title? system)
14 (equal? #t (ly:prob-property system 'is-title)
17 (define-public (paper-system-stencil system)
18 (ly:prob-property system 'stencil))
20 (define-public (paper-system-system-grob paper-system)
21 (ly:prob-property paper-system 'system-grob))
23 (define-public (paper-system-extent system axis)
24 (ly:stencil-extent (paper-system-stencil system) axis))
26 (define-public (paper-system-staff-extents ps)
27 (ly:prob-property ps 'refpoint-Y-extent '(0 . 0)))
29 (define-public (paper-system-annotate-last system layout)
31 ((bottomspace (ly:prob-property system 'bottom-space))
32 (y-extent (paper-system-extent system Y))
33 (x-extent (paper-system-extent system X))
34 (stencil (ly:prob-property system 'stencil))
36 (arrow (if (number? bottomspace)
37 (annotate-y-interval layout
39 (cons (- (car y-extent) bottomspace)
46 (ly:stencil-add stencil arrow)))
48 (set! (ly:prob-property system 'stencil)
52 (define-public (paper-system-annotate system next-system layout)
53 "Add arrows and texts to indicate which lengths are set."
54 (let* ((annotations (list))
55 (annotate-extent-and-space
56 (lambda (extent-accessor next-space
57 extent-name next-space-name after-space-name)
58 (let* ((extent-annotations (list))
59 (this-extent (extent-accessor system))
60 (next-extent (and next-system (extent-accessor next-system)))
61 (push-annotation (lambda (stil)
62 (set! extent-annotations
63 (cons stil extent-annotations))))
64 (color (if (paper-system-title? system) darkblue blue))
65 (space-color (if (paper-system-title? system) darkred red)))
66 (if (and (number-pair? this-extent)
67 (not (= (interval-start this-extent)
68 (interval-end this-extent))))
69 (push-annotation (annotate-y-interval
70 layout extent-name this-extent #f
73 (push-annotation (annotate-y-interval
74 layout next-space-name
75 (interval-translate (cons (- next-space) 0)
76 (if (number-pair? this-extent)
77 (interval-start this-extent)
82 (number-pair? this-extent)
83 (number-pair? next-extent))
85 (- (+ (ly:prob-property next-system 'Y-offset)
86 (interval-start this-extent))
87 (ly:prob-property system 'Y-offset)
88 (interval-end next-extent)
90 (if (> space-after 0.01)
91 (push-annotation (annotate-y-interval
95 (cons (- space-after) 0)
96 (- (interval-start this-extent)
99 #:color space-color)))))
100 (if (not (null? extent-annotations))
102 (stack-stencils X RIGHT 0.5
104 (ly:make-stencil '() (cons 0 1) (cons 0 0))
105 (apply ly:stencil-add
106 extent-annotations)))))))))
107 (let ((next-space (ly:prob-property
109 (cond ((and next-system
110 (paper-system-title? system)
111 (paper-system-title? next-system))
112 (ly:output-def-lookup layout 'between-title-space))
113 ((paper-system-title? system)
114 (ly:output-def-lookup layout 'after-title-space))
116 (paper-system-title? next-system))
117 (ly:output-def-lookup layout 'before-title-space))
119 (ly:output-def-lookup layout 'between-system-space)))))
120 (next-padding (ly:prob-property
122 (ly:output-def-lookup layout 'between-system-padding))))
123 (annotate-extent-and-space (lambda (sys)
124 (paper-system-extent sys Y))
126 "Y-extent" "next-padding" "space after next-padding")
127 (annotate-extent-and-space paper-system-staff-extents
128 (+ next-space next-padding)
129 "refpoint-Y-extent" "next-space+padding"
130 "space after next-space+padding"))
131 (if (not (null? annotations))
132 (set! (ly:prob-property system 'stencil)
134 (ly:prob-property system 'stencil)
136 (ly:stencil-expr annotations)
137 (ly:stencil-extent empty-stencil X)
138 (ly:stencil-extent empty-stencil Y)))))
139 (ly:prob-property system 'stencil)))