Fix some bugs in the dynamic engraver and PostScript backend

[lilypond.git] / scm / layout-page-layout.scm

diff --git a/scm/layout-page-layout.scm b/scm/layout-page-layout.scm
index e370a171323254050179f6e777eea2bece37b859..8a7628af857519d7c1dc0ec0bb8c718db029ab27 100644 (file)
--- a/scm/layout-page-layout.scm
+++ b/scm/layout-page-layout.scm
@@ -1,219 +1,148 @@
-;;;; layout-page-layout.scm -- page breaking and page layout
+;;;; page-layout.scm -- page breaking and page layout

 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;;
 ;;;; (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;;
 ;;;; (c) 2004--2006 Jan Nieuwenhuizen <janneke@gnu.org>

-;;;;         Han-Wen Nienhuys <hanwen@xs4all.nl>
-
-(define-module (scm layout-page-layout)
-  #:use-module (srfi srfi-1)
-  #:use-module (oop goops describe)
-  #:use-module (oop goops)
-  #:use-module (scm paper-system)
-  #:use-module (scm page)
-  #:use-module (scm layout-page-dump)
-  #:use-module (lily)
-  #:export (post-process-pages optimal-page-breaks make-page-from-systems
-           page-breaking-wrapper
-           ;; utilities for writing custom page breaking functions
-            line-height line-next-space line-next-padding
-           line-minimum-distance line-ideal-distance
-           first-line-position
-           line-ideal-relative-position line-minimum-relative-position
-            line-minimum-position-on-page stretchable-line?
-           page-maximum-space-to-fill page-maximum-space-left space-systems))
-
-(define (page-breaking-wrapper paper-book)
-  "Compute line and page breaks by calling the page-breaking paper variable,
-  then performs the post process function using the page-post-process paper
-  variable. Finally, return the pages."
-  (let* ((paper (ly:paper-book-paper paper-book))
-         (pages ((ly:output-def-lookup paper 'page-breaking) paper-book)))
-    ((ly:output-def-lookup paper 'page-post-process) paper pages)
-    pages))
+;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+(use-modules (oop goops describe)
+            (oop goops)
+            (scm paper-system)
+            (scm page)
+            )
+
+
+(define (write-page-breaks pages) 
+  "Dump page breaks"
+
+  (define tweaks (make-hash-table 23))
+
+  (define (record what property-pairs)
+    (let*
+       ((key (ly:output-def-lookup (ly:grob-layout what)
+                                   'tweak-key
+                                   "tweaks"
+                                   ))
+        (when (ly:grob-property what 'when))
+        )
+
+      (if (not (hash-ref tweaks key))
+         (hash-set! tweaks key '()))
+
+      (hash-set! tweaks key
+                (acons when property-pairs
+                       (hash-ref tweaks key)))
+      
+      ))
+
+  (define (graceless-moment mom)
+    (ly:make-moment
+     (ly:moment-main-numerator mom)
+     (ly:moment-main-denominator mom)
+     0 0))
+
+  (define (moment->skip mom)
+    (let*
+       ((main (if (> (ly:moment-main-numerator mom) 0)
+                  (format "\\skip 1*~a/~a"
+                          (ly:moment-main-numerator mom)
+                          (ly:moment-main-denominator mom))
+                  ""))
+        (grace (if (< (ly:moment-grace-numerator mom) 0)
+                   (format "\\grace { \\skip 1*~a/~a }"
+                           (- (ly:moment-grace-numerator mom))
+                           (ly:moment-grace-denominator mom))
+                   "")))
+
+      (format "~a~a" main grace)))
+    
+  (define (dump-tweaks out-port tweak-list last-moment)
+    (if (not (null? tweak-list))
+       (let*
+           ((now (caar tweak-list))
+            (diff (ly:moment-sub now last-moment))
+            (these-tweaks (cdar tweak-list))
+            (skip (moment->skip diff))
+            (line-break-str (if (assoc-get 'line-break these-tweaks #f)
+                                "\\break\n"
+                                ""))
+            (page-break-str (if (assoc-get 'page-break these-tweaks #f)
+                                "\\pageBreak\n"
+                                ""))
+            (space-tweaks (format "\\spacingTweaks #'~a\n"
+                                  (with-output-to-string
+                                    (lambda ()
+                                      (pretty-print
+                                  
+                                       (assoc-get 'spacing-parameters these-tweaks '()))))
+                                    ))
+            (base (format "~a~a~a"
+                          line-break-str
+                          page-break-str
+                          space-tweaks))
+            )
+
+         (format out-port "~a\n~a\n" skip base)
+         (dump-tweaks out-port (cdr tweak-list) (graceless-moment now))
+       )))
+
+  (define (dump-all-tweaks)
+    (let*
+     ((paper (ly:paper-book-paper (page-property  (car pages) 'paper-book)))
+      (parser (ly:output-def-parser paper))
+      (name  (format "~a-page-layout.ly"
+                    (ly:parser-output-name parser)))
+      (out-port (open-output-file name)))
+      
+     (ly:progress "Writing page layout to ~a" name)
+     (hash-for-each
+      (lambda (key val)
+       (format out-port "~a = {" key)
+       (dump-tweaks out-port (reverse val) (ly:make-moment 0 1))
+        (display "}" out-port))
+       tweaks)
+     (close-port out-port)
+     ))
+
+  (define (handle-page page)
+    (define index 0)
+    (define music-system-heights
+      (map-in-order (lambda (sys)
+                     (* -1 (car (paper-system-extent sys Y))))
+                   (remove (lambda (sys)
+                             (ly:prob-property? sys 'is-title))
+                           (page-lines page))))
+    (define (handle-system sys)
+      (let*
+         ((props `((line-break . #t)
+                   (spacing-parameters
+                    . ((system-Y-extent . ,(paper-system-extent sys Y))
+                       (system-refpoint-Y-extent . ,(paper-system-staff-extents sys))
+                       (system-index . ,index)
+                       (music-system-heights . ,music-system-heights)
+                       (page-system-count . ,(length (page-lines page)))
+                       (page-printable-height . ,(page-printable-height page)) 
+                       (page-space-left . ,(page-property page 'space-left))))
+                   )))
+
+       (if (equal? (car (page-lines page)) sys)
+           (set! props (cons '(page-break . #t)
+                             props)))
+       (if (not (ly:prob-property? sys 'is-title))
+           (record  (ly:spanner-bound (ly:prob-property sys 'system-grob) LEFT)
+                    props))
+
+       (set! index (1+ index))
+       ))
+    (for-each handle-system (page-lines page)))
+
+  (for-each handle-page pages)
+  (dump-all-tweaks))

 
 (define (post-process-pages layout pages)
 
 (define (post-process-pages layout pages)

-  "If the write-page-layout paper variable is true, dumps page breaks
-  and tweaks."

   (if (ly:output-def-lookup layout 'write-page-layout #f)
       (write-page-breaks pages)))
 
   (if (ly:output-def-lookup layout 'write-page-layout #f)
       (write-page-breaks pages)))
 

-;;;
-;;; Utilities for computing line distances and positions
-;;;
-(define (line-height line)
-  "Return the system height, that is the length of its vertical extent."
-  (interval-length (paper-system-extent line Y)))
-
-(define (line-next-space line next-line layout)
-  "Return space to use between `line' and `next-line'.
-  `next-line' can be #f, meaning that `line' is the last line."
-  (let* ((title (paper-system-title? line))
-        (next-title (and next-line (paper-system-title? next-line))))
-    (cond ((and title next-title)
-          (ly:output-def-lookup layout 'between-title-space))
-         (title
-          (ly:output-def-lookup layout 'after-title-space))
-         (next-title
-          (ly:output-def-lookup layout 'before-title-space))
-         (else
-          (ly:prob-property
-           line 'next-space
-           (ly:output-def-lookup layout 'between-system-space))))))
-
-(define (line-next-padding line next-line layout)
-  "Return padding to use between `line' and `next-line'.
-  `next-line' can be #f, meaning that `line' is the last line."
-  (ly:prob-property
-   line 'next-padding
-   (ly:output-def-lookup layout 'between-system-padding)))
-
-
-(define (line-minimum-distance line next-line layout ignore-padding)
-  "Minimum distance between `line' reference position and `next-line'
- reference position. If next-line is #f, return #f."
-  (and next-line
-       (max 0 (- (+ (interval-end (paper-system-extent next-line Y))
-                   (if ignore-padding 0 (line-next-padding line next-line layout)))
-                (interval-start (paper-system-extent line Y))))))
-
-(define (line-ideal-distance line next-line layout ignore-padding)
-  "Ideal distance between `line' reference position and `next-line'
- reference position. If next-line is #f, return #f."
-  (and next-line
-       (+ (max 0 (- (+ (interval-end (paper-system-staff-extents next-line))
-                      (if ignore-padding 0 (line-next-padding line next-line layout)))
-                   (interval-start (paper-system-staff-extents line))))
-         (line-next-space line next-line layout))))
-
-(define (first-line-position line layout)
-  "Position of the first line on page"
-  (max (+ (ly:output-def-lookup layout 'page-top-space)
-         (interval-end (paper-system-staff-extents line)))
-       (interval-end (paper-system-extent line Y))))
-
-(define (line-ideal-relative-position line prev-line layout ignore-padding)
-  "Return ideal position of `line', relative to `prev-line' position.
-  `prev-line' can be #f, meaning that `line' is the first line."
-  (if (not prev-line)
-      ;; first line on page
-      (first-line-position line layout)
-      ;; not the first line on page
-      (max (line-minimum-distance prev-line line layout ignore-padding)
-          (line-ideal-distance prev-line line layout ignore-padding))))
-
-(define (line-minimum-relative-position line prev-line layout ignore-padding)
-  "Return position of `line', relative to `prev-line' position.
-  `prev-line' can be #f, meaning that `line' is the first line."
-  (if (not prev-line)
-      ;; first line on page
-      (first-line-position line layout)
-      ;; not the first line on page
-      (line-minimum-distance prev-line line layout ignore-padding)))
-
-(define (line-minimum-position-on-page line prev-line prev-position page)
-  "If `line' fits on `page' after `prev-line', which position on page is
-  `prev-position', then return the line's postion on page, otherwise #f.
-  `prev-line' can be #f, meaning that `line' is the first line."
-  (let* ((layout (ly:paper-book-paper (page-property page 'paper-book)))
-         (position (+ (line-minimum-relative-position line prev-line layout #f)
-                      (if prev-line prev-position 0.0)))
-         (bottom-position (- position
-                             (interval-start (paper-system-extent line Y)))))
-    (and (or (not prev-line)
-             (< bottom-position (page-printable-height page)))
-         position)))
-
-(define (stretchable-line? line)
-  "Say whether a system can be stretched."
-  (not (or (ly:prob-property? line 'is-title)
-          (let ((system-extent (paper-system-staff-extents line)))
-            (= (interval-start system-extent)
-               (interval-end   system-extent))))))
-
-(define (page-maximum-space-to-fill page lines paper)
-  "Return the space between the first line top position and the last line
-  bottom position. This constitutes the maximum space to fill on `page'
-  with `lines'."
-  (let ((last-line (car (last-pair lines))))
-    (- (page-printable-height page)
-       (first-line-position (first lines) paper)
-       (ly:prob-property last-line
-                        'bottom-space 0.0)
-       (- (interval-start (paper-system-extent last-line Y))))))
-
-(define (page-maximum-space-left page)
-  (let ((paper (ly:paper-book-paper (page-property page 'paper-book))))
-    (let bottom-position ((lines (page-property page 'lines))
-                          (prev-line #f)
-                          (prev-position #f))
-      (if (null? lines)
-          (page-printable-height page)
-          (let* ((line (first lines))
-                 (position (line-minimum-position-on-page
-                            line prev-line prev-position page)))
-            (if (null? (cdr lines))
-                (and position
-                     (- (page-printable-height page)
-                        (- position
-                           (interval-start (paper-system-extent line Y)))))
-                (bottom-position (cdr lines) line position)))))))
-
-;;;
-;;; Utilities for distributing systems on a page
-;;;
-
-(define (space-systems space-to-fill lines ragged paper ignore-padding)
-  "Compute lines positions on page: return force and line positions as a pair.
- force is #f if lines do not fit on page."
-  (let* ((empty-stencil (ly:make-stencil '() '(0 . 0) '(0 . 0)))
-        (empty-prob (ly:make-prob 'paper-system (list `(stencil . ,empty-stencil))))
-        (cdr-lines (append (cdr lines)
-                           (if (<= (length lines) 1)
-                               (list empty-prob)
-                               '())))
-        (springs (map (lambda (prev-line line)
-                        (list (line-ideal-distance prev-line line paper ignore-padding)
-                              (/ 1.0 (line-next-space prev-line line paper))))
-                      lines
-                      cdr-lines))
-        (rods (map (let ((i -1))
-                     (lambda (prev-line line)
-                       (set! i (1+ i))
-                       (list i (1+ i)
-                             (line-minimum-distance prev-line line paper ignore-padding))))
-                      lines
-                      cdr-lines))
-        (space-result
-         (ly:solve-spring-rod-problem springs rods space-to-fill ragged)))
-    (cons (car space-result)
-         (map (let ((topskip (first-line-position (first lines) paper)))
-                (lambda (y)
-                  (+ y topskip)))
-              (cdr space-result)))))
-
-(define (make-page-from-systems paper-book lines page-number ragged last)
-  "Return a new page, filled with `lines'."
-  (let* ((page (make-page paper-book
-                         'lines lines
-                         'page-number page-number
-                         'is-last last))
-        (posns (if (null? lines)
-                   (list)
-                   (let* ((paper (ly:paper-book-paper paper-book))
-                          (space-to-fill (page-maximum-space-to-fill
-                                           page lines paper))
-                          (spacing (space-systems space-to-fill lines ragged paper #f)))
-                     (if (or (not (car spacing)) (inf? (car spacing)))
-                         (cdr (space-systems space-to-fill lines ragged paper #t))
-                         (cdr spacing))))))
-    (page-set-property! page 'configuration posns)
-    page))
-
-;;;
-;;; Page breaking function
-;;;
-

 ;; Optimal distribution of
 ;; lines over pages; line breaks are a given.
 
 ;; Optimal distribution of
 ;; lines over pages; line breaks are a given.
 


@@ -223,147 +152,309 @@
 ;; - separate function for word-wrap style breaking?
 ;; - ragged-bottom? ragged-last-bottom?
 
 ;; - separate function for word-wrap style breaking?
 ;; - ragged-bottom? ragged-last-bottom?
 

-(define (get-path node done)
-  "Follow NODE.PREV, and return as an ascending list of pages. DONE
+(define-public (optimal-page-breaks lines paper-book)
+  "Return pages as a list starting with 1st page. Each page is a 'page Prob."
+
+  (define MAXPENALTY 1e9)
+  (define paper (ly:paper-book-paper paper-book))
+
+  ;; ugh.
+  (define page-alist (layout->page-init (ly:paper-book-paper paper-book))) 
+  (define scopes (ly:paper-book-scopes paper-book))
+  (define force-equalization-factor #f)
+  (define (get-path node done)
+    
+    "Follow NODE.PREV, and return as an ascending list of pages. DONE

 is what have collected so far, and has ascending page numbers."
 is what have collected so far, and has ascending page numbers."

-  (if (page? node)
-      (get-path (page-prev node) (cons node done))
-      done))
-
-(define (combine-penalties force user best-paths
-                          inter-system-space force-equalization-factor)
-  (let* ((prev-force (if (null? best-paths)
-                        0.0
-                        (page-force (car best-paths))))
-        (prev-penalty (if (null? best-paths)
+
+    (if (page? node)
+       (get-path (page-prev node) (cons node done))
+       done))
+
+  (define (combine-penalties force user best-paths)
+    (let* ((prev-force (if (null? best-paths)

                           0.0
                           0.0

-                          (page-penalty (car best-paths))))
+                          (page-force (car best-paths))))
+          (prev-penalty (if (null? best-paths)
+                            0.0
+                            (page-penalty (car best-paths))))
+        (inter-system-space (ly:output-def-lookup paper 'between-system-space))

         (relative-force (/ force inter-system-space))
         (abs-relative-force (abs relative-force)))
         (relative-force (/ force inter-system-space))
         (abs-relative-force (abs relative-force)))

-    (+ (* abs-relative-force (+ abs-relative-force 1))
-       prev-penalty
-       (* force-equalization-factor (/ (abs (- prev-force force))
-                                      inter-system-space))
-       user)))
-
-(define (walk-paths done-lines best-paths current-lines last current-best
-                   paper-book page-alist)
-  "Return the best optimal-page-break-node that contains
-CURRENT-LINES. DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
+
+      (+ (* abs-relative-force (+ abs-relative-force 1))
+        prev-penalty
+        (* force-equalization-factor (/ (abs (- prev-force force))
+                                        inter-system-space))
+        user)))
+
+  (define (space-systems page-height lines ragged?)
+    (let* ((global-inter-system-space
+           (ly:output-def-lookup paper 'between-system-space))
+          (top-space
+           (ly:output-def-lookup paper 'page-top-space))
+          (global-fixed-dist (ly:output-def-lookup paper 'between-system-padding))
+          
+          (system-vector (list->vector
+                          (append lines
+                                  (if (= (length lines) 1)
+                                      '(#f)
+                                      '()))))
+          (staff-extents
+           (list->vector
+            (append (map paper-system-staff-extents lines)
+                    (if (= (length lines) 1)
+                        '((0 . 0))
+                        '()))))
+
+          (real-extents
+           (list->vector
+            (append
+             (map
+              (lambda (sys) (paper-system-extent sys Y)) lines)
+             (if (= (length lines) 1)
+                 '((0 .  0))
+                 '()))))
+          
+          (system-count (vector-length real-extents))
+          (topskip (max
+                    (+
+                     top-space
+                     (interval-end (vector-ref staff-extents 0)))
+                    (interval-end (vector-ref real-extents 0))
+                    ))
+          (last-system (vector-ref system-vector (1- system-count)))
+          (bottom-space (if (ly:prob? last-system)
+                            (ly:prob-property last-system 'bottom-space 0.0)
+                            0.0))
+          (space-left (- page-height
+                         bottom-space
+                         (apply + (map interval-length
+                                       (vector->list real-extents)))))
+
+          (space (- page-height
+                    topskip
+                    bottom-space
+                    (-  (interval-start
+                         (vector-ref real-extents (1- system-count))))))
+
+          (calc-spring
+           (lambda (idx)
+             (let* (
+                    (upper-system (vector-ref system-vector idx))
+                    (between-space (ly:prob-property upper-system 'next-space
+                                                             global-inter-system-space))
+                    (fixed-dist (ly:prob-property upper-system 'next-padding
+                                                          global-fixed-dist))
+                    
+                    (this-system-ext (vector-ref staff-extents idx))
+                    (next-system-ext (vector-ref staff-extents (1+ idx)))
+                    (fixed (max 0 (- (+ (interval-end next-system-ext)
+                                        fixed-dist)
+                                     (interval-start this-system-ext))))
+                    (title1? (and (vector-ref system-vector idx)
+                                  (paper-system-title? (vector-ref system-vector idx)
+                                                            )))
+                    (title2? (and
+                              (vector-ref system-vector (1+ idx))
+                              (paper-system-title? (vector-ref system-vector (1+ idx)))))
+                    (ideal (+
+                            (cond
+                             ((and title2? title1?)
+                              (ly:output-def-lookup paper 'between-title-space))
+                             (title1?
+                              (ly:output-def-lookup paper 'after-title-space))
+                             (title2?
+                              (ly:output-def-lookup paper 'before-title-space))
+                             (else between-space))
+                            fixed))
+                    (hooke (/ 1 (- ideal fixed))))
+               (list ideal hooke))))
+
+          (springs (map calc-spring (iota (1- system-count))))
+          (calc-rod
+           (lambda (idx)
+             (let* (
+                    (upper-system (vector-ref system-vector idx))
+                    (fixed-dist (ly:prob-property upper-system 'next-padding
+                                                          global-fixed-dist))
+                    (this-system-ext (vector-ref real-extents idx))
+                    (next-system-ext (vector-ref real-extents (1+ idx)))
+                    
+                    (distance (max  (- (+ (interval-end next-system-ext)
+                                          fixed-dist)
+                                       (interval-start this-system-ext)
+                                       ) 0))
+                    (entry (list idx (1+ idx) distance)))
+               entry)))
+          (rods (map calc-rod (iota (1- system-count))))
+
+          ;; we don't set ragged based on amount space left.
+          ;; ragged-bottomlast = ##T is much more predictable
+          (result (ly:solve-spring-rod-problem
+                   springs rods space
+                   ragged?))
+
+          (force (car result))
+          (positions
+           (map (lambda (y)
+                  (+ y topskip))
+                (cdr  result))))
+
+      (if #f ;; debug.
+         (begin
+           (display (list "\n# systems: " system-count
+                          "\nreal-ext" real-extents "\nstaff-ext" staff-extents
+                          "\ninterscore" global-inter-system-space
+                          "\nspace-left" space-left
+                          "\nspring,rod" springs rods
+                          "\ntopskip " topskip
+                          " space " space
+                          "\npage-height" page-height
+                          "\nragged" ragged?
+                          "\nforce" force
+                          "\nres" (cdr result)
+                          "\npositions" positions "\n"))))
+
+      (cons force positions)))
+
+  (define (walk-paths done-lines best-paths current-lines last? current-best)
+    "Return the best optimal-page-break-node that contains
+CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive

 ascending range of lines, and BEST-PATHS contains the optimal breaks
 corresponding to DONE-LINES.
 
 CURRENT-BEST is the best result sofar, or #f."
 ascending range of lines, and BEST-PATHS contains the optimal breaks
 corresponding to DONE-LINES.
 
 CURRENT-BEST is the best result sofar, or #f."

-  (let* ((paper (ly:paper-book-paper paper-book))
-        (this-page (make-page
-                    paper-book
-                    'is-last last
-                    'page-number (if (null? best-paths)
-                                     (ly:output-def-lookup paper 'first-page-number)
-                                     (1+ (page-page-number (first best-paths))))))
-        (ragged-all (eq? #t (ly:output-def-lookup paper 'ragged-bottom)))
-        (ragged-last (eq? #t (ly:output-def-lookup paper 'ragged-last-bottom)))
-        (ragged (or ragged-all (and ragged-last last)))
-        (space-to-fill (page-maximum-space-to-fill this-page current-lines paper))
-        (vertical-spacing (space-systems space-to-fill current-lines ragged paper #f))
-        (satisfied-constraints (car vertical-spacing))
-        (force (if satisfied-constraints
-                   (if (and last ragged-last)
-                       0.0
-                       satisfied-constraints)
-                   10000))
-        (positions (cdr vertical-spacing))
-        (get-break-penalty (lambda (sys)
-                             (ly:prob-property sys 'penalty 0.0)))
-        (user-nobreak-penalties (- (apply + (filter negative?
-                                                    (map get-break-penalty
-                                                         (cdr current-lines))))))
-        (user-penalty (+ (max (get-break-penalty (car current-lines)) 0.0)
-                         user-nobreak-penalties))
-        (total-penalty (combine-penalties
-                        force user-penalty best-paths
-                        (ly:output-def-lookup paper 'between-system-space)
-                        (ly:output-def-lookup paper 'verticalequalizationfactor 0.3)))
-        (new-best (if (or (not current-best)
-                          (and satisfied-constraints
-                               (< total-penalty (page-penalty current-best))))
-                      (begin
-                        (map (lambda (x)
-                               (page-set-property! this-page
-                                                   (car x)
-                                                   (cdr x)))
-                             (list (cons 'prev (if (null? best-paths)
-                                                   #f
-                                                   (car best-paths)))
-                                   (cons 'lines current-lines)
-                                   (cons 'force force)
-                                   (cons 'configuration positions)
-                                   (cons 'penalty total-penalty)))
-                        this-page)
-                      current-best)))
-    (if #f ;; debug
-       (display
-        (list
-         "\nuser pen " user-penalty
-         "\nsatisfied-constraints" satisfied-constraints
-         "\nlast? " last "ragged?" ragged
-         "\nis-better " is-better " total-penalty " total-penalty "\n"
-         "\nconfig " positions
-         "\nforce " force
-         "\nlines: " current-lines "\n")))
-    (if #f ; debug
-       (display (list "\nnew-best is " (page-lines new-best)
-                      "\ncontinuation of "
-                      (if (null? best-paths)
-                          "start"
-                          (page-lines (car best-paths))))))
-    (if (and (pair? done-lines)
-            ;; if this page is too full, adding another line won't help
-            satisfied-constraints)
-       (walk-paths (cdr done-lines) (cdr best-paths)
-                   (cons (car done-lines) current-lines)
-                   last new-best
-                   paper-book page-alist)
-       new-best)))
-
-(define (walk-lines done best-paths todo paper-book page-alist)
-  "Return the best page breaking as a single
+
+    (let* ((this-page-num (if (null? best-paths)
+                              (ly:output-def-lookup paper 'first-page-number)
+                              (1+ (page-page-number (car best-paths)))))
+
+          (this-page (make-page
+                      page-alist
+                      'paper-book paper-book
+                      'is-last last?
+                      'page-number this-page-num))
+
+          (ragged-all? (eq? #t (ly:output-def-lookup paper 'ragged-bottom)))
+          (ragged-last? (eq? #t (ly:output-def-lookup paper 'ragged-last-bottom)))
+          (ragged? (or ragged-all?
+                       (and ragged-last?
+                            last?)))
+           (height (page-printable-height this-page))
+          (vertical-spacing (space-systems height current-lines ragged?))
+          
+          (satisfied-constraints (car vertical-spacing))
+           (force (if satisfied-constraints
+                     (if (and last? ragged-last?)
+                         0.0
+                         satisfied-constraints)
+                     10000))
+          (positions (cdr vertical-spacing))
+          (get-break-penalty (lambda (sys)
+                               (ly:prob-property sys 'penalty 0.0)))
+          (user-nobreak-penalties
+           (-
+            (apply + (filter negative?
+                             (map get-break-penalty
+                                  (cdr current-lines))))))
+           (user-penalty
+           (+
+            (max (get-break-penalty (car current-lines)) 0.0)
+            user-nobreak-penalties))
+          
+           (total-penalty (combine-penalties
+                           force user-penalty
+                          best-paths))
+
+           (is-better (or
+                      (not current-best)
+                      (and
+                       satisfied-constraints
+                       (< total-penalty (page-penalty current-best)))))
+           (new-best (if is-better
+                        (begin
+                          (map
+                           (lambda (x)
+                             (page-set-property! this-page
+                                                 (car x)
+                                                 (cdr x)))
+                           (list
+                            (cons 'prev (if (null? best-paths)
+                                            #f
+                                            (car best-paths)))
+                            (cons 'lines current-lines)
+                            (cons 'force force)
+                            (cons 'configuration positions)
+                            (cons 'penalty total-penalty)))
+                          this-page)
+                         current-best)))
+
+;;      (display total-penalty) (newline)
+      (if #f ;; debug
+          (display
+           (list
+            "\nuser pen " user-penalty
+           "\nsatisfied-constraints" satisfied-constraints
+           "\nlast? " last? "ragged?" ragged?
+            "\nis-better " is-better " total-penalty " total-penalty "\n"
+           "\nconfig " positions
+            "\nforce " force
+           "\nlines: " current-lines "\n")))
+
+      (if #f ; debug
+         (display (list "\nnew-best is " (page-lines new-best)
+                        "\ncontinuation of "
+                        (if (null? best-paths)
+                            "start"
+                            (page-lines (car best-paths))))))
+
+      (if (and (pair? done-lines)
+               ;; if this page is too full, adding another line won't help
+               satisfied-constraints)
+          (walk-paths (cdr done-lines) (cdr best-paths)
+                      (cons (car done-lines) current-lines)
+                      last? new-best)
+         new-best)))
+
+  (define (walk-lines done best-paths todo)
+    "Return the best page breaking as a single

 page node for optimally breaking TODO ++
 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 DONE."
 page node for optimally breaking TODO ++
 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 DONE."

-  (if (null? todo)
-      (car best-paths)
-      (let* ((this-line (car todo))
-            (last (null? (cdr todo)))
-            (next (walk-paths done best-paths (list this-line) last #f
-                              paper-book page-alist)))
-       (walk-lines (cons this-line done)
-                   (cons next best-paths)
-                   (cdr todo)
-                   paper-book
-                   page-alist))))
-
-(define-public (optimal-page-breaks paper-book)
-  "Return pages as a list starting with 1st page. Each page is a 'page Prob."
-  (let* ((paper (ly:paper-book-paper paper-book))
-        (lines (ly:paper-book-systems paper-book))
-        (page-alist (layout->page-init paper)) 
-        (force-equalization-factor (ly:output-def-lookup
-                                    paper 'verticalequalizationfactor 0.3)))
-    (ly:message (_ "Calculating page breaks..."))
-    (let* ((best-break-node (walk-lines '() '() lines paper-book page-alist))
-          (break-nodes (get-path best-break-node '())))
-      (page-set-property! (car (last-pair break-nodes)) 'is-last #t)
-      (if #f; (ly:get-option 'verbose)
-         (begin
-           (display (list
-                     "\nbreaks: " (map (lambda (node)
-                                         (ly:prob-property (car (page-lines node))
-                                                           'number))
-                                       break-nodes)
-                     "\nsystems " (map page-lines break-nodes)
-                     "\npenalties " (map page-penalty break-nodes)
-                     "\nconfigs " (map page-configuration break-nodes)))))
-      ;; construct page stencils.
-      (for-each page-stencil break-nodes)
-      break-nodes)))
+    
+    (if (null? todo)
+       (car best-paths)
+       (let* ((this-line (car todo))
+              (last? (null? (cdr todo)))
+              (next (walk-paths done best-paths (list this-line) last? #f)))
+
+         ;; (display "\n***************")
+         (walk-lines (cons this-line done)
+                     (cons next best-paths)
+                     (cdr todo)))))
+
+  (define (line-number node)
+    (ly:prob-property (car (page-lines node)) 'number))
+  
+  (ly:message (_ "Calculating page breaks..."))
+  (set! force-equalization-factor
+       (ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
+  
+  (let* ((best-break-node (walk-lines '() '() lines))
+        (break-nodes (get-path best-break-node '())))
+
+    (page-set-property! (car (last-pair break-nodes)) 'is-last #t)
+    (if #f; (ly:get-option 'verbose)
+       (begin
+         (display (list
+                   "\nbreaks: " (map line-number break-nodes))
+                  "\nsystems " (map page-lines break-nodes)
+                  "\npenalties " (map page-penalty break-nodes)
+                  "\nconfigs " (map page-configuration break-nodes))))
+
+    ;; construct page stencils.
+    (for-each page-stencil break-nodes)
+    (post-process-pages paper break-nodes)
+    
+    break-nodes))