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 'annotatespacing)))
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 ((topmargin (ly:output-def-lookup layout 'topmargin))
90 (vsize (ly:output-def-lookup layout 'vsize))
91 (bottommargin (ly:output-def-lookup layout 'bottommargin))
92 (add-stencil (lambda (y)
94 (ly:stencil-add stencil y))
98 (ly:stencil-translate-axis
99 (annotate-y-interval layout "vsize"
106 (ly:stencil-translate-axis
107 (annotate-y-interval layout "topmargin"
108 (cons (- topmargin) 0)
113 (ly:stencil-translate-axis
114 (annotate-y-interval layout "bottommargin"
115 (cons (- vsize) (- bottommargin vsize))
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
127 (cons (- (page-property page 'bottom-edge))
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 'linewidth) 2)
177 (ly:stencil-translate-axis
178 (annotate-y-interval layout
181 (- (min 0 (* dir sep))
182 (ly:output-def-lookup layout 'pagetopspace))
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 ((vsize (ly:output-def-lookup layout 'vsize))
223 (hsize (ly:output-def-lookup layout 'hsize))
225 (lmargin (ly:output-def-lookup layout 'leftmargin))
226 (leftmargin (if lmargin
229 (ly:output-def-lookup layout 'linewidth)) 2)))
231 (bottom-edge (- vsize
232 (ly:output-def-lookup layout 'bottommargin)))
233 (top-margin (ly:output-def-lookup layout 'topmargin))
238 (left-margin . ,leftmargin)
239 (top-margin . ,top-margin)
240 (bottom-edge . ,bottom-edge)
243 (define (make-page-stencil page)
244 "Construct a stencil representing the page from LINES.
246 Offsets is a list of increasing numbers. They must be negated to
252 (page-translate-systems page)
254 ((p-book (page-property page 'paper-book))
255 (prop (lambda (sym) (page-property page sym)))
256 (layout (ly:paper-book-paper p-book))
257 (scopes (ly:paper-book-scopes p-book))
258 (lines (page-lines page))
259 (number (page-page-number page))
261 ;; TODO: naming vsize/hsize not analogous to TeX.
264 (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
265 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
266 (system-separator-stencil (if (markup? system-separator-markup)
267 (interpret-markup layout
268 (layout-extract-page-properties layout)
269 system-separator-markup)
272 (head-height (if (ly:stencil? (prop 'head-stencil))
273 (interval-length (ly:stencil-extent (prop 'head-stencil) Y))
276 (page-stencil (ly:make-stencil
278 (cons (prop 'left-margin) (prop 'hsize))
279 (cons (- (prop 'top-margin)) 0)))
283 (add-to-page (lambda (stencil x y)
285 (ly:stencil-add page-stencil
286 (ly:stencil-translate stencil
289 (- 0 head-height y (prop 'top-margin)))
294 (let* ((stencil (paper-system-stencil system))
295 (y (ly:prob-property system 'Y-offset))
296 (is-title (paper-system-title?
299 (ly:prob-property system 'X-offset 0.0)
301 (if (and (ly:stencil? system-separator-stencil)
303 (not (paper-system-title? system))
304 (not (paper-system-title? last-system)))
306 system-separator-stencil
309 (car (paper-system-staff-extents last-system)))
311 (cdr (paper-system-staff-extents system))))))
312 (set! last-system system)
314 (head (prop 'head-stencil))
315 (foot (prop 'foot-stencil))
318 (if (or (annotate? layout)
319 (ly:output-def-lookup layout 'annotatesystems #f))
322 (for-each (lambda (sys) (paper-system-annotate sys layout))
324 (paper-system-annotate-last (car (last-pair lines)) layout)))
326 (set! page-stencil (ly:stencil-combine-at-edge
330 (not (ly:stencil-empty? head)))
332 (ly:make-stencil "" (cons 0 0) (cons 0 0)))
335 (map add-system lines)
337 (ly:prob-set-property! page 'bottom-system-edge
338 (car (ly:stencil-extent page-stencil Y)))
339 (ly:prob-set-property! page 'space-left
340 (car (ly:stencil-extent page-stencil Y)))
342 (if (annotate? layout)
344 (ly:stencil-add page-stencil
345 (annotate-space-left page))))
347 (if (and (ly:stencil? foot)
348 (not (ly:stencil-empty? foot)))
352 (ly:stencil-translate
355 (+ (- (prop 'bottom-edge))
356 (- (car (ly:stencil-extent foot Y)))))))))
359 (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))
362 (if (or (annotate? layout)
363 (ly:output-def-lookup layout 'annotatepage #f))
364 (set! page-stencil (annotate-page layout page-stencil)))
369 (define (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 ((p-book (page-property page 'paper-book))
382 (layout (ly:paper-book-paper p-book))
383 (scopes (ly:paper-book-scopes p-book))
384 (number (page-page-number page))
385 (last? (page-property page 'is-last))
386 (h (- (ly:output-def-lookup layout 'vsize)
387 (ly:output-def-lookup layout 'topmargin)
388 (ly:output-def-lookup layout 'bottommargin)))
390 (head (page-property page 'head-stencil))
391 (foot (page-property page 'foot-stencil))
393 (- h (if (ly:stencil? head)
394 (interval-length (ly:stencil-extent head Y))
396 (if (ly:stencil? foot)
397 (interval-length (ly:stencil-extent foot Y))
400 ;; (display (list "\n available" available head foot))
403 (define (page-printable-height page)
404 (if (not (number? (page-property page 'printable-height)))
405 (page-set-property! page 'printable-height (calc-printable-height page)))
407 (page-property page 'printable-height))