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 configuration lines))
69 (define (page-system-numbers node)
70 (map (lambda (ps) (ly:prob-property ps 'number))
73 (define (annotate-page layout stencil)
75 ((topmargin (ly:output-def-lookup layout 'topmargin))
76 (vsize (ly:output-def-lookup layout 'vsize))
77 (bottommargin (ly:output-def-lookup layout 'bottommargin))
78 (add-stencil (lambda (y)
80 (ly:stencil-add stencil y))
84 (ly:stencil-translate-axis
85 (annotate-y-interval layout "vsize"
92 (ly:stencil-translate-axis
93 (annotate-y-interval layout "topmargin"
94 (cons (- topmargin) 0)
99 (ly:stencil-translate-axis
100 (annotate-y-interval layout "bottommargin"
101 (cons (- vsize) (- bottommargin vsize))
107 (define (annotate-space-left page)
109 ((p-book (page-property page 'paper-book))
110 (layout (ly:paper-book-paper p-book))
111 (arrow (annotate-y-interval layout
113 (cons (- (page-property page 'bottom-edge))
114 (page-property page 'bottom-system-edge))
117 (set! arrow (ly:stencil-translate-axis arrow 8 X))
124 (define (page-headfoot layout scopes number
125 sym separation-symbol dir last?)
127 "Create a stencil including separating space."
129 (let* ((header-proc (ly:output-def-lookup layout sym))
130 (sep (ly:output-def-lookup layout separation-symbol))
131 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
133 (if (procedure? header-proc)
134 (header-proc layout scopes number last?)
138 (if (and (number? sep)
139 (ly:stencil? head-stencil)
140 (not (ly:stencil-empty? head-stencil)))
144 (ly:stencil-combine-at-edge
145 stencil Y dir head-stencil
150 (if (annotate? layout)
153 (ly:stencil-translate-axis
154 (annotate-y-interval layout
155 (symbol->string separation-symbol)
156 (cons (min 0 (* dir sep))
159 (/ (ly:output-def-lookup layout 'linewidth) 2)
162 (ly:stencil-translate-axis
163 (annotate-y-interval layout
166 (- (min 0 (* dir sep))
167 (ly:output-def-lookup layout 'pagetopspace))
170 (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X)
179 (define (page-header-or-footer page dir)
181 ((p-book (page-property page 'paper-book))
182 (layout (ly:paper-book-paper p-book))
183 (scopes (ly:paper-book-scopes p-book))
184 (lines (page-lines page))
185 (offsets (page-configuration page))
186 (number (page-page-number page))
187 (last? (page-property page 'is-last))
190 (page-headfoot layout scopes number
199 (define (page-header page)
200 (page-header-or-footer page UP))
202 (define (page-footer page)
203 (page-header-or-footer page DOWN))
205 (define (layout->page-init layout)
206 "Alist of settings for page layout"
208 ((vsize (ly:output-def-lookup layout 'vsize))
209 (hsize (ly:output-def-lookup layout 'hsize))
211 (lmargin (ly:output-def-lookup layout 'leftmargin))
212 (leftmargin (if lmargin
215 (ly:output-def-lookup layout 'linewidth)) 2)))
217 (bottom-edge (- vsize
218 (ly:output-def-lookup layout 'bottommargin)))
219 (top-margin (ly:output-def-lookup layout 'topmargin))
224 (left-margin . ,leftmargin)
225 (top-margin . ,top-margin)
226 (bottom-edge . ,bottom-edge)
229 (define (make-page-stencil page)
230 "Construct a stencil representing the page from LINES.
232 Offsets is a list of increasing numbers. They must be negated to
239 ((p-book (page-property page 'paper-book))
240 (prop (lambda (sym) (page-property page sym)))
241 (layout (ly:paper-book-paper p-book))
242 (scopes (ly:paper-book-scopes p-book))
243 (lines (page-lines page))
244 (offsets (page-configuration page))
245 (number (page-page-number page))
247 ;; TODO: naming vsize/hsize not analogous to TeX.
250 (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
251 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
252 (system-separator-stencil (if (markup? system-separator-markup)
253 (interpret-markup layout
254 (layout-extract-page-properties layout)
255 system-separator-markup)
258 (head-height (if (ly:stencil? (prop 'head-stencil))
259 (interval-length (ly:stencil-extent (prop 'head-stencil) Y))
262 (page-stencil (ly:make-stencil
264 (cons (prop 'left-margin) (prop 'hsize))
265 (cons (- (prop 'top-margin)) 0)))
269 (add-to-page (lambda (stencil y)
271 (ly:stencil-add page-stencil
272 (ly:stencil-translate stencil
275 (- 0 head-height y (prop 'top-margin)))
279 (lambda (stencil-position)
280 (let* ((system (car stencil-position))
281 (stencil (paper-system-stencil system))
282 (y (cadr stencil-position))
283 (is-title (paper-system-title?
284 (car stencil-position))))
285 (add-to-page stencil y)
286 (if (and (ly:stencil? system-separator-stencil)
288 (not (paper-system-title? system))
289 (not (paper-system-title? last-system)))
291 system-separator-stencil
293 (car (paper-system-staff-extents last-system)))
295 (cdr (paper-system-staff-extents system))))))
296 (set! last-system system)
298 (head (prop 'head-stencil))
299 (foot (prop 'foot-stencil))
302 (if (annotate? layout)
304 (for-each (lambda (sys) (paper-system-annotate sys layout))
306 (paper-system-annotate-last (car (last-pair lines)) layout)))
308 (set! page-stencil (ly:stencil-combine-at-edge
312 (not (ly:stencil-empty? head)))
314 (ly:make-stencil "" (cons 0 0) (cons 0 0)))
317 (map add-system (zip lines offsets))
319 (ly:prob-set-property! page 'bottom-system-edge
320 (car (ly:stencil-extent page-stencil Y)))
321 (ly:prob-set-property! page 'space-left
322 (car (ly:stencil-extent page-stencil Y)))
324 (if (annotate? layout)
326 (ly:stencil-add page-stencil
327 (annotate-space-left page))))
329 (if (and (ly:stencil? foot)
330 (not (ly:stencil-empty? foot)))
334 (ly:stencil-translate
337 (+ (- (prop 'bottom-edge))
338 (- (car (ly:stencil-extent foot Y)))))))))
341 (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))
344 (if (annotate? layout)
345 (set! page-stencil (annotate-page layout page-stencil)))
350 (define (page-stencil page)
351 (if (not (ly:stencil? (page-property page 'stencil)))
353 ;; todo: make tweakable.
354 ;; via property + callbacks.
356 (page-set-property! page 'stencil (make-page-stencil page)))
357 (page-property page 'stencil))
359 (define (calc-printable-height page)
360 "Printable area for music and titles; matches default-page-make-stencil."
362 ((p-book (page-property page 'paper-book))
363 (layout (ly:paper-book-paper p-book))
364 (scopes (ly:paper-book-scopes p-book))
365 (number (page-page-number page))
366 (last? (page-property page 'is-last))
367 (h (- (ly:output-def-lookup layout 'vsize)
368 (ly:output-def-lookup layout 'topmargin)
369 (ly:output-def-lookup layout 'bottommargin)))
371 (head (page-property page 'head-stencil))
372 (foot (page-property page 'foot-stencil))
374 (- h (if (ly:stencil? head)
375 (interval-length (ly:stencil-extent head Y))
377 (if (ly:stencil? foot)
378 (interval-length (ly:stencil-extent foot Y))
381 ;; (display (list "\n available" available head foot))
384 (define (page-printable-height page)
385 (if (not (number? (page-property page 'printable-height)))
386 (page-set-property! page 'printable-height (calc-printable-height page)))
388 (page-property page 'printable-height))