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 music-system-heights
110 (map-in-order (lambda (sys)
111 (* -1 (car (paper-system-extent sys Y))))
112 (remove (lambda (sys)
113 (ly:prob-property? sys 'is-title))
115 (define (handle-system sys)
117 ((props `((line-break . #t)
119 . ((system-Y-extent . ,(paper-system-extent sys Y))
120 (system-refpoint-Y-extent . ,(paper-system-staff-extents sys))
121 (system-index . ,index)
122 (music-system-heights . ,music-system-heights)
123 (page-system-count . ,(length (page-lines page)))
124 (page-printable-height . ,(page-printable-height page))
125 (page-space-left . ,(page-property page 'space-left))))
128 (if (equal? (car (page-lines page)) sys)
129 (set! props (cons '(page-break . #t)
131 (if (not (ly:prob-property? sys 'is-title))
132 (record (ly:spanner-bound (ly:prob-property sys 'system-grob) LEFT)
135 (set! index (1+ index))
137 (for-each handle-system (page-lines page)))
139 (for-each handle-page pages)
142 (define (post-process-pages layout pages)
143 (if (ly:output-def-lookup layout 'write-page-layout #f)
144 (write-page-breaks pages)))
146 ;; Optimal distribution of
147 ;; lines over pages; line breaks are a given.
152 ;; - separate function for word-wrap style breaking?
153 ;; - ragged-bottom? ragged-last-bottom?
155 (define-public (optimal-page-breaks lines paper-book)
156 "Return pages as a list starting with 1st page. Each page is a 'page Prob."
158 (define MAXPENALTY 1e9)
159 (define paper (ly:paper-book-paper paper-book))
162 (define page-alist (layout->page-init (ly:paper-book-paper paper-book)))
163 (define scopes (ly:paper-book-scopes paper-book))
164 (define force-equalization-factor #f)
165 (define (get-path node done)
167 "Follow NODE.PREV, and return as an ascending list of pages. DONE
168 is what have collected so far, and has ascending page numbers."
171 (get-path (page-prev node) (cons node done))
174 (define (combine-penalties force user best-paths)
175 (let* ((prev-force (if (null? best-paths)
177 (page-force (car best-paths))))
178 (prev-penalty (if (null? best-paths)
180 (page-penalty (car best-paths))))
181 (inter-system-space (ly:output-def-lookup paper 'between-system-space))
182 (relative-force (/ force inter-system-space))
183 (abs-relative-force (abs relative-force)))
185 (+ (* abs-relative-force (+ abs-relative-force 1))
187 (* force-equalization-factor (/ (abs (- prev-force force))
191 (define (space-systems page-height lines ragged?)
192 (let* ((global-inter-system-space
193 (ly:output-def-lookup paper 'between-system-space))
195 (ly:output-def-lookup paper 'page-top-space))
196 (global-fixed-dist (ly:output-def-lookup paper 'between-system-padding))
198 (system-vector (list->vector
200 (if (= (length lines) 1)
205 (append (map paper-system-staff-extents lines)
206 (if (= (length lines) 1)
214 (lambda (sys) (paper-system-extent sys Y)) lines)
215 (if (= (length lines) 1)
219 (system-count (vector-length real-extents))
223 (interval-end (vector-ref staff-extents 0)))
224 (interval-end (vector-ref real-extents 0))
226 (last-system (vector-ref system-vector (1- system-count)))
227 (bottom-space (if (ly:prob? last-system)
228 (ly:prob-property last-system 'bottom-space 0.0)
230 (space-left (- page-height
232 (apply + (map interval-length
233 (vector->list real-extents)))))
235 (space (- page-height
239 (vector-ref real-extents (1- system-count))))))
244 (upper-system (vector-ref system-vector idx))
245 (between-space (ly:prob-property upper-system 'next-space
246 global-inter-system-space))
247 (fixed-dist (ly:prob-property upper-system 'next-padding
250 (this-system-ext (vector-ref staff-extents idx))
251 (next-system-ext (vector-ref staff-extents (1+ idx)))
252 (fixed (max 0 (- (+ (interval-end next-system-ext)
254 (interval-start this-system-ext))))
255 (title1? (and (vector-ref system-vector idx)
256 (paper-system-title? (vector-ref system-vector idx)
259 (vector-ref system-vector (1+ idx))
260 (paper-system-title? (vector-ref system-vector (1+ idx)))))
263 ((and title2? title1?)
264 (ly:output-def-lookup paper 'between-title-space))
266 (ly:output-def-lookup paper 'after-title-space))
268 (ly:output-def-lookup paper 'before-title-space))
269 (else between-space))
271 (hooke (/ 1 (- ideal fixed))))
272 (list ideal hooke))))
274 (springs (map calc-spring (iota (1- system-count))))
278 (upper-system (vector-ref system-vector idx))
279 (fixed-dist (ly:prob-property upper-system 'next-padding
281 (this-system-ext (vector-ref real-extents idx))
282 (next-system-ext (vector-ref real-extents (1+ idx)))
284 (distance (max (- (+ (interval-end next-system-ext)
286 (interval-start this-system-ext)
288 (entry (list idx (1+ idx) distance)))
290 (rods (map calc-rod (iota (1- system-count))))
292 ;; we don't set ragged based on amount space left.
293 ;; ragged-bottomlast = ##T is much more predictable
294 (result (ly:solve-spring-rod-problem
306 (display (list "\n# systems: " system-count
307 "\nreal-ext" real-extents "\nstaff-ext" staff-extents
308 "\ninterscore" global-inter-system-space
309 "\nspace-left" space-left
310 "\nspring,rod" springs rods
313 "\npage-height" page-height
317 "\npositions" positions "\n"))))
319 (cons force positions)))
321 (define (walk-paths done-lines best-paths current-lines last? current-best)
322 "Return the best optimal-page-break-node that contains
323 CURRENT-LINES. DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
324 ascending range of lines, and BEST-PATHS contains the optimal breaks
325 corresponding to DONE-LINES.
327 CURRENT-BEST is the best result sofar, or #f."
329 (let* ((this-page-num (if (null? best-paths)
330 (ly:output-def-lookup paper 'first-page-number)
331 (1+ (page-page-number (car best-paths)))))
333 (this-page (make-page
335 'paper-book paper-book
337 'page-number this-page-num))
339 (ragged-all? (eq? #t (ly:output-def-lookup paper 'ragged-bottom)))
340 (ragged-last? (eq? #t (ly:output-def-lookup paper 'ragged-last-bottom)))
341 (ragged? (or ragged-all?
344 (height (page-printable-height this-page))
345 (vertical-spacing (space-systems height current-lines ragged?))
346 (satisfied-constraints (car vertical-spacing))
347 (force (if satisfied-constraints
348 (if (and last? ragged-last?)
350 satisfied-constraints)
352 (positions (cdr vertical-spacing))
353 (get-break-penalty (lambda (sys)
354 (ly:prob-property sys 'penalty 0.0)))
355 (user-nobreak-penalties
357 (apply + (filter negative?
358 (map get-break-penalty
359 (cdr current-lines))))))
362 (max (get-break-penalty (car current-lines)) 0.0)
363 user-nobreak-penalties))
365 (total-penalty (combine-penalties
372 satisfied-constraints
373 (< total-penalty (page-penalty current-best)))))
374 (new-best (if is-better
378 (page-set-property! this-page
382 (cons 'prev (if (null? best-paths)
385 (cons 'lines current-lines)
387 (cons 'configuration positions)
388 (cons 'penalty total-penalty)))
392 ;; (display total-penalty) (newline)
396 "\nuser pen " user-penalty
397 "\nsatisfied-constraints" satisfied-constraints
398 "\nlast? " last? "ragged?" ragged?
399 "\nis-better " is-better " total-penalty " total-penalty "\n"
400 "\nconfig " positions
402 "\nlines: " current-lines "\n")))
405 (display (list "\nnew-best is " (page-lines new-best)
407 (if (null? best-paths)
409 (page-lines (car best-paths))))))
411 (if (and (pair? done-lines)
412 ;; if this page is too full, adding another line won't help
413 satisfied-constraints)
414 (walk-paths (cdr done-lines) (cdr best-paths)
415 (cons (car done-lines) current-lines)
419 (define (walk-lines done best-paths todo)
420 "Return the best page breaking as a single
421 page node for optimally breaking TODO ++
422 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
427 (let* ((this-line (car todo))
428 (last? (null? (cdr todo)))
429 (next (walk-paths done best-paths (list this-line) last? #f)))
431 ;; (display "\n***************")
432 (walk-lines (cons this-line done)
433 (cons next best-paths)
436 (define (line-number node)
437 (ly:prob-property (car (page-lines node)) 'number))
439 (ly:message (_ "Calculating page breaks..."))
440 (set! force-equalization-factor
441 (ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
443 (let* ((best-break-node (walk-lines '() '() lines))
444 (break-nodes (get-path best-break-node '())))
446 (page-set-property! (car (last-pair break-nodes)) 'is-last #t)
447 (if #f; (ly:get-option 'verbose)
450 "\nbreaks: " (map line-number break-nodes))
451 "\nsystems " (map page-lines break-nodes)
452 "\npenalties " (map page-penalty break-nodes)
453 "\nconfigs " (map page-configuration break-nodes))))
455 ;; construct page stencils.
456 (for-each page-stencil break-nodes)
457 (post-process-pages paper break-nodes)