2 ;; page.scm -- implement Page stuff.
4 ;; source file of the GNU LilyPond music typesetter
6 ;; (c) 2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
9 (define-module (scm page)
34 (define (annotate? layout)
35 (eq? #t (ly:output-def-lookup layout 'annotate-spacing)))
38 (define page-module (current-module))
40 (define (make-page paper-book . args)
42 ((p (apply ly:make-prob (append
43 (list 'page (layout->page-init (ly:paper-book-paper paper-book))
44 'paper-book paper-book)
47 (page-set-property! p 'head-stencil (page-header p))
48 (page-set-property! p 'foot-stencil (page-footer p))
52 (define page-property ly:prob-property)
53 (define page-set-property! ly:prob-set-property!)
54 (define (page-property? page sym)
55 (eq? #t (page-property page sym)))
56 (define (page? x) (ly:prob-type? x 'page))
64 (string->symbol (format "page-~a" j))
66 (page-property pg j))))
68 '(page-number prev lines force penalty lines))
70 (define (page-system-numbers page)
71 (map (lambda (ps) (ly:prob-property ps 'number))
74 (define (page-translate-systems page)
82 (if (not (number? (ly:prob-property sys 'Y-offset)))
83 (ly:prob-set-property! sys 'Y-offset off))))
85 (zip (page-property page 'lines)
86 (page-property page 'configuration))))
88 (define (annotate-page layout stencil)
89 (let ((top-margin (ly:output-def-lookup layout 'top-margin))
90 (paper-height (ly:output-def-lookup layout 'paper-height))
91 (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
92 (add-stencil (lambda (y)
94 (ly:stencil-add stencil
95 (ly:stencil-translate-axis y 6 X))))))
97 (ly:stencil-translate-axis
98 (annotate-y-interval layout "paper-height"
99 (cons (- paper-height) 0)
103 (ly:stencil-translate-axis
104 (annotate-y-interval layout "top-margin"
105 (cons (- top-margin) 0)
109 (ly:stencil-translate-axis
110 (annotate-y-interval layout "bottom-margin"
111 (cons (- paper-height) (- bottom-margin paper-height))
116 (define (annotate-space-left page)
118 ((paper-book (page-property page 'paper-book))
119 (layout (ly:paper-book-paper paper-book))
120 (arrow (annotate-y-interval layout
123 (page-property page 'bottom-edge)
124 (let ((foot (page-property page 'foot-stencil)))
125 (if (and (ly:stencil? foot)
126 (not (ly:stencil-empty? foot)))
127 (car (ly:stencil-extent foot Y))
129 (page-property page 'bottom-system-edge))
132 (set! arrow (ly:stencil-translate-axis arrow 8 X))
139 (define (page-headfoot layout scopes number
140 sym separation-symbol dir last?)
142 "Create a stencil including separating space."
144 (let* ((header-proc (ly:output-def-lookup layout sym))
145 (sep (ly:output-def-lookup layout separation-symbol))
146 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
148 (if (procedure? header-proc)
149 (header-proc layout scopes number last?)
153 (if (and (number? sep)
154 (ly:stencil? head-stencil)
155 (not (ly:stencil-empty? head-stencil)))
159 (ly:stencil-combine-at-edge
160 stencil Y dir head-stencil
165 (if (or (annotate? layout)
166 (ly:output-def-lookup layout 'annotate-headers #f))
169 (ly:stencil-translate-axis
170 (annotate-y-interval layout
171 (symbol->string separation-symbol)
172 (cons (min 0 (* dir sep))
175 (/ (ly:output-def-lookup layout 'line-width) 2)
178 (ly:stencil-translate-axis
179 (annotate-y-interval layout
182 (- (min 0 (* dir sep))
183 (ly:output-def-lookup layout 'page-top-space))
186 (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X)
195 (define (page-header-or-footer page dir)
197 ((paper-book (page-property page 'paper-book))
198 (layout (ly:paper-book-paper paper-book))
199 (scopes (ly:paper-book-scopes paper-book))
200 (number (page-page-number page))
201 (last? (page-property page 'is-last))
204 (page-headfoot layout scopes number
213 (define (page-header page)
214 (page-header-or-footer page UP))
216 (define (page-footer page)
217 (page-header-or-footer page DOWN))
219 (define (layout->page-init layout)
220 "Alist of settings for page layout"
222 ((paper-height (ly:output-def-lookup layout 'paper-height))
223 (paper-width (ly:output-def-lookup layout 'paper-width))
225 (lmargin (ly:output-def-lookup layout 'left-margin))
226 (left-margin (if lmargin
229 (ly:output-def-lookup layout 'line-width)) 2)))
230 (bottom-edge (- paper-height
231 (ly:output-def-lookup layout 'bottom-margin)) )
232 (top-margin (ly:output-def-lookup layout 'top-margin))
235 `((paper-height . ,paper-height)
236 (paper-width . ,paper-width)
237 (left-margin . ,left-margin)
238 (top-margin . ,top-margin)
239 (bottom-edge . ,bottom-edge)
242 (define (make-page-stencil page)
243 "Construct a stencil representing the page from PAGE."
246 (page-translate-systems page)
248 ((paper-book (page-property page 'paper-book))
249 (prop (lambda (sym) (page-property page sym)))
250 (layout (ly:paper-book-paper paper-book))
251 (scopes (ly:paper-book-scopes paper-book))
252 (lines (page-lines page))
253 (number (page-page-number page))
255 ;; TODO: naming paper-height/paper-width not analogous to TeX.
257 (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
258 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
259 (system-separator-stencil (if (markup? system-separator-markup)
260 (interpret-markup layout
261 (layout-extract-page-properties layout)
262 system-separator-markup)
265 (head-height (if (ly:stencil? (prop 'head-stencil))
266 (interval-length (ly:stencil-extent (prop 'head-stencil) Y))
269 (page-stencil (ly:make-stencil '()))
273 (add-to-page (lambda (stencil x y)
275 (ly:stencil-add page-stencil
276 (ly:stencil-translate stencil
279 (- 0 head-height y (prop 'top-margin)))
284 (let* ((stencil (paper-system-stencil system))
285 (y (ly:prob-property system 'Y-offset))
286 (is-title (paper-system-title?
289 (ly:prob-property system 'X-offset 0.0)
291 (if (and (ly:stencil? system-separator-stencil)
293 (not (paper-system-title? system))
294 (not (paper-system-title? last-system)))
296 system-separator-stencil
299 (car (paper-system-staff-extents last-system)))
301 (cdr (paper-system-staff-extents system))))))
302 (set! last-system system)
304 (head (prop 'head-stencil))
305 (foot (prop 'foot-stencil))
309 (or (annotate? layout)
310 (ly:output-def-lookup layout 'annotate-systems #f))
314 (for-each (lambda (sys next-sys)
315 (paper-system-annotate sys next-sys layout))
317 (append (cdr lines) (list #f)))
318 (paper-system-annotate-last (car (last-pair lines)) layout)))
322 (not (ly:stencil-empty? head)))
324 (set! page-stencil (ly:stencil-add page-stencil
325 (ly:stencil-translate-axis head
326 (- 0 head-height (prop 'top-margin)) Y))))
328 (map add-system lines)
331 (ly:prob-set-property! page 'bottom-system-edge
332 (car (ly:stencil-extent page-stencil Y)))
333 (ly:prob-set-property! page 'space-left
334 (+ (prop 'bottom-edge)
335 (prop 'bottom-system-edge)
336 (if (and (ly:stencil? foot)
337 (not (ly:stencil-empty? foot)))
338 (car (ly:stencil-extent foot Y))
341 (if (annotate? layout)
343 (ly:stencil-add page-stencil
344 (annotate-space-left page))))
346 (if (and (ly:stencil? foot)
347 (not (ly:stencil-empty? foot)))
351 (ly:stencil-translate
354 (+ (- (prop 'bottom-edge))
355 (- (car (ly:stencil-extent foot Y)))))))))
358 (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))
361 (if (or (annotate? layout)
362 (ly:output-def-lookup layout 'annotate-page #f))
363 (set! page-stencil (annotate-page layout page-stencil)))
369 (define-public (page-stencil page)
370 (if (not (ly:stencil? (page-property page 'stencil)))
372 ;; todo: make tweakable.
373 ;; via property + callbacks.
375 (page-set-property! page 'stencil (make-page-stencil page)))
376 (page-property page 'stencil))
378 (define (calc-printable-height page)
379 "Printable area for music and titles; matches default-page-make-stencil."
381 ((paper-book (page-property page 'paper-book))
382 (layout (ly:paper-book-paper paper-book))
383 (h (- (ly:output-def-lookup layout 'paper-height)
384 (ly:output-def-lookup layout 'top-margin)
385 (ly:output-def-lookup layout 'bottom-margin)))
387 (head (page-property page 'head-stencil))
388 (foot (page-property page 'foot-stencil))
390 (- h (if (ly:stencil? head)
391 (interval-length (ly:stencil-extent head Y))
393 (if (ly:stencil? foot)
394 (interval-length (ly:stencil-extent foot Y))
397 ;; (display (list "\n available" available head foot))
400 (define (page-printable-height page)
401 (if (not (number? (page-property page 'printable-height)))
402 (page-set-property! page 'printable-height (calc-printable-height page)))
404 (page-property page 'printable-height))