1 ;;;; page-layout.scm -- page breaking and page layout
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
8 (use-modules (oop goops describe)
12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 (define-class <optimally-broken-page-node> ()
15 (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
16 (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno)
17 (force #:init-value 0 #:accessor node-force #:init-keyword #:force)
18 (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
19 (configuration #:init-value '() #:accessor node-configuration #:init-keyword #:configuration)
20 (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
22 (define-method (display (node <optimally-broken-page-node>) port)
23 (map (lambda (x) (display x port))
25 "Page " (node-page-number node)
26 " Lines: " (node-lines node)
27 " Penalty " (node-penalty node)
30 (define-method (node-system-numbers (node <optimally-broken-page-node>))
31 (map (lambda (ps) (ly:paper-system-property ps 'number))
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 (define-public (paper-system-staff-extents ps)
37 (ly:paper-system-property ps 'refpoint-Y-extent '(0 . 0)))
41 (define (paper-system-annotate system layout)
42 "Add arrows and texts to indicate which lengths are set."
44 ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
47 (font-family . typewriter)
49 (layout-extract-page-properties layout)))
52 (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
55 (lambda (name extent is-length?)
57 ;; do something sensible for 0,0 intervals.
58 (set! extent (interval-widen extent 0.001))
60 ((annotation (interpret-markup
64 (make-whiteout-markup (make-simple-markup name))
68 (format "~$" (interval-length extent))
69 (format "(~$,~$)" (car extent) (cdr extent)))))))))
73 (ly:stencil-translate-axis
74 (dimension-arrows (cons 0 (interval-length extent)))
75 (interval-start extent) Y))
79 (ly:stencil-aligned-to annotation Y CENTER))
81 (ly:stencil-translate annotation (cons 0 (interval-center extent))))
85 (append-stencil annotations
86 (append-stencil arrows annotation))))))
89 (bbox-extent (paper-system-extent system Y))
90 (refp-extent (ly:paper-system-property system 'refpoint-Y-extent))
91 (next-space (ly:paper-system-property system 'next-space
92 (ly:output-def-lookup layout 'betweensystemspace)
94 (next-padding (ly:paper-system-property system 'next-padding
95 (ly:output-def-lookup layout 'betweensystempadding)
100 (if (number-pair? bbox-extent)
101 (annotate-property "Y-extent"
104 ;; titles don't have a refpoint-Y-extent.
105 (if (number-pair? refp-extent)
107 (annotate-property "refpoint-Y-extent"
110 (annotate-property "next-space"
111 (interval-translate (cons (- next-space) 0) (car refp-extent))
115 (annotate-property "next-padding"
116 (interval-translate (cons (- next-padding) 0) (car bbox-extent))
120 (set! (ly:paper-system-property system 'stencil)
122 (ly:paper-system-property system 'stencil)
124 (ly:stencil-expr annotations)
125 (ly:stencil-extent empty-stencil X)
126 (ly:stencil-extent empty-stencil Y)
133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
135 (define (page-headfoot layout scopes number sym sepsym dir last?)
136 "Create a stencil including separating space."
137 (let* ((header-proc (ly:output-def-lookup layout sym))
138 (sep (ly:output-def-lookup layout sepsym))
139 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
141 (if (procedure? header-proc)
142 (header-proc layout scopes number last?)
145 (if (and (number? sep)
146 (ly:stencil? head-stencil)
147 (not (ly:stencil-empty? head-stencil)))
149 (ly:stencil-combine-at-edge
150 stencil Y dir head-stencil
155 (define-public (default-page-music-height layout scopes number last?)
156 "Printable area for music and titles; matches default-page-make-stencil."
157 (let* ((h (- (ly:output-def-lookup layout 'vsize)
158 (ly:output-def-lookup layout 'topmargin)
159 (ly:output-def-lookup layout 'bottommargin)))
160 (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
161 (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
163 (- h (if (ly:stencil? head)
164 (interval-length (ly:stencil-extent head Y))
166 (if (ly:stencil? foot)
167 (interval-length (ly:stencil-extent foot Y))
170 ;; (display (list "\n available" available head foot))
173 (define-public (default-page-make-stencil
174 lines offsets layout scopes number last?)
175 "Construct a stencil representing the page from LINES.
177 Offsets is a list of increasing numbers. They must be negated to
181 (if (eq? #t (ly:output-def-lookup layout 'annotatespacing))
182 (for-each (lambda (sys) (paper-system-annotate sys layout))
184 (let* ((topmargin (ly:output-def-lookup layout 'topmargin))
186 ;; TODO: naming vsize/hsize not analogous to TeX.
188 (vsize (ly:output-def-lookup layout 'vsize))
189 (hsize (ly:output-def-lookup layout 'hsize))
191 (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
192 (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
193 (system-separator-stencil (if (markup? system-separator-markup)
194 (interpret-markup layout
195 (layout-extract-page-properties layout)
196 system-separator-markup)
198 (lmargin (ly:output-def-lookup layout 'leftmargin))
199 (leftmargin (if lmargin
202 (ly:output-def-lookup layout 'linewidth)) 2)))
204 (rightmargin (ly:output-def-lookup layout 'rightmargin))
205 (bottom-edge (- vsize
206 (ly:output-def-lookup layout 'bottommargin)))
208 (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
209 (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
211 (head-height (if (ly:stencil? head)
212 (interval-length (ly:stencil-extent head Y))
215 (height-proc (ly:output-def-lookup layout 'page-music-height))
217 (page-stencil (ly:make-stencil '()
218 (cons leftmargin hsize)
219 (cons (- topmargin) 0)))
222 (add-to-page (lambda (stencil y)
224 (ly:stencil-add page-stencil
225 (ly:stencil-translate stencil
228 (- 0 head-height y topmargin))
232 (lambda (stencil-position)
233 (let* ((system (car stencil-position))
234 (stencil (paper-system-stencil system))
235 (y (cadr stencil-position))
236 (is-title (paper-system-title?
237 (car stencil-position))))
238 (add-to-page stencil y)
239 (if (and (ly:stencil? system-separator-stencil)
241 (not (paper-system-title? system))
242 (not (paper-system-title? last-system)))
244 system-separator-stencil
246 (car (paper-system-staff-extents last-system)))
248 (cdr (paper-system-staff-extents system))))))
249 (set! last-system system)
254 "leftmargin " leftmargin "rightmargin " rightmargin
257 (set! page-stencil (ly:stencil-combine-at-edge
261 (not (ly:stencil-empty? head)))
263 (ly:make-stencil "" (cons 0 0) (cons 0 0)))
266 (map add-system (zip lines offsets))
267 (if (and (ly:stencil? foot)
268 (not (ly:stencil-empty? foot)))
272 (ly:stencil-translate
276 (- (car (ly:stencil-extent foot Y)))))))))
278 (ly:stencil-translate page-stencil (cons leftmargin 0))))
280 ;;; optimal page breaking
282 ;;; This is not optimal page breaking, this is optimal distribution of
283 ;;; lines over pages; line breaks are a given.
288 ;; - separate function for word-wrap style breaking?
289 ;; - raggedbottom? raggedlastbottom?
291 (define-public (optimal-page-breaks lines paper-book)
292 "Return pages as a list starting with 1st page. Each page is a list
295 (define MAXPENALTY 1e9)
296 (define paper (ly:paper-book-paper paper-book))
297 (define scopes (ly:paper-book-scopes paper-book))
298 (define force-equalization-factor #f)
300 (define (page-height page-number last?)
301 (let ((p (ly:output-def-lookup paper 'page-music-height)))
304 (p paper scopes page-number last?)
307 (define (get-path node done)
308 "Follow NODE.PREV, and return as an ascending list of pages. DONE
309 is what have collected so far, and has ascending page numbers."
311 (if (is-a? node <optimally-broken-page-node>)
312 (get-path (node-prev node) (cons node done))
315 (define (combine-penalties force user best-paths)
316 (let* ((prev-force (if (null? best-paths)
318 (node-force (car best-paths))))
319 (prev-penalty (if (null? best-paths)
321 (node-penalty (car best-paths))))
322 (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
323 (relative-force (/ force inter-system-space))
324 (abs-relative-force (abs relative-force)))
327 (+ (* abs-relative-force (+ abs-relative-force 1))
329 (* force-equalization-factor (/ (abs (- prev-force force))
333 (define (space-systems page-height lines ragged?)
334 (let* ((global-inter-system-space
335 (ly:output-def-lookup paper 'betweensystemspace))
337 (ly:output-def-lookup paper 'pagetopspace))
338 (global-fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
340 (system-vector (list->vector
342 (if (= (length lines) 1)
347 (append (map paper-system-staff-extents lines)
348 (if (= (length lines) 1)
356 (lambda (sys) (paper-system-extent sys Y)) lines)
357 (if (= (length lines) 1)
361 (system-count (vector-length real-extents))
365 (interval-end (vector-ref staff-extents 0)))
366 (interval-end (vector-ref real-extents 0))
368 (last-system (vector-ref system-vector (1- system-count)))
369 (bottom-space (if (ly:paper-system? last-system)
370 (ly:paper-system-property last-system 'bottom-space 0.0)
372 (space-left (- page-height
374 (apply + (map interval-length
375 (vector->list real-extents)))))
377 (space (- page-height
381 (vector-ref real-extents (1- system-count))))))
386 (upper-system (vector-ref system-vector idx))
387 (between-space (ly:paper-system-property upper-system 'next-space
388 global-inter-system-space))
389 (fixed-dist (ly:paper-system-property upper-system 'next-padding
392 (this-system-ext (vector-ref staff-extents idx))
393 (next-system-ext (vector-ref staff-extents (1+ idx)))
394 (fixed (max 0 (- (+ (interval-end next-system-ext)
396 (interval-start this-system-ext))))
397 (title1? (and (vector-ref system-vector idx)
398 (paper-system-title? (vector-ref system-vector idx)
401 (vector-ref system-vector (1+ idx))
402 (paper-system-title? (vector-ref system-vector (1+ idx)))))
405 ((and title2? title1?)
406 (ly:output-def-lookup paper 'betweentitlespace))
408 (ly:output-def-lookup paper 'aftertitlespace))
410 (ly:output-def-lookup paper 'beforetitlespace))
411 (else between-space))
413 (hooke (/ 1 (- ideal fixed))))
414 (list ideal hooke))))
416 (springs (map calc-spring (iota (1- system-count))))
420 (upper-system (vector-ref system-vector idx))
421 (fixed-dist (ly:paper-system-property upper-system 'next-padding
423 (this-system-ext (vector-ref real-extents idx))
424 (next-system-ext (vector-ref real-extents (1+ idx)))
426 (distance (max (- (+ (interval-end next-system-ext)
428 (interval-start this-system-ext)
430 (entry (list idx (1+ idx) distance)))
432 (rods (map calc-rod (iota (1- system-count))))
434 ;; we don't set ragged based on amount space left.
435 ;; raggedbottomlast = ##T is much more predictable
436 (result (ly:solve-spring-rod-problem
448 (display (list "\n# systems: " system-count
449 "\nreal-ext" real-extents "\nstaff-ext" staff-extents
450 "\ninterscore" global-inter-system-space
451 "\nspace-left" space-left
452 "\nspring,rod" springs rods
455 "\npage-height" page-height
459 "\npositions" positions "\n"))))
461 (cons force positions)))
463 (define (walk-paths done-lines best-paths current-lines last? current-best)
464 "Return the best optimal-page-break-node that contains
465 CURRENT-LINES. DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
466 ascending range of lines, and BEST-PATHS contains the optimal breaks
467 corresponding to DONE-LINES.
469 CURRENT-BEST is the best result sofar, or #f."
472 (let* ((this-page-num (if (null? best-paths)
473 (ly:output-def-lookup paper 'firstpagenumber)
474 (1+ (node-page-number (car best-paths)))))
476 (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom)))
477 (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom)))
478 (ragged? (or ragged-all?
481 (page-height (page-height this-page-num last?))
482 (vertical-spacing (space-systems page-height current-lines ragged?))
483 (satisfied-constraints (car vertical-spacing))
484 (force (if satisfied-constraints
485 (if (and last? ragged-last?)
487 satisfied-constraints)
489 (positions (cdr vertical-spacing))
490 (get-break-penalty (lambda (sys)
491 (ly:paper-system-property sys 'penalty 0.0)))
492 (user-nobreak-penalties
494 (apply + (filter negative?
495 (map get-break-penalty
496 (cdr current-lines))))))
499 (max (get-break-penalty (car current-lines)) 0.0)
500 user-nobreak-penalties))
502 (total-penalty (combine-penalties
508 (< total-penalty (node-penalty current-best))))
509 (new-best (if better?
510 (make <optimally-broken-page-node>
511 #:prev (if (null? best-paths)
514 #:lines current-lines
515 #:pageno this-page-num
517 #:configuration positions
518 #:penalty total-penalty)
521 ;; (display total-penalty) (newline)
525 "\nuser pen " user-penalty
526 "\nsatisfied-constraints" satisfied-constraints
527 "\nlast? " last? "ragged?" ragged?
528 "\nbetter? " better? " total-penalty " total-penalty "\n"
529 "\nconfig " positions
531 "\nlines: " current-lines "\n")))
534 (display (list "\nnew-best is " (node-lines new-best)
536 (if (null? best-paths)
538 (node-lines (car best-paths))))))
540 (if (and (pair? done-lines)
541 ;; if this page is too full, adding another line won't help
542 satisfied-constraints)
543 (walk-paths (cdr done-lines) (cdr best-paths)
544 (cons (car done-lines) current-lines)
548 (define (walk-lines done best-paths todo)
549 "Return the best page breaking as a single
550 <optimal-page-break-node> for optimally breaking TODO ++
551 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
556 (let* ((this-line (car todo))
557 (last? (null? (cdr todo)))
558 (next (walk-paths done best-paths (list this-line) last? #f)))
560 ;; (display "\n***************")
561 (walk-lines (cons this-line done)
562 (cons next best-paths)
565 (define (line-number node)
566 (ly:paper-system-property (car (node-lines node)) 'number))
568 (ly:message (_ "Calculating page breaks..."))
569 (set! force-equalization-factor
570 (ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
572 (let* ((best-break-node (walk-lines '() '() lines))
573 (break-nodes (get-path best-break-node '()))
574 (last-node (car (last-pair break-nodes))))
576 (define (node->page-stencil node)
577 (if (not (eq? node last-node))
580 ((ly:output-def-lookup paper 'page-make-stencil)
582 (node-configuration node)
585 (node-page-number node)
586 (eq? node best-break-node))))
587 (if (not (eq? node last-node))
589 (ly:progress (number->string
590 (car (last-pair (node-system-numbers node)))))
594 (if #f; (ly:get-option 'verbose)
597 "\nbreaks: " (map line-number break-nodes))
598 "\nsystems " (map node-lines break-nodes)
599 "\npenalties " (map node-penalty break-nodes)
600 "\nconfigs " (map node-configuration break-nodes))))
602 (let ((stencils (map node->page-stencil break-nodes)))