1 ;;;; page-layout.scm -- page breaking and page layout
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
8 (use-modules (oop goops describe)
15 (define (write-page-breaks pages)
18 (define tweaks (make-hash-table 23))
20 (define (record what property-pairs)
22 ((key (ly:output-def-lookup (ly:grob-layout what)
26 (when (ly:grob-property what 'when))
29 (if (not (hash-ref tweaks key))
30 (hash-set! tweaks key '()))
33 (acons when property-pairs
34 (hash-ref tweaks key)))
38 (define (graceless-moment mom)
40 (ly:moment-main-numerator mom)
41 (ly:moment-main-denominator mom)
44 (define (moment->skip mom)
46 ((main (if (> (ly:moment-main-numerator mom) 0)
47 (format "\\skip 1*~a/~a"
48 (ly:moment-main-numerator mom)
49 (ly:moment-main-denominator mom))
51 (grace (if (< (ly:moment-grace-numerator mom) 0)
52 (format "\\grace { \\skip 1*~a/~a }"
53 (- (ly:moment-grace-numerator mom))
54 (ly:moment-grace-denominator mom))
57 (format "~a~a" main grace)))
59 (define (dump-tweaks out-port tweak-list last-moment)
60 (if (not (null? tweak-list))
62 ((now (caar tweak-list))
63 (diff (ly:moment-sub now last-moment))
64 (these-tweaks (cdar tweak-list))
65 (skip (moment->skip diff))
66 (line-break-str (if (assoc-get 'line-break these-tweaks #f)
69 (page-break-str (if (assoc-get 'page-break these-tweaks #f)
72 (space-tweaks (format "\\spacingTweaks #'~a\n"
73 (with-output-to-string
77 (assoc-get 'spacing-parameters these-tweaks '()))))
79 (base (format "~a~a~a"
85 (format out-port "~a\n~a\n" skip base)
86 (dump-tweaks out-port (cdr tweak-list) (graceless-moment now))
89 (define (dump-all-tweaks)
91 ((paper (ly:paper-book-paper (page-property (car pages) 'paper-book)))
92 (parser (ly:output-def-parser paper))
93 (name (format "~a-page-layout.ly"
94 (ly:parser-output-name parser)))
95 (out-port (open-output-file name)))
97 (ly:progress "Writing page layout to ~a" name)
100 (format out-port "~a = {" key)
101 (dump-tweaks out-port (reverse val) (ly:make-moment 0 1))
102 (display "}" out-port))
104 (close-port out-port)
107 (define (handle-page page)
109 (define (handle-system sys)
111 ((props `((line-break . #t)
113 . ((system-Y-extent . ,(paper-system-extent sys Y))
114 (system-refpoint-Y-extent . ,(paper-system-staff-extents sys))
115 (system-index . ,index)
116 (page-system-count . ,(length (page-lines page)))
117 (page-printable-height . ,(page-printable-height page))
118 (page-space-left . ,(page-property page 'space-left))))
121 (if (equal? (car (page-lines page)) sys)
122 (set! props (cons '(page-break . #t)
124 (if (not (ly:prob-property? sys 'is-title))
125 (record (ly:spanner-bound (ly:prob-property sys 'system-grob) LEFT)
128 (set! index (1+ index))
130 (for-each handle-system (page-lines page)))
132 (for-each handle-page pages)
135 (define (post-process-pages layout pages)
136 (if (ly:output-def-lookup layout 'write-page-layout #f)
137 (write-page-breaks pages)))
139 ;; Optimal distribution of
140 ;; lines over pages; line breaks are a given.
145 ;; - separate function for word-wrap style breaking?
146 ;; - ragged-bottom? ragged-last-bottom?
148 (define-public (optimal-page-breaks lines paper-book)
149 "Return pages as a list starting with 1st page. Each page is a 'page Prob."
151 (define MAXPENALTY 1e9)
152 (define paper (ly:paper-book-paper paper-book))
155 (define page-alist (layout->page-init (ly:paper-book-paper paper-book)))
156 (define scopes (ly:paper-book-scopes paper-book))
157 (define force-equalization-factor #f)
158 (define (get-path node done)
160 "Follow NODE.PREV, and return as an ascending list of pages. DONE
161 is what have collected so far, and has ascending page numbers."
164 (get-path (page-prev node) (cons node done))
167 (define (combine-penalties force user best-paths)
168 (let* ((prev-force (if (null? best-paths)
170 (page-force (car best-paths))))
171 (prev-penalty (if (null? best-paths)
173 (page-penalty (car best-paths))))
174 (inter-system-space (ly:output-def-lookup paper 'between-system-space))
175 (relative-force (/ force inter-system-space))
176 (abs-relative-force (abs relative-force)))
178 (+ (* abs-relative-force (+ abs-relative-force 1))
180 (* force-equalization-factor (/ (abs (- prev-force force))
184 (define (space-systems page-height lines ragged?)
185 (let* ((global-inter-system-space
186 (ly:output-def-lookup paper 'between-system-space))
188 (ly:output-def-lookup paper 'page-top-space))
189 (global-fixed-dist (ly:output-def-lookup paper 'between-system-padding))
191 (system-vector (list->vector
193 (if (= (length lines) 1)
198 (append (map paper-system-staff-extents lines)
199 (if (= (length lines) 1)
207 (lambda (sys) (paper-system-extent sys Y)) lines)
208 (if (= (length lines) 1)
212 (system-count (vector-length real-extents))
216 (interval-end (vector-ref staff-extents 0)))
217 (interval-end (vector-ref real-extents 0))
219 (last-system (vector-ref system-vector (1- system-count)))
220 (bottom-space (if (ly:prob? last-system)
221 (ly:prob-property last-system 'bottom-space 0.0)
223 (space-left (- page-height
225 (apply + (map interval-length
226 (vector->list real-extents)))))
228 (space (- page-height
232 (vector-ref real-extents (1- system-count))))))
237 (upper-system (vector-ref system-vector idx))
238 (between-space (ly:prob-property upper-system 'next-space
239 global-inter-system-space))
240 (fixed-dist (ly:prob-property upper-system 'next-padding
243 (this-system-ext (vector-ref staff-extents idx))
244 (next-system-ext (vector-ref staff-extents (1+ idx)))
245 (fixed (max 0 (- (+ (interval-end next-system-ext)
247 (interval-start this-system-ext))))
248 (title1? (and (vector-ref system-vector idx)
249 (paper-system-title? (vector-ref system-vector idx)
252 (vector-ref system-vector (1+ idx))
253 (paper-system-title? (vector-ref system-vector (1+ idx)))))
256 ((and title2? title1?)
257 (ly:output-def-lookup paper 'between-title-space))
259 (ly:output-def-lookup paper 'after-title-space))
261 (ly:output-def-lookup paper 'before-title-space))
262 (else between-space))
264 (hooke (/ 1 (- ideal fixed))))
265 (list ideal hooke))))
267 (springs (map calc-spring (iota (1- system-count))))
271 (upper-system (vector-ref system-vector idx))
272 (fixed-dist (ly:prob-property upper-system 'next-padding
274 (this-system-ext (vector-ref real-extents idx))
275 (next-system-ext (vector-ref real-extents (1+ idx)))
277 (distance (max (- (+ (interval-end next-system-ext)
279 (interval-start this-system-ext)
281 (entry (list idx (1+ idx) distance)))
283 (rods (map calc-rod (iota (1- system-count))))
285 ;; we don't set ragged based on amount space left.
286 ;; ragged-bottomlast = ##T is much more predictable
287 (result (ly:solve-spring-rod-problem
299 (display (list "\n# systems: " system-count
300 "\nreal-ext" real-extents "\nstaff-ext" staff-extents
301 "\ninterscore" global-inter-system-space
302 "\nspace-left" space-left
303 "\nspring,rod" springs rods
306 "\npage-height" page-height
310 "\npositions" positions "\n"))))
312 (cons force positions)))
314 (define (walk-paths done-lines best-paths current-lines last? current-best)
315 "Return the best optimal-page-break-node that contains
316 CURRENT-LINES. DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
317 ascending range of lines, and BEST-PATHS contains the optimal breaks
318 corresponding to DONE-LINES.
320 CURRENT-BEST is the best result sofar, or #f."
322 (let* ((this-page-num (if (null? best-paths)
323 (ly:output-def-lookup paper 'first-page-number)
324 (1+ (page-page-number (car best-paths)))))
326 (this-page (make-page
328 'paper-book paper-book
330 'page-number this-page-num))
332 (ragged-all? (eq? #t (ly:output-def-lookup paper 'ragged-bottom)))
333 (ragged-last? (eq? #t (ly:output-def-lookup paper 'ragged-last-bottom)))
334 (ragged? (or ragged-all?
337 (height (page-printable-height this-page))
338 (vertical-spacing (space-systems height current-lines ragged?))
339 (satisfied-constraints (car vertical-spacing))
340 (force (if satisfied-constraints
341 (if (and last? ragged-last?)
343 satisfied-constraints)
345 (positions (cdr vertical-spacing))
346 (get-break-penalty (lambda (sys)
347 (ly:prob-property sys 'penalty 0.0)))
348 (user-nobreak-penalties
350 (apply + (filter negative?
351 (map get-break-penalty
352 (cdr current-lines))))))
355 (max (get-break-penalty (car current-lines)) 0.0)
356 user-nobreak-penalties))
358 (total-penalty (combine-penalties
365 satisfied-constraints
366 (< total-penalty (page-penalty current-best)))))
367 (new-best (if is-better
371 (page-set-property! this-page
375 (cons 'prev (if (null? best-paths)
378 (cons 'lines current-lines)
380 (cons 'configuration positions)
381 (cons 'penalty total-penalty)))
385 ;; (display total-penalty) (newline)
389 "\nuser pen " user-penalty
390 "\nsatisfied-constraints" satisfied-constraints
391 "\nlast? " last? "ragged?" ragged?
392 "\nis-better " is-better " total-penalty " total-penalty "\n"
393 "\nconfig " positions
395 "\nlines: " current-lines "\n")))
398 (display (list "\nnew-best is " (page-lines new-best)
400 (if (null? best-paths)
402 (page-lines (car best-paths))))))
404 (if (and (pair? done-lines)
405 ;; if this page is too full, adding another line won't help
406 satisfied-constraints)
407 (walk-paths (cdr done-lines) (cdr best-paths)
408 (cons (car done-lines) current-lines)
412 (define (walk-lines done best-paths todo)
413 "Return the best page breaking as a single
414 page node for optimally breaking TODO ++
415 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
420 (let* ((this-line (car todo))
421 (last? (null? (cdr todo)))
422 (next (walk-paths done best-paths (list this-line) last? #f)))
424 ;; (display "\n***************")
425 (walk-lines (cons this-line done)
426 (cons next best-paths)
429 (define (line-number node)
430 (ly:prob-property (car (page-lines node)) 'number))
432 (ly:message (_ "Calculating page breaks..."))
433 (set! force-equalization-factor
434 (ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
436 (let* ((best-break-node (walk-lines '() '() lines))
437 (break-nodes (get-path best-break-node '())))
439 (page-set-property! (car (last-pair break-nodes)) 'is-last #t)
440 (if #f; (ly:get-option 'verbose)
443 "\nbreaks: " (map line-number break-nodes))
444 "\nsystems " (map page-lines break-nodes)
445 "\npenalties " (map page-penalty break-nodes)
446 "\nconfigs " (map page-configuration break-nodes))))
448 ;; construct page stencils.
449 (for-each page-stencil break-nodes)
450 (post-process-pages paper break-nodes)