X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flayout-page-dump.scm;h=8237106f063ff967f447d05ae27cde2dd41a307b;hb=2e613f5d4d7232507698d3a717576f46920a988b;hp=151c30c4dfaafea88e29dab5218b7aa715fd5b1a;hpb=9ef42dd3755b24588ebb762b7da14af028697c28;p=lilypond.git diff --git a/scm/layout-page-dump.scm b/scm/layout-page-dump.scm index 151c30c4df..8237106f06 100644 --- a/scm/layout-page-dump.scm +++ b/scm/layout-page-dump.scm @@ -2,50 +2,53 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2006 Han-Wen Nienhuys +;;;; (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)) - + #:export (write-page-breaks + ;; 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) @@ -59,21 +62,20 @@ (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) +(define (dump-all-tweaks pages tweaks output-name) + (let* ((paper (ly:paper-book-paper (page-property (car pages) 'paper-book))) + (name (format "~a-page-layout.ly" output-name)) + (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) @@ -82,35 +84,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 output-name) + "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))) + (dump-all-tweaks pages tweaks output-name)))