X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flayout-page-layout.scm;h=715629c3b36b36d622950b8eb50b446980d37485;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=91742ef315f98319e9d017aa4a1021af2ed79539;hpb=3f3019866f87eede1da58b6f2c64097eb5b9b37c;p=lilypond.git diff --git a/scm/layout-page-layout.scm b/scm/layout-page-layout.scm index 91742ef315..715629c3b3 100644 --- a/scm/layout-page-layout.scm +++ b/scm/layout-page-layout.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004--2006 Jan Nieuwenhuizen +;;;; (c) 2004--2008 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys (define-module (scm layout-page-layout) @@ -21,7 +21,6 @@ line-minimum-distance line-ideal-distance first-line-position line-ideal-relative-position line-minimum-relative-position - line-minimum-position-on-page page-maximum-space-to-fill page-maximum-space-left space-systems)) ; this is for 2-pass spacing. Delete me. @@ -32,7 +31,8 @@ (= (interval-start system-extent) (interval-end system-extent)))))) -(define (stretch-and-draw-page paper-book systems page-number ragged last) +(define (stretch-and-draw-page paper-book systems page-number ragged + is-last-bookpart is-bookpart-last-page) (define (max-stretch sys) (if (ly:grob? sys) (ly:grob-property sys 'max-stretch) @@ -79,7 +79,8 @@ (let* ((page (make-page paper-book 'page-number page-number - 'is-last last)) + 'is-last-bookpart is-last-bookpart + 'is-bookpart-last-page is-bookpart-last-page)) (paper (ly:paper-book-paper paper-book)) (height (page-printable-height page)) ; there is a certain amount of impreciseness going on here: @@ -102,21 +103,29 @@ (filter stretchable? systems))) height-left)) - (let* ((lines (map print-system systems)) - (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 (and (> (length lines) 1) - (or (not (car spacing)) (inf? (car spacing)))) - (begin - (ly:warning (_ "Can't fit systems on page -- ignoring between-system-padding")) - (cdr (space-systems space-to-fill lines ragged paper #t))) - (cdr spacing)))))) + (let ((lines (map print-system systems))) (page-set-property! page 'lines lines) - (page-set-property! page 'configuration posns) + (page-set-property! + page 'configuration + (if (null? lines) + (list) + (let* ((paper (ly:paper-book-paper paper-book)) + (max-space-to-fill (page-maximum-space-to-fill page lines paper)) + (space-to-fill (if (ly:output-def-lookup + paper 'page-limit-inter-system-space #f) + (min max-space-to-fill + (* (ly:output-def-lookup + paper 'page-limit-inter-system-space-factor 1.4) + (- max-space-to-fill + (or (page-ideal-space-left page) 0)))) + max-space-to-fill)) + (spacing (space-systems space-to-fill lines ragged paper #f))) + (if (and (> (length lines) 1) + (or (not (car spacing)) (inf? (car spacing)))) + (begin + (ly:warning (_ "Can't fit systems on page -- ignoring between-system-padding")) + (cdr (space-systems space-to-fill lines ragged paper #t))) + (cdr spacing))))) page))) (define (page-breaking-wrapper paper-book) @@ -195,11 +204,11 @@ "Ideal distance between `line' reference position and `next-line' reference position. If next-line is #f, return #f." (and next-line - (max (+ (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)) - (line-minimum-distance line next-line layout ignore-padding)))) + (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" @@ -229,18 +238,16 @@ ;; 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) +(define (line-position-on-page line prev-line prev-position page relative-positionning-fn) "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) + (position (+ (relative-positionning-fn line prev-line layout #f) (if prev-line prev-position 0.0))) (bottom-position (- position (interval-start (line-extent line))))) - (and (or (not prev-line) - (< bottom-position (page-printable-height page))) - position))) + position)) (define (page-maximum-space-to-fill page lines paper) "Return the space between the first line top position and the last line @@ -253,7 +260,7 @@ 'bottom-space 0.0) (- (interval-start (line-extent last-line)))))) -(define (page-maximum-space-left page) +(define (page-space-left page relative-positionning-fn) (let ((paper (ly:paper-book-paper (page-property page 'paper-book)))) (let bottom-position ((lines (page-property page 'lines)) (prev-line #f) @@ -261,15 +268,21 @@ (if (null? lines) (page-printable-height page) (let* ((line (first lines)) - (position (line-minimum-position-on-page - line prev-line prev-position page))) + (position (line-position-on-page + line prev-line prev-position page relative-positionning-fn))) (if (null? (cdr lines)) - (and position + (max 0 (- (page-printable-height page) (- position (interval-start (line-extent line))))) (bottom-position (cdr lines) line position))))))) +(define (page-maximum-space-left page) + (page-space-left page line-minimum-relative-position)) + +(define (page-ideal-space-left page) + (page-space-left page line-ideal-relative-position)) + ;;; ;;; Utilities for distributing systems on a page ;;; @@ -340,8 +353,8 @@ is what have collected so far, and has ascending page numbers." inter-system-space)) user))) -(define (walk-paths done-lines best-paths current-lines last current-best - paper-book page-alist) +(define (walk-paths done-lines best-paths current-lines is-last-bookpart + is-bookpart-last-page 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 ascending range of lines, and BEST-PATHS contains the optimal breaks @@ -351,18 +364,19 @@ 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 + 'is-last-bookpart is-last-bookpart + 'is-bookpart-last-page is-bookpart-last-page '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))) + (ragged (or ragged-all (and ragged-last is-bookpart-last-page))) (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) + (if (and is-bookpart-last-page ragged-last) 0.0 satisfied-constraints) 10000)) @@ -400,7 +414,7 @@ CURRENT-BEST is the best result sofar, or #f." (list "\nuser pen " user-penalty "\nsatisfied-constraints" satisfied-constraints - "\nlast? " last "ragged?" ragged + "\nlast? " is-bookpart-last-page "ragged?" ragged "\nis-better " is-better " total-penalty " total-penalty "\n" "\nconfig " positions "\nforce " force @@ -416,11 +430,11 @@ CURRENT-BEST is the best result sofar, or #f." satisfied-constraints) (walk-paths (cdr done-lines) (cdr best-paths) (cons (car done-lines) current-lines) - last new-best + is-last-bookpart is-bookpart-last-page new-best paper-book page-alist) new-best))) -(define (walk-lines done best-paths todo paper-book page-alist) +(define (walk-lines done best-paths todo paper-book page-alist is-last-bookpart) "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 @@ -428,14 +442,15 @@ 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))) + (is-bookpart-last-page (null? (cdr todo))) + (next (walk-paths done best-paths (list this-line) is-last-bookpart + is-bookpart-last-page #f paper-book page-alist))) (walk-lines (cons this-line done) (cons next best-paths) (cdr todo) paper-book - page-alist)))) + page-alist + is-last-bookpart)))) (define-public (optimal-page-breaks paper-book) "Return pages as a list starting with 1st page. Each page is a 'page Prob." @@ -443,11 +458,11 @@ DONE." (lines (ly:paper-book-systems paper-book)) (page-alist (layout->page-init paper)) (force-equalization-factor (ly:output-def-lookup - paper 'verticalequalizationfactor 0.3))) + paper 'verticalequalizationfactor 0.3)) + (is-last-bookpart (ly:output-def-lookup paper 'is-last-bookpart))) (ly:message (_ "Calculating page breaks...")) - (let* ((best-break-node (walk-lines '() '() lines paper-book page-alist)) + (let* ((best-break-node (walk-lines '() '() lines paper-book page-alist is-last-bookpart)) (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