+2006-10-01 Nicolas Sceaux <nicolas.sceaux@free.fr>
+
+ * 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-10-01 Joe Neeman <joeneeman@gmail.com>
* lily/page-spacing.cc (compress_lines, uncompress_solution):
Page_breaking::make_pages (vector<vsize> 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 ();
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;
}
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 */
(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),
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))
(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
+ <basename>-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-string page-layout-parser
+ (format #f "\\include \"~a\""
+ 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
(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 )
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; 2006 Nicolas Sceaux <nicolas.sceaux@free.fr>
(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)
(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)
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)))
#: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."
;; 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'
'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
;;;
(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.
"\nconfigs " (map page-configuration break-nodes)))))
;; construct page stencils.
(for-each page-stencil break-nodes)
- (post-process-pages paper break-nodes)
break-nodes)))
(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.")
projects / lilypond.git / commitdiff