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 52544ec2fafd5c105a3feaf28eb0ca461c0cfcbd..8a7628af857519d7c1dc0ec0bb8c718db029ab27 100644 (file)
--- a/scm/layout-page-layout.scm
+++ b/scm/layout-page-layout.scm
@@ -101,10 +101,17 @@
        (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)
@@ -112,6 +119,7 @@
                     . ((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))))
@@ -135,16 +143,14 @@
   (if (ly:output-def-lookup layout 'write-page-layout #f)
       (write-page-breaks pages)))
 
-;;; optimal page breaking
-
-;;; This is not optimal page breaking, this is optimal distribution of
-;;; lines over pages; line breaks are a given.
+;; Optimal distribution of
+;; lines over pages; line breaks are a given.
 
 ;; TODO:
 ;;
 ;; - density scoring
 ;; - separate function for word-wrap style breaking?
-;; - raggedbottom? raggedlastbottom?
+;; - ragged-bottom? ragged-last-bottom?
 
 (define-public (optimal-page-breaks lines paper-book)
   "Return pages as a list starting with 1st page. Each page is a 'page Prob."
@@ -157,6 +163,7 @@
   (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."
 
@@ -171,7 +178,7 @@ is what have collected so far, and has ascending page numbers."
           (prev-penalty (if (null? best-paths)
                             0.0
                             (page-penalty (car best-paths))))
-        (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
+        (inter-system-space (ly:output-def-lookup paper 'between-system-space))
         (relative-force (/ force inter-system-space))
         (abs-relative-force (abs relative-force)))
 
@@ -183,10 +190,10 @@ is what have collected so far, and has ascending page numbers."
 
   (define (space-systems page-height lines ragged?)
     (let* ((global-inter-system-space
-           (ly:output-def-lookup paper 'betweensystemspace))
+           (ly:output-def-lookup paper 'between-system-space))
           (top-space
-           (ly:output-def-lookup paper 'pagetopspace))
-          (global-fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
+           (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
@@ -254,11 +261,11 @@ is what have collected so far, and has ascending page numbers."
                     (ideal (+
                             (cond
                              ((and title2? title1?)
-                              (ly:output-def-lookup paper 'betweentitlespace))
+                              (ly:output-def-lookup paper 'between-title-space))
                              (title1?
-                              (ly:output-def-lookup paper 'aftertitlespace))
+                              (ly:output-def-lookup paper 'after-title-space))
                              (title2?
-                              (ly:output-def-lookup paper 'beforetitlespace))
+                              (ly:output-def-lookup paper 'before-title-space))
                              (else between-space))
                             fixed))
                     (hooke (/ 1 (- ideal fixed))))
@@ -283,7 +290,7 @@ is what have collected so far, and has ascending page numbers."
           (rods (map calc-rod (iota (1- system-count))))
 
           ;; we don't set ragged based on amount space left.
-          ;; raggedbottomlast = ##T is much more predictable
+          ;; ragged-bottomlast = ##T is much more predictable
           (result (ly:solve-spring-rod-problem
                    springs rods space
                    ragged?))
@@ -311,7 +318,7 @@ is what have collected so far, and has ascending page numbers."
 
       (cons force positions)))
 
-  (define (walk-paths done-lines best-paths current-lines  last? current-best)
+  (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
@@ -319,9 +326,8 @@ corresponding to DONE-LINES.
 
 CURRENT-BEST is the best result sofar, or #f."
 
-
     (let* ((this-page-num (if (null? best-paths)
-                              (ly:output-def-lookup paper 'firstpagenumber)
+                              (ly:output-def-lookup paper 'first-page-number)
                               (1+ (page-page-number (car best-paths)))))
 
           (this-page (make-page
@@ -330,13 +336,14 @@ CURRENT-BEST is the best result sofar, or #f."
                       'is-last last?
                       'page-number this-page-num))
 
-          (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom)))
-          (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom)))
+          (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?)
@@ -360,10 +367,12 @@ CURRENT-BEST is the best result sofar, or #f."
                            force user-penalty
                           best-paths))
 
-           (better? (or
-                     (not current-best)
-                     (< total-penalty (page-penalty current-best))))
-           (new-best (if better?
+           (is-better (or
+                      (not current-best)
+                      (and
+                       satisfied-constraints
+                       (< total-penalty (page-penalty current-best)))))
+           (new-best (if is-better
                         (begin
                           (map
                            (lambda (x)
@@ -388,7 +397,7 @@ CURRENT-BEST is the best result sofar, or #f."
             "\nuser pen " user-penalty
            "\nsatisfied-constraints" satisfied-constraints
            "\nlast? " last? "ragged?" ragged?
-            "\nbetter? " better? " total-penalty " total-penalty "\n"
+            "\nis-better " is-better " total-penalty " total-penalty "\n"
            "\nconfig " positions
             "\nforce " force
            "\nlines: " current-lines "\n")))
@@ -433,8 +442,7 @@ DONE."
        (ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
   
   (let* ((best-break-node (walk-lines '() '() lines))
-        (break-nodes (get-path best-break-node '()))
-        )
+        (break-nodes (get-path best-break-node '())))
 
     (page-set-property! (car (last-pair break-nodes)) 'is-last #t)
     (if #f; (ly:get-option 'verbose)