X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flayout-page-layout.scm;h=38da734bd38a5b6add540937a7ab56680b0d014b;hb=2aada748eeb7e563cbd23f30ece2fe79e3d346a5;hp=6c1f605b0d7d0bc80c8161c6636e24711602e06f;hpb=9f114c6402fb7cf9c9bf0ea97ee7c16291c48193;p=lilypond.git diff --git a/scm/layout-page-layout.scm b/scm/layout-page-layout.scm index 6c1f605b0d..38da734bd3 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--2007 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. @@ -102,21 +101,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) @@ -156,16 +163,13 @@ `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)))))) + (ly:prob-property + line 'next-space + (ly:output-def-lookup layout + (cond ((and title next-title) 'between-title-space) + (title 'after-title-space) + (next-title 'before-title-space) + (else 'between-system-space)))))) (define (line-next-padding line next-line layout) "Return padding to use between `line' and `next-line'. @@ -198,10 +202,11 @@ "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)))) + (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)))) (define (first-line-position line layout) "Position of the first line on page" @@ -231,18 +236,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 @@ -255,7 +258,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) @@ -263,15 +266,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 ;;; @@ -287,7 +296,7 @@ '()))) (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)))) + (line-next-space prev-line line paper))) lines cdr-lines)) (rods (map (let ((i -1))