1 ;;;; layout-page-tweaks.scm -- page breaking and page layout
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 ;;;; 2006 Nicolas Sceaux <nicolas.sceaux@free.fr>
8 (define-module (scm layout-page-dump)
9 #:use-module (srfi srfi-1)
10 #:use-module (ice-9 pretty-print)
11 #:use-module (scm paper-system)
12 #:use-module (scm page)
13 #:use-module (scm layout-page-layout)
15 #:export (write-page-breaks
16 ;; utilisties for writing other page dump functions
17 record-tweaks dump-all-tweaks))
19 (define (stretchable-line? line)
20 "Say whether a system can be stretched."
21 (not (or (ly:prob-property? line 'is-title)
22 (let ((system-extent (paper-system-staff-extents line)))
23 (= (interval-start system-extent)
24 (interval-end system-extent))))))
26 (define (record-tweaks what property-pairs tweaks)
27 (let ((key (ly:output-def-lookup (ly:grob-layout what)
30 (when (ly:grob-property what 'when)))
31 (if (not (hash-ref tweaks key))
32 (hash-set! tweaks key '()))
34 (acons when property-pairs
35 (hash-ref tweaks key)))))
37 (define (graceless-moment mom)
38 (ly:make-moment (ly:moment-main-numerator mom)
39 (ly:moment-main-denominator mom)
42 (define (moment->skip mom)
43 (let ((main (if (> (ly:moment-main-numerator mom) 0)
44 (format "\\skip 1*~a/~a"
45 (ly:moment-main-numerator mom)
46 (ly:moment-main-denominator mom))
48 (grace (if (< (ly:moment-grace-numerator mom) 0)
49 (format "\\grace { \\skip 1*~a/~a }"
50 (- (ly:moment-grace-numerator mom))
51 (ly:moment-grace-denominator mom))
53 (format "~a~a" main grace)))
55 (define (dump-tweaks out-port tweak-list last-moment)
56 (if (not (null? tweak-list))
57 (let* ((now (caar tweak-list))
58 (diff (ly:moment-sub now last-moment))
59 (these-tweaks (cdar tweak-list))
60 (skip (moment->skip diff))
61 (line-break-str (if (assoc-get 'line-break these-tweaks #f)
64 (page-break-str (if (assoc-get 'page-break these-tweaks #f)
67 (space-tweaks (format "\\spacingTweaks #'~a\n"
68 (with-output-to-string
71 (assoc-get 'spacing-parameters
72 these-tweaks '()))))))
73 (base (format "~a~a~a"
77 (format out-port "~a\n~a\n" skip base)
78 (dump-tweaks out-port (cdr tweak-list) (graceless-moment now)))))
80 (define (dump-all-tweaks pages tweaks output-name)
81 (let* ((paper (ly:paper-book-paper (page-property (car pages) 'paper-book)))
82 (name (format "~a-page-layout.ly" output-name))
83 (out-port (open-output-file name)))
85 (ly:message "Writing page layout to ~a" name)
88 (format out-port "~a = {" key)
89 (dump-tweaks out-port (reverse val) (ly:make-moment 0 1))
90 (display "}" out-port))
92 (close-port out-port)))
94 (define (write-page-breaks pages output-name)
95 "Dump page breaks and tweaks"
96 (let ((tweaks (make-hash-table 60)))
97 (define (handle-page page)
98 "Computes vertical stretch for each music line of `page' (starting by
99 the smallest lines), then record the tweak parameters of each line to
100 the `tweaks' hash-table."
101 (let* ((lines (page-property page 'lines))
102 (line-count (length lines))
103 (compute-max-stretch (ly:output-def-lookup
104 (ly:paper-book-paper (page-property page
106 'system-maximum-stretch-procedure))
107 (page-number (page-property page 'page-number)))
108 (let set-line-stretch! ((sorted-lines (sort lines
112 (rest-height ;; sum of stretchable line heights
115 (filter stretchable-line? lines))))
116 (space-left (page-maximum-space-left page)))
117 (if (not (null? sorted-lines))
118 (let* ((line (first sorted-lines))
119 (height (line-height line))
120 (stretch (min (compute-max-stretch line)
121 (if (and (stretchable-line? line)
122 (positive? rest-height))
123 (/ (* height space-left) rest-height)
125 (set! (ly:prob-property line 'stretch) stretch)
126 (set-line-stretch! (cdr sorted-lines)
127 (if (stretchable-line? line)
128 (- rest-height height)
130 (- space-left stretch)))))
131 (let record-line-tweak ((lines lines)
134 (if (not (null? lines))
135 (let ((line (first lines)))
136 (if (not (ly:prob-property? line 'is-title))
138 (ly:spanner-bound (ly:prob-property line 'system-grob) LEFT)
140 (page-break . ,is-first-line)
142 . ((page-number . ,page-number)
143 (system-index . ,index)
144 (system-stretch . ,(ly:prob-property line 'stretch))
145 (system-Y-extent . ,(paper-system-extent line Y))
146 (system-refpoint-Y-extent . ,(paper-system-staff-extents line))
147 (page-system-count . ,line-count)
148 (page-printable-height . ,(page-printable-height page))
149 (page-space-left . ,(page-property page 'space-left)))))
151 (record-line-tweak (cdr lines) #f (1+ index)))))))
152 ;; Compute tweaks for each page, then dump them to the page-layout file
153 (for-each handle-page pages)
154 (dump-all-tweaks pages tweaks output-name)))