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 init . args)
42 ((p (apply ly:make-prob (append
46 (page-set-property! p 'head-stencil (page-header p))
47 (page-set-property! p 'foot-stencil (page-footer p))
51 (define page-property ly:prob-property)
52 (define page-set-property! ly:prob-set-property!)
53 (define (page-property? page sym)
54 (eq? #t (page-property page sym)))
55 (define (page? x) (ly:prob-type? x 'page))
63 (string->symbol (format "page-~a" j))
65 (page-property pg j))))
67 '(page-number prev lines force penalty lines))
69 (define (page-system-numbers page)
70 (map (lambda (ps) (ly:prob-property ps 'number))
73 (define (page-translate-systems page)
81 (if (not (number? (ly:prob-property sys 'Y-offset)))
82 (ly:prob-set-property! sys 'Y-offset off))))
84 (zip (page-property page 'lines)
85 (page-property page 'configuration))))
87 (define (annotate-page layout stencil)
88 (let ((top-margin (ly:output-def-lookup layout 'top-margin))
89 (paper-height (ly:output-def-lookup layout 'paper-height))
90 (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
91 (add-stencil (lambda (y)
93 (ly:stencil-add stencil
94 (ly:stencil-translate-axis y 6 X))))))
96 (ly:stencil-translate-axis
97 (annotate-y-interval layout "paper-height"
98 (cons (- paper-height) 0)
102 (ly:stencil-translate-axis
103 (annotate-y-interval layout "top-margin"
104 (cons (- top-margin) 0)
108 (ly:stencil-translate-axis
109 (annotate-y-interval layout "bottom-margin"
110 (cons (- paper-height) (- bottom-margin paper-height))
115 (define (annotate-space-left page)
117 ((p-book (page-property page 'paper-book))
118 (layout (ly:paper-book-paper p-book))
119 (arrow (annotate-y-interval layout
122 (page-property page 'bottom-edge)
123 (let ((foot (page-property page 'foot-stencil)))
124 (if (and (ly:stencil? foot)
125 (not (ly:stencil-empty? foot)))
126 (car (ly:stencil-extent foot Y))
128 (page-property page 'bottom-system-edge))
131 (set! arrow (ly:stencil-translate-axis arrow 8 X))
138 (define (page-headfoot layout scopes number
139 sym separation-symbol dir last?)
141 "Create a stencil including separating space."
143 (let* ((header-proc (ly:output-def-lookup layout sym))
144 (sep (ly:output-def-lookup layout separation-symbol))
145 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
147 (if (procedure? header-proc)
148 (header-proc layout scopes number last?)
152 (if (and (number? sep)
153 (ly:stencil? head-stencil)
154 (not (ly:stencil-empty? head-stencil)))
158 (ly:stencil-combine-at-edge
159 stencil Y dir head-stencil
164 (if (or (annotate? layout)
165 (ly:output-def-lookup layout 'annotateheaders #f))
168 (ly:stencil-translate-axis
169 (annotate-y-interval layout
170 (symbol->string separation-symbol)
171 (cons (min 0 (* dir sep))
174 (/ (ly:output-def-lookup layout 'line-width) 2)
177 (ly:stencil-translate-axis
178 (annotate-y-interval layout
181 (- (min 0 (* dir sep))
182 (ly:output-def-lookup layout 'page-top-space))
185 (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X)
194 (define (page-header-or-footer page dir)
196 ((p-book (page-property page 'paper-book))
197 (layout (ly:paper-book-paper p-book))
198 (scopes (ly:paper-book-scopes p-book))
199 (lines (page-lines page))
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 LINES.
245 Offsets is a list of increasing numbers. They must be negated to
251 (page-translate-systems page)
253 ((p-book (page-property page 'paper-book))
254 (prop (lambda (sym) (page-property page sym)))
255 (layout (ly:paper-book-paper p-book))
256 (scopes (ly:paper-book-scopes p-book))
257 (lines (page-lines page))
258 (number (page-page-number page))
260 ;; TODO: naming paper-height/paper-width not analogous to TeX.
263 (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
264 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
265 (system-separator-stencil (if (markup? system-separator-markup)
266 (interpret-markup layout
267 (layout-extract-page-properties layout)
268 system-separator-markup)
271 (head-height (if (ly:stencil? (prop 'head-stencil))
272 (interval-length (ly:stencil-extent (prop 'head-stencil) Y))
275 (page-stencil (ly:make-stencil
277 (cons (prop 'left-margin) (prop 'paper-width))
278 (cons (- (prop 'top-margin)) 0)))
282 (add-to-page (lambda (stencil x y)
284 (ly:stencil-add page-stencil
285 (ly:stencil-translate stencil
288 (- 0 head-height y (prop 'top-margin)))
293 (let* ((stencil (paper-system-stencil system))
294 (y (ly:prob-property system 'Y-offset))
295 (is-title (paper-system-title?
298 (ly:prob-property system 'X-offset 0.0)
300 (if (and (ly:stencil? system-separator-stencil)
302 (not (paper-system-title? system))
303 (not (paper-system-title? last-system)))
305 system-separator-stencil
308 (car (paper-system-staff-extents last-system)))
310 (cdr (paper-system-staff-extents system))))))
311 (set! last-system system)
313 (head (prop 'head-stencil))
314 (foot (prop 'foot-stencil))
317 (if (or (annotate? layout)
318 (ly:output-def-lookup layout 'annotatesystems #f))
321 (for-each (lambda (sys next-sys)
322 (paper-system-annotate sys next-sys layout))
324 (append (cdr lines) (list #f)))
325 (paper-system-annotate-last (car (last-pair lines)) layout)))
327 (set! page-stencil (ly:stencil-combine-at-edge
331 (not (ly:stencil-empty? head)))
333 (ly:make-stencil "" (cons 0 0) (cons 0 0)))
336 (map add-system lines)
338 (ly:prob-set-property! page 'bottom-system-edge
339 (car (ly:stencil-extent page-stencil Y)))
340 (ly:prob-set-property! page 'space-left
341 (+ (prop 'bottom-edge)
342 (prop 'bottom-system-edge)
343 (if (and (ly:stencil? foot)
344 (not (ly:stencil-empty? foot)))
345 (car (ly:stencil-extent foot Y))
348 (if (annotate? layout)
350 (ly:stencil-add page-stencil
351 (annotate-space-left page))))
353 (if (and (ly:stencil? foot)
354 (not (ly:stencil-empty? foot)))
358 (ly:stencil-translate
361 (+ (- (prop 'bottom-edge))
362 (- (car (ly:stencil-extent foot Y)))))))))
365 (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))
368 (if (or (annotate? layout)
369 (ly:output-def-lookup layout 'annotatepage #f))
370 (set! page-stencil (annotate-page layout page-stencil)))
375 (define-public (page-stencil page)
376 (if (not (ly:stencil? (page-property page 'stencil)))
378 ;; todo: make tweakable.
379 ;; via property + callbacks.
381 (page-set-property! page 'stencil (make-page-stencil page)))
382 (page-property page 'stencil))
384 (define (calc-printable-height page)
385 "Printable area for music and titles; matches default-page-make-stencil."
387 ((p-book (page-property page 'paper-book))
388 (layout (ly:paper-book-paper p-book))
389 (scopes (ly:paper-book-scopes p-book))
390 (number (page-page-number page))
391 (last? (page-property page 'is-last))
392 (h (- (ly:output-def-lookup layout 'paper-height)
393 (ly:output-def-lookup layout 'top-margin)
394 (ly:output-def-lookup layout 'bottom-margin)))
396 (head (page-property page 'head-stencil))
397 (foot (page-property page 'foot-stencil))
399 (- h (if (ly:stencil? head)
400 (interval-length (ly:stencil-extent head Y))
402 (if (ly:stencil? foot)
403 (interval-length (ly:stencil-extent foot Y))
406 ;; (display (list "\n available" available head foot))
409 (define (page-printable-height page)
410 (if (not (number? (page-property page 'printable-height)))
411 (page-set-property! page 'printable-height (calc-printable-height page)))
413 (page-property page 'printable-height))