1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 2006--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
5 ;;;; LilyPond is free software: you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation, either version 3 of the License, or
8 ;;;; (at your option) any later version.
10 ;;;; LilyPond is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
18 (define-module (scm page)
42 (define (annotate? layout)
43 (eq? #t (ly:output-def-lookup layout 'annotate-spacing)))
46 (define page-module (current-module))
48 (define (make-page paper-book . args)
50 ((p (apply ly:make-prob (append
51 (list 'page (layout->page-init (ly:paper-book-paper paper-book))
52 'paper-book paper-book)
55 (page-set-property! p 'head-stencil (page-header p))
56 (page-set-property! p 'foot-stencil (page-footer p))
60 (define page-property ly:prob-property)
61 (define page-set-property! ly:prob-set-property!)
62 (define (page-property? page sym)
63 (eq? #t (page-property page sym)))
64 (define (page? x) (ly:prob-type? x 'page))
72 (string->symbol (format #f "page-~a" j))
74 (page-property pg j))))
76 '(page-number prev lines force penalty lines))
78 (define (page-system-numbers page)
79 (map (lambda (ps) (ly:prob-property ps 'number))
82 (define (page-translate-systems page)
86 (if (not (number? (ly:prob-property sys 'Y-offset)))
87 (ly:prob-set-property! sys 'Y-offset off)))
89 (page-property page 'lines)
90 (page-property page 'configuration)))
92 (define (annotate-top-space first-system layout header-stencil stencil)
93 (let* ((top-margin (ly:output-def-lookup layout 'top-margin))
94 (sym (if (paper-system-title? first-system)
97 (spacing-spec (ly:output-def-lookup layout sym))
98 (X-offset (ly:prob-property first-system 'X-offset 5))
99 (header-extent (ly:stencil-extent header-stencil Y)))
102 (ly:stencil-add stencil
103 (ly:stencil-translate-axis
104 (annotate-spacing-spec layout
114 (define (annotate-page layout stencil)
115 (let ((top-margin (ly:output-def-lookup layout 'top-margin))
116 (paper-height (ly:output-def-lookup layout 'paper-height))
117 (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
118 (add-stencil (lambda (y)
120 (ly:stencil-add stencil
121 (ly:stencil-translate-axis y 6 X))))))
123 (ly:stencil-translate-axis
124 (annotate-y-interval layout "paper-height"
125 (cons (- paper-height) 0)
129 (ly:stencil-translate-axis
130 (annotate-y-interval layout "top-margin"
131 (cons (- top-margin) 0)
135 (ly:stencil-translate-axis
136 (annotate-y-interval layout "bottom-margin"
137 (cons (- paper-height) (- bottom-margin paper-height))
142 (define (annotate-space-left page)
144 ((paper-book (page-property page 'paper-book))
145 (layout (ly:paper-book-paper paper-book))
146 (arrow (annotate-y-interval layout
149 (page-property page 'bottom-edge)
150 (let ((foot (page-property page 'foot-stencil)))
151 (if (and (ly:stencil? foot)
152 (not (ly:stencil-empty? foot)))
153 (car (ly:stencil-extent foot Y))
155 (page-property page 'bottom-system-edge))
158 (set! arrow (ly:stencil-translate-axis arrow 8 X))
163 (define (page-header-or-footer page dir)
165 ((paper-book (page-property page 'paper-book))
166 (layout (ly:paper-book-paper paper-book))
167 (scopes (ly:paper-book-scopes paper-book))
168 (number (page-page-number page))
169 (is-last-bookpart (page-property page 'is-last-bookpart))
170 (is-bookpart-last-page (page-property page 'is-bookpart-last-page))
174 (header-proc (ly:output-def-lookup layout sym)))
176 (if (procedure? header-proc)
177 (header-proc layout scopes number is-last-bookpart is-bookpart-last-page)
181 (define (page-header page)
182 (page-header-or-footer page UP))
184 (define (page-footer page)
185 (page-header-or-footer page DOWN))
187 (define (layout->page-init layout)
188 "Alist of settings for page layout"
190 ((paper-height (ly:output-def-lookup layout 'paper-height))
191 (paper-width (ly:output-def-lookup layout 'paper-width))
192 (left-margin (ly:output-def-lookup layout 'left-margin))
193 (right-margin (ly:output-def-lookup layout 'right-margin))
194 (bottom-edge (- paper-height
195 (ly:output-def-lookup layout 'bottom-margin)) )
196 (top-margin (ly:output-def-lookup layout 'top-margin))
199 `((paper-height . ,paper-height)
200 (paper-width . ,paper-width)
201 (left-margin . ,left-margin)
202 (right-margin . ,right-margin)
203 (top-margin . ,top-margin)
204 (bottom-edge . ,bottom-edge)
207 (define (make-page-stencil page)
208 "Construct a stencil representing the page from PAGE."
211 (page-translate-systems page)
213 ((paper-book (page-property page 'paper-book))
214 (prop (lambda (sym) (page-property page sym)))
215 (layout (ly:paper-book-paper paper-book))
216 (scopes (ly:paper-book-scopes paper-book))
217 (lines (page-lines page))
218 (number (page-page-number page))
220 ;; TODO: naming paper-height/paper-width not analogous to TeX.
222 (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
223 (system-separator-markup (ly:output-def-lookup layout 'system-separator-markup))
224 (system-separator-stencil (if (markup? system-separator-markup)
225 (interpret-markup layout
226 (layout-extract-page-properties layout)
227 system-separator-markup)
230 (page-stencil empty-stencil)
234 (add-to-page (lambda (stencil x y)
236 (ly:stencil-add page-stencil
237 (ly:stencil-translate stencil
240 (- 0 y (prop 'top-margin)))
245 (let* ((stencil (paper-system-stencil system))
246 (extra-offset (ly:prob-property system 'extra-offset '(0 . 0)))
247 (x (+ (ly:prob-property system 'X-offset 0.0)
249 (y (+ (ly:prob-property system 'Y-offset 0.0)
251 (is-title (paper-system-title?
253 (add-to-page stencil x y)
254 (if (and (ly:stencil? system-separator-stencil)
256 (not (paper-system-title? system))
257 (not (paper-system-title? last-system)))
259 system-separator-stencil
262 (car (paper-system-staff-extents last-system)))
264 (cdr (paper-system-staff-extents system))))))
265 (set! last-system system)
267 (head (prop 'head-stencil))
268 (foot (prop 'foot-stencil))
273 (not (ly:stencil-empty? head)))
275 ;; Ensure that the top of the header just touches the top margin.
276 (set! head (ly:stencil-translate-axis head
277 (- 0 (cdr (ly:stencil-extent head Y)) (prop 'top-margin)) Y))
278 (set! page-stencil (ly:stencil-add page-stencil head))))
285 (set! page-stencil (annotate-top-space (car lines) layout head page-stencil))
287 (for-each (lambda (sys next-sys)
288 (paper-system-annotate sys next-sys layout))
290 (append (cdr lines) (list #f)))
291 (paper-system-annotate-last (car (last-pair lines)) layout)))
293 (for-each add-system lines)
296 (ly:prob-set-property! page 'bottom-system-edge
297 (car (ly:stencil-extent page-stencil Y)))
298 (ly:prob-set-property! page 'space-left
299 (+ (prop 'bottom-edge)
300 (prop 'bottom-system-edge)
301 (if (and (ly:stencil? foot)
302 (not (ly:stencil-empty? foot)))
303 (car (ly:stencil-extent foot Y))
306 (if (annotate? layout)
308 (ly:stencil-add page-stencil
309 (annotate-space-left page))))
311 (if (and (ly:stencil? foot)
312 (not (ly:stencil-empty? foot)))
316 (ly:stencil-translate
319 (+ (- (prop 'bottom-edge))
320 (- (car (ly:stencil-extent foot Y)))))))))
322 (if (ly:output-def-lookup layout 'two-sided #f)
324 (ly:stencil-translate page-stencil
325 (cons (prop (if (even? number)
330 (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0))))
333 (if (annotate? layout)
334 (set! page-stencil (annotate-page layout page-stencil)))
339 (define-public (page-stencil page)
340 (if (not (ly:stencil? (page-property page 'stencil)))
342 ;; todo: make tweakable.
343 ;; via property + callbacks.
345 (page-set-property! page 'stencil (make-page-stencil page)))
346 (page-property page 'stencil))
348 (define (calc-printable-height page)
349 "Printable area for music and titles; matches default-page-make-stencil."
351 ((paper-book (page-property page 'paper-book))
352 (layout (ly:paper-book-paper paper-book))
353 (h (- (ly:output-def-lookup layout 'paper-height)
354 (ly:output-def-lookup layout 'top-margin)
355 (ly:output-def-lookup layout 'bottom-margin)))
357 (head (page-property page 'head-stencil))
358 (foot (page-property page 'foot-stencil))
360 (- h (if (ly:stencil? head)
361 (interval-length (ly:stencil-extent head Y))
363 (if (ly:stencil? foot)
364 (interval-length (ly:stencil-extent foot Y))
367 ;; (display (list "\n available" available head foot))
370 (define (page-printable-height page)
371 (if (not (number? (page-property page 'printable-height)))
372 (page-set-property! page 'printable-height (calc-printable-height page)))
374 (page-property page 'printable-height))