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)
89 ((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 y))
98 (ly:stencil-translate-axis
99 (annotate-y-interval layout "paper-height"
100 (cons (- paper-height) 0)
106 (ly:stencil-translate-axis
107 (annotate-y-interval layout "top-margin"
108 (cons (- top-margin) 0)
113 (ly:stencil-translate-axis
114 (annotate-y-interval layout "bottom-margin"
115 (cons (- paper-height) (- bottom-margin paper-height))
121 (define (annotate-space-left page)
123 ((p-book (page-property page 'paper-book))
124 (layout (ly:paper-book-paper p-book))
125 (arrow (annotate-y-interval layout
128 (page-property page 'bottom-edge)
129 (let ((foot (page-property page 'foot-stencil)))
130 (if (and (ly:stencil? foot)
131 (not (ly:stencil-empty? foot)))
132 (car (ly:stencil-extent foot Y))
134 (page-property page 'bottom-system-edge))
137 (set! arrow (ly:stencil-translate-axis arrow 8 X))
144 (define (page-headfoot layout scopes number
145 sym separation-symbol dir last?)
147 "Create a stencil including separating space."
149 (let* ((header-proc (ly:output-def-lookup layout sym))
150 (sep (ly:output-def-lookup layout separation-symbol))
151 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
153 (if (procedure? header-proc)
154 (header-proc layout scopes number last?)
158 (if (and (number? sep)
159 (ly:stencil? head-stencil)
160 (not (ly:stencil-empty? head-stencil)))
164 (ly:stencil-combine-at-edge
165 stencil Y dir head-stencil
170 (if (or (annotate? layout)
171 (ly:output-def-lookup layout 'annotateheaders #f))
174 (ly:stencil-translate-axis
175 (annotate-y-interval layout
176 (symbol->string separation-symbol)
177 (cons (min 0 (* dir sep))
180 (/ (ly:output-def-lookup layout 'line-width) 2)
183 (ly:stencil-translate-axis
184 (annotate-y-interval layout
187 (- (min 0 (* dir sep))
188 (ly:output-def-lookup layout 'page-top-space))
191 (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X)
200 (define (page-header-or-footer page dir)
202 ((p-book (page-property page 'paper-book))
203 (layout (ly:paper-book-paper p-book))
204 (scopes (ly:paper-book-scopes p-book))
205 (lines (page-lines page))
206 (number (page-page-number page))
207 (last? (page-property page 'is-last))
210 (page-headfoot layout scopes number
219 (define (page-header page)
220 (page-header-or-footer page UP))
222 (define (page-footer page)
223 (page-header-or-footer page DOWN))
225 (define (layout->page-init layout)
226 "Alist of settings for page layout"
228 ((paper-height (ly:output-def-lookup layout 'paper-height))
229 (paper-width (ly:output-def-lookup layout 'paper-width))
231 (lmargin (ly:output-def-lookup layout 'left-margin))
232 (left-margin (if lmargin
235 (ly:output-def-lookup layout 'line-width)) 2)))
236 (bottom-edge (- paper-height
237 (ly:output-def-lookup layout 'bottom-margin)) )
238 (top-margin (ly:output-def-lookup layout 'top-margin))
241 `((paper-height . ,paper-height)
242 (paper-width . ,paper-width)
243 (left-margin . ,left-margin)
244 (top-margin . ,top-margin)
245 (bottom-edge . ,bottom-edge)
248 (define (make-page-stencil page)
249 "Construct a stencil representing the page from LINES.
251 Offsets is a list of increasing numbers. They must be negated to
257 (page-translate-systems page)
259 ((p-book (page-property page 'paper-book))
260 (prop (lambda (sym) (page-property page sym)))
261 (layout (ly:paper-book-paper p-book))
262 (scopes (ly:paper-book-scopes p-book))
263 (lines (page-lines page))
264 (number (page-page-number page))
266 ;; TODO: naming paper-height/paper-width not analogous to TeX.
269 (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
270 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
271 (system-separator-stencil (if (markup? system-separator-markup)
272 (interpret-markup layout
273 (layout-extract-page-properties layout)
274 system-separator-markup)
277 (head-height (if (ly:stencil? (prop 'head-stencil))
278 (interval-length (ly:stencil-extent (prop 'head-stencil) Y))
281 (page-stencil (ly:make-stencil
283 (cons (prop 'left-margin) (prop 'paper-width))
284 (cons (- (prop 'top-margin)) 0)))
288 (add-to-page (lambda (stencil x y)
290 (ly:stencil-add page-stencil
291 (ly:stencil-translate stencil
294 (- 0 head-height y (prop 'top-margin)))
299 (let* ((stencil (paper-system-stencil system))
300 (y (ly:prob-property system 'Y-offset))
301 (is-title (paper-system-title?
304 (ly:prob-property system 'X-offset 0.0)
306 (if (and (ly:stencil? system-separator-stencil)
308 (not (paper-system-title? system))
309 (not (paper-system-title? last-system)))
311 system-separator-stencil
314 (car (paper-system-staff-extents last-system)))
316 (cdr (paper-system-staff-extents system))))))
317 (set! last-system system)
319 (head (prop 'head-stencil))
320 (foot (prop 'foot-stencil))
323 (if (or (annotate? layout)
324 (ly:output-def-lookup layout 'annotatesystems #f))
327 (for-each (lambda (sys) (paper-system-annotate sys layout))
329 (paper-system-annotate-last (car (last-pair lines)) layout)))
331 (set! page-stencil (ly:stencil-combine-at-edge
335 (not (ly:stencil-empty? head)))
337 (ly:make-stencil "" (cons 0 0) (cons 0 0)))
340 (map add-system lines)
342 (ly:prob-set-property! page 'bottom-system-edge
343 (car (ly:stencil-extent page-stencil Y)))
344 (ly:prob-set-property! page 'space-left
345 (+ (prop 'bottom-edge)
346 (prop 'bottom-system-edge)
347 (if (and (ly:stencil? foot)
348 (not (ly:stencil-empty? foot)))
349 (car (ly:stencil-extent foot Y))
352 (if (annotate? layout)
354 (ly:stencil-add page-stencil
355 (annotate-space-left page))))
357 (if (and (ly:stencil? foot)
358 (not (ly:stencil-empty? foot)))
362 (ly:stencil-translate
365 (+ (- (prop 'bottom-edge))
366 (- (car (ly:stencil-extent foot Y)))))))))
369 (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))
372 (if (or (annotate? layout)
373 (ly:output-def-lookup layout 'annotatepage #f))
374 (set! page-stencil (annotate-page layout page-stencil)))
379 (define-public (page-stencil page)
380 (if (not (ly:stencil? (page-property page 'stencil)))
382 ;; todo: make tweakable.
383 ;; via property + callbacks.
385 (page-set-property! page 'stencil (make-page-stencil page)))
386 (page-property page 'stencil))
388 (define (calc-printable-height page)
389 "Printable area for music and titles; matches default-page-make-stencil."
391 ((p-book (page-property page 'paper-book))
392 (layout (ly:paper-book-paper p-book))
393 (scopes (ly:paper-book-scopes p-book))
394 (number (page-page-number page))
395 (last? (page-property page 'is-last))
396 (h (- (ly:output-def-lookup layout 'paper-height)
397 (ly:output-def-lookup layout 'top-margin)
398 (ly:output-def-lookup layout 'bottom-margin)))
400 (head (page-property page 'head-stencil))
401 (foot (page-property page 'foot-stencil))
403 (- h (if (ly:stencil? head)
404 (interval-length (ly:stencil-extent head Y))
406 (if (ly:stencil? foot)
407 (interval-length (ly:stencil-extent foot Y))
410 ;; (display (list "\n available" available head foot))
413 (define (page-printable-height page)
414 (if (not (number? (page-property page 'printable-height)))
415 (page-set-property! page 'printable-height (calc-printable-height page)))
417 (page-property page 'printable-height))