Index: ChangeLog =================================================================== RCS file: /cvsroot/lilypond/lilypond/ChangeLog,v retrieving revision 1.5337 diff -u -r1.5337 ChangeLog --- ChangeLog 29 Sep 2006 23:28:04 -0000 1.5337 +++ ChangeLog 30 Sep 2006 11:54:09 -0000 @@ -1,3 +1,44 @@ +2006-09-30 Nicolas Sceaux + + * scm/layout-page-layout.scm (page-breaking-wrapper): new + function. Call the page breaking function selected in the + `page-breaking' \paper variable, then the post processing function + chosen using the `page-post-process' \paper variable. + (line-height): new function. Return the height of a system. + (line-minimum-position-on-page): new function. Return the position + of a system on page (using the previous line position), only + considering between system padding. + (stretchable-line?): new function. Says whether a line can be + stretched (ie. is not a title nor a single staff system). + (page-maximum-space-left): new function. Computes space left on a + page, when all systems are separated by their padding. + + * lily/page-breaking.cc (breaking::make_pages): Move page post + processing function call to page breaking wrapper (common to all + page breakers). + + * lily/paper-book.cc (book::pages): call the page breaking + wrapper, instead of the page breaker directly + + * ly/paper-defaults.ly: Add \paper variables for page breaking + wrapper and page post processing function. Make + `write-page-layout' value depend on the 'dump-tweaks option. Add a + `system-maximum-stretch-procedure' variable for holding a function + computing the maximum stretch a system allows. + + * scm/layout-page-dump.scm (write-page-breaks): computes the + stretch to apply to systems on a page to minimize left + space. Dump this stretch length. + + * ly/music-functions-init.ly (spacingTweaks): implement it. Read + the system-stretch property of the tweak data to stretch the + system. + (includePageLayoutFile): Void function which includes the + generated page-layout file if it exists and if the page layout + dumping is not asked. + (scoreTweak): if the score tweak named by the argument exists, + return it. + 2006-09-30 Joe Neeman * lily/page-turn-engraver.cc (breakable_column): remove an always-true Index: lily/page-breaking.cc =================================================================== RCS file: /cvsroot/lilypond/lilypond/lily/page-breaking.cc,v retrieving revision 1.6 diff -u -r1.6 page-breaking.cc --- lily/page-breaking.cc 28 Sep 2006 22:40:05 -0000 1.6 +++ lily/page-breaking.cc 30 Sep 2006 11:54:10 -0000 @@ -176,14 +176,11 @@ Page_breaking::make_pages (vector lines_per_page, SCM systems) { SCM layout_module = scm_c_resolve_module ("scm layout-page-layout"); - SCM dump_module = scm_c_resolve_module ("scm layout-page-dump"); SCM page_module = scm_c_resolve_module ("scm page"); SCM make_page = scm_c_module_lookup (layout_module, "make-page-from-systems"); - SCM write_page_breaks = scm_c_module_lookup (dump_module, "write-page-breaks"); SCM page_stencil = scm_c_module_lookup (page_module, "page-stencil"); make_page = scm_variable_ref (make_page); - write_page_breaks = scm_variable_ref (write_page_breaks); page_stencil = scm_variable_ref (page_stencil); SCM book = book_->self_scm (); @@ -207,9 +204,6 @@ systems = scm_list_tail (systems, line_count); } ret = scm_reverse (ret); - - if (to_boolean (book_->paper_->c_variable ("write-page-layout"))) - scm_apply_1 (write_page_breaks, ret, SCM_EOL); return ret; } Index: lily/paper-book.cc =================================================================== RCS file: /cvsroot/lilypond/lilypond/lily/paper-book.cc,v retrieving revision 1.136 diff -u -r1.136 paper-book.cc --- lily/paper-book.cc 24 Sep 2006 06:21:56 -0000 1.136 +++ lily/paper-book.cc 30 Sep 2006 11:54:10 -0000 @@ -394,7 +394,7 @@ return pages_; pages_ = SCM_EOL; - SCM proc = paper_->c_variable ("page-breaking"); + SCM proc = paper_->c_variable ("page-breaking-wrapper"); pages_ = scm_apply_0 (proc, scm_list_1(self_scm ())); /* set systems_ from the pages */ Index: ly/music-functions-init.ly =================================================================== RCS file: /cvsroot/lilypond/lilypond/ly/music-functions-init.ly,v retrieving revision 1.68 diff -u -r1.68 music-functions-init.ly --- ly/music-functions-init.ly 24 Aug 2006 15:40:37 -0000 1.68 +++ ly/music-functions-init.ly 30 Sep 2006 11:54:11 -0000 @@ -370,6 +370,9 @@ (set! (ly:music-property arg 'parenthesize) #t) arg) +%% for lambda* +#(use-modules (ice-9 optargs)) + parallelMusic = #(define-music-function (parser location voice-ids music) (list? ly:music?) "Define parallel music sequences, separated by '|' (bar check signs), @@ -439,7 +442,7 @@ voices) ;; ;; check sequence length - (apply for-each (lambda (. seqs) + (apply for-each (lambda* (#:rest seqs) (let ((moment-reference (ly:music-length (car seqs)))) (for-each (lambda (seq moment) (if (not (equal? moment moment-reference)) @@ -500,12 +503,43 @@ (lambda (x) (shift-one-duration-log x dur dots)) arg)) - -%% this is a stub. Write your own to suit the spacing tweak output. spacingTweaks = #(define-music-function (parser location parameters) (list?) + "Set the system stretch, by reading the 'system-stretch property of + the `parameters' assoc list." + #{ + \overrideProperty #"Score.NonMusicalPaperColumn" + #'line-break-system-details + #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters)))) + #}) + +%% Parser used to read page-layout file, and then retreive score tweaks. +#(define page-layout-parser #f) + +includePageLayoutFile = +#(define-music-function (parser location) () + "If page breaks and tweak dump is not asked, and the file + -page-layout.ly exists, include it." + (if (not (ly:get-option 'dump-tweaks)) + (let ((tweak-filename (format #f "~a-page-layout.ly" + (ly:parser-output-name parser)))) + (if (access? tweak-filename R_OK) + (begin + (ly:message "Including tweak file ~a" tweak-filename) + (set! page-layout-parser (ly:clone-parser parser)) + (ly:parser-parse-file page-layout-parser tweak-filename))))) (make-music 'SequentialMusic 'void #t)) +scoreTweak = +#(define-music-function (parser location name) (string?) + "Include the score tweak, if exists." + (if (and page-layout-parser (not (ly:get-option 'dump-tweaks))) + (let ((tweak-music (ly:parser-lookup page-layout-parser + (string->symbol name)))) + (if (ly:music? tweak-music) + tweak-music + (make-music 'SequentialMusic))) + (make-music 'SequentialMusic))) transposedCueDuring = #(define-music-function Index: ly/paper-defaults.ly =================================================================== RCS file: /cvsroot/lilypond/lilypond/ly/paper-defaults.ly,v retrieving revision 1.27 diff -u -r1.27 paper-defaults.ly --- ly/paper-defaults.ly 4 Sep 2006 05:31:28 -0000 1.27 +++ ly/paper-defaults.ly 30 Sep 2006 11:54:11 -0000 @@ -97,6 +97,17 @@ (word-space . 0.6))) #(define page-breaking ly:optimal-breaking) + #(define page-breaking-wrapper page-breaking-wrapper) + #(define page-post-process post-process-pages) + + #(define write-page-layout (ly:get-option 'dump-tweaks)) + #(define system-maximum-stretch-procedure + (lambda (line) + (if (stretchable-line? line) + (let ((height (line-height line))) + (/ (* height height) 80.0)) + 0.0))) + % #(define page-music-height default-page-music-height ) % #(define page-make-stencil default-page-make-stencil ) Index: scm/layout-page-dump.scm =================================================================== RCS file: /cvsroot/lilypond/lilypond/scm/layout-page-dump.scm,v retrieving revision 1.2 diff -u -r1.2 layout-page-dump.scm --- scm/layout-page-dump.scm 17 Sep 2006 07:45:56 -0000 1.2 +++ scm/layout-page-dump.scm 30 Sep 2006 11:54:12 -0000 @@ -3,51 +3,52 @@ ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 2006 Han-Wen Nienhuys +;;;; 2006 Nicolas Sceaux (define-module (scm layout-page-dump) #:use-module (srfi srfi-1) #:use-module (ice-9 pretty-print) #:use-module (scm paper-system) #:use-module (scm page) + #:use-module (scm layout-page-layout) #:use-module (lily) #:export (write-page-breaks - ;; utilisties for writing other page dump functions - record-tweaks dump-all-tweaks)) - + ;; utilisties for writing other page dump functions + record-tweaks dump-all-tweaks)) (define (record-tweaks what property-pairs tweaks) (let ((key (ly:output-def-lookup (ly:grob-layout what) - 'tweak-key - "tweaks")) - (when (ly:grob-property what 'when))) + 'tweak-key + "tweaks")) + (when (ly:grob-property what 'when))) (if (not (hash-ref tweaks key)) - (hash-set! tweaks key '())) + (hash-set! tweaks key '())) (hash-set! tweaks key - (acons when property-pairs - (hash-ref 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)) + (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 "\\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)) + (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) @@ -61,21 +62,21 @@ (lambda () (pretty-print (assoc-get 'spacing-parameters - these-tweaks '())))))) + 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))))) + (format out-port "~a\n~a\n" skip base) + (dump-tweaks out-port (cdr tweak-list) (graceless-moment now))))) (define (dump-all-tweaks pages 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) + (parser (ly:output-def-parser paper)) + (name (format "~a-page-layout.ly" + (ly:parser-output-name parser))) + (out-port (open-output-file name))) + (ly:message "Writing page layout to ~a" name) (hash-for-each (lambda (key val) (format out-port "~a = {" key) @@ -84,35 +85,64 @@ tweaks) (close-port out-port))) -(define (write-page-breaks pages) - "Dump page breaks" - (let ((tweaks (make-hash-table 23))) +(define (write-page-breaks pages) + "Dump page breaks and tweaks" + (let ((tweaks (make-hash-table 60))) (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-tweaks (ly:spanner-bound (ly:prob-property sys 'system-grob) LEFT) - props - tweaks)) - (set! index (1+ index)))) - (for-each handle-system (page-lines page))) + "Computes vertical stretch for each music line of `page' (starting by + the smallest lines), then record the tweak parameters of each line to + the `tweaks' hash-table." + (let* ((lines (page-property page 'lines)) + (line-count (length lines)) + (compute-max-stretch (ly:output-def-lookup + (ly:paper-book-paper (page-property page + 'paper-book)) + 'system-maximum-stretch-procedure)) + (page-number (page-property page 'page-number))) + (let set-line-stretch! ((sorted-lines (sort lines + (lambda (l1 l2) + (< (line-height l1) + (line-height l2))))) + (rest-height ;; sum of stretchable line heights + (reduce + 0.0 + (map line-height + (filter stretchable-line? lines)))) + (space-left (page-maximum-space-left page))) + (if (not (null? sorted-lines)) + (let* ((line (first sorted-lines)) + (height (line-height line)) + (stretch (min (compute-max-stretch line) + (if (and (stretchable-line? line) + (positive? rest-height)) + (/ (* height space-left) rest-height) + 0.0)))) + (set! (ly:prob-property line 'stretch) stretch) + (set-line-stretch! (cdr sorted-lines) + (if (stretchable-line? line) + (- rest-height height) + rest-height) + (- space-left stretch))))) + (let record-line-tweak ((lines lines) + (is-first-line #t) + (index 0)) + (if (not (null? lines)) + (let ((line (first lines))) + (if (not (ly:prob-property? line 'is-title)) + (record-tweaks + (ly:spanner-bound (ly:prob-property line 'system-grob) LEFT) + `((line-break . #t) + (page-break . ,is-first-line) + (spacing-parameters + . ((page-number . ,page-number) + (system-index . ,index) + (system-stretch . ,(ly:prob-property line 'stretch)) + (system-Y-extent . ,(paper-system-extent line Y)) + (system-refpoint-Y-extent . ,(paper-system-staff-extents line)) + (page-system-count . ,line-count) + (page-printable-height . ,(page-printable-height page)) + (page-space-left . ,(page-property page 'space-left))))) + tweaks)) + (record-line-tweak (cdr lines) #f (1+ index))))))) + ;; Compute tweaks for each page, then dump them to the page-layout file (for-each handle-page pages) (dump-all-tweaks pages tweaks))) Index: scm/layout-page-layout.scm =================================================================== RCS file: /cvsroot/lilypond/lilypond/scm/layout-page-layout.scm,v retrieving revision 1.22 diff -u -r1.22 layout-page-layout.scm --- scm/layout-page-layout.scm 17 Sep 2006 07:45:56 -0000 1.22 +++ scm/layout-page-layout.scm 30 Sep 2006 11:54:12 -0000 @@ -14,20 +14,37 @@ #: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-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)) + 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)) (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))) ;;; ;;; 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." @@ -94,6 +111,26 @@ ;; 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' @@ -105,6 +142,23 @@ '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 ;;; @@ -195,7 +249,7 @@ (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 +366,4 @@ "\nconfigs " (map page-configuration break-nodes))))) ;; construct page stencils. (for-each page-stencil break-nodes) - (post-process-pages paper break-nodes) break-nodes))) Index: scm/lily.scm =================================================================== RCS file: /cvsroot/lilypond/lilypond/scm/lily.scm,v retrieving revision 1.406 diff -u -r1.406 lily.scm --- scm/lily.scm 21 Sep 2006 00:19:07 -0000 1.406 +++ scm/lily.scm 30 Sep 2006 11:54:12 -0000 @@ -25,6 +25,7 @@ (delete-intermediate-files #f "delete unusable PostScript files") (dump-signatures #f "dump output signatures of each system") + (dump-tweaks #f "dump page layout and tweaks for each score having the tweak-key layout property set.") (gs-load-fonts #f "load fonts via Ghostscript.") (include-book-title-preview #t "include book-titles in preview images.")