X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flayout-page-layout.scm;h=1686d9613a11d7ac097e484f797f462282feb372;hb=903bf2659772b432c08b2c971832fb6b37f6e726;hp=3516a6412735e43824194c083c20c7ca6bc37585;hpb=15fc2d2d49677da8e6c77185615868276e9bd771;p=lilypond.git diff --git a/scm/layout-page-layout.scm b/scm/layout-page-layout.scm index 3516a64127..1686d9613a 100644 --- a/scm/layout-page-layout.scm +++ b/scm/layout-page-layout.scm @@ -2,8 +2,8 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004--2006 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; (c) 2004--2007 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys (define-module (scm layout-page-layout) #:use-module (srfi srfi-1) @@ -14,66 +14,208 @@ #:use-module (scm layout-page-dump) #:use-module (lily) #:export (post-process-pages optimal-page-breaks make-page-from-systems + page-breaking-wrapper + stretchable-line? ; delete me ;; utilities for writing custom page breaking functions - line-next-space line-next-padding + 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 - page-maximum-space-to-fill space-systems)) + page-maximum-space-to-fill page-maximum-space-left space-systems)) + +; this is for 2-pass spacing. Delete me. +(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 (stretch-and-draw-page paper-book systems page-number ragged last) + (define (max-stretch sys) + (if (ly:grob? sys) + (ly:grob-property sys 'max-stretch) + 0.0)) + + (define (stretchable? sys) + (and (ly:grob? sys) + (> (max-stretch sys) 0.0))) + + (define (height-estimate sys) + (interval-length + (if (ly:grob? sys) + (ly:grob-property sys 'pure-Y-extent) + (paper-system-extent sys Y)))) + + (define (print-system sys) + (if (ly:grob? sys) + (ly:system-print sys) + sys)) + + (define (set-line-stretch! sorted-lines rest-height space-left) + (if (not (null? sorted-lines)) + (let* ((line (first sorted-lines)) + (height (height-estimate line)) + (stretch (min (max-stretch line) + (if (positive? rest-height) + (/ (* height space-left) rest-height) + 0.0)))) + (if (stretchable? line) + (ly:system-stretch line stretch)) + (set-line-stretch! (cdr sorted-lines) + (if (stretchable? line) + (- rest-height height) + rest-height) + (- space-left stretch))))) + + (define (total-padding systems) + (let ((layout (ly:paper-book-paper paper-book))) + (if (or (null? systems) + (null? (cdr systems))) + 0.0 + (+ (line-next-padding (car systems) (cadr systems) layout) + (total-padding (cdr systems)))))) + + (let* ((page (make-page paper-book + 'page-number page-number + 'is-last last)) + (paper (ly:paper-book-paper paper-book)) + (height (page-printable-height page)) + ; there is a certain amount of impreciseness going on here: + ; the system heights are estimated, we aren't using skyline distances + ; yet, etc. If we overstretch because of underestimation, the result + ; is very bad. So we stick in some extra space, just to be sure. + (buffer (/ height 10.0)) + (total-system-height (+ (apply + (map height-estimate systems)) + (total-padding systems))) + (height-left (- height total-system-height buffer))) + + (if (and + (not ragged) + (> height-left 0)) + (set-line-stretch! (sort systems + (lambda (s1 s2) + (< (height-estimate s1) + (height-estimate s2)))) + (apply + (map height-estimate + (filter stretchable? systems))) + height-left)) + + (let ((lines (map print-system systems))) + (page-set-property! page 'lines lines) + (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) + "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)) (define (post-process-pages layout pages) - (if (ly:output-def-lookup layout 'write-page-layout #f) - (write-page-breaks pages))) + "If the write-page-layout paper variable is true, dumps page breaks + and tweaks." + + (let* + ((parser (ly:modules-lookup (list (current-module)) 'parser)) + (output-name (ly:parser-output-name parser)) + ) + + (if (ly:output-def-lookup layout 'write-page-layout #f) + (write-page-breaks pages output-name)))) ;;; ;;; Utilities for computing line distances and positions ;;; +(define (line-extent line) + "Return the extent of the line (its lowest and highest Y-coordinates)." + (paper-system-extent line Y)) + +(define (line-height line) + "Return the system height, that is the length of its vertical extent." + (interval-length (line-extent line))) + (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)))))) + (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'. `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))) + (let ((default (ly:output-def-lookup layout 'between-system-padding))) + (if (ly:grob? line) + (let* ((details (ly:grob-property line 'line-break-system-details)) + (padding (assq 'next-padding details))) + (if padding + (cdr padding) + default)) + (ly:prob-property line 'next-padding default)))) (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)))))) + (let ((padding (if ignore-padding + 0 + (line-next-padding line next-line layout)))) + (if (or (ly:grob? line) (ly:grob? next-line)) + (max 0 (+ padding + (- (interval-start (line-extent line)) + (interval-end (line-extent next-line))))) + (max 0 (+ padding + (ly:paper-system-minimum-distance line next-line))))))) (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)))) + (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) + (max (+ (if (ly:prob-property? line 'is-title) + ;; do not use page-top-space if first line is a title + 0.0 + (ly:output-def-lookup layout 'page-top-space)) (interval-end (paper-system-staff-extents line))) - (interval-end (paper-system-extent line Y)))) + (interval-end (line-extent line)))) (define (line-ideal-relative-position line prev-line layout ignore-padding) "Return ideal position of `line', relative to `prev-line' position. @@ -94,6 +236,17 @@ ;; not the first line on page (line-minimum-distance prev-line line layout ignore-padding))) +(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 (+ (relative-positionning-fn line prev-line layout #f) + (if prev-line prev-position 0.0))) + (bottom-position (- position + (interval-start (line-extent line))))) + position)) + (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' @@ -103,7 +256,30 @@ (first-line-position (first lines) paper) (ly:prob-property last-line 'bottom-space 0.0) - (- (interval-start (paper-system-extent last-line Y)))))) + (- (interval-start (line-extent last-line)))))) + +(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) + (prev-position #f)) + (if (null? lines) + (page-printable-height page) + (let* ((line (first lines)) + (position (line-position-on-page + line prev-line prev-position page relative-positionning-fn))) + (if (null? (cdr lines)) + (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 @@ -120,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)) @@ -138,23 +314,6 @@ (+ 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 @@ -195,7 +354,7 @@ is what have collected so far, and has ascending page numbers." (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 +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. @@ -312,5 +471,4 @@ DONE." "\nconfigs " (map page-configuration break-nodes))))) ;; construct page stencils. (for-each page-stencil break-nodes) - (post-process-pages paper break-nodes) break-nodes)))