]> git.donarmstrong.com Git - lilypond.git/blob - scm/layout-page-dump.scm
(allfiles): look for .ly rather
[lilypond.git] / scm / layout-page-dump.scm
1 ;;;; layout-page-tweaks.scm -- page breaking and page layout
2 ;;;;
3 ;;;;  source file of the GNU LilyPond music typesetter
4 ;;;;
5 ;;;; (c) 2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
6
7 (define-module (scm layout-page-dump)
8   #:use-module (srfi srfi-1)
9   #:use-module (ice-9 pretty-print)
10   #:use-module (scm paper-system)
11   #:use-module (scm page)
12   #:use-module (lily)
13   #:export (write-page-breaks))
14
15
16 (define (record-tweaks what property-pairs tweaks)
17   (let ((key (ly:output-def-lookup (ly:grob-layout what)
18                                    'tweak-key
19                                    "tweaks"))
20         (when (ly:grob-property what 'when)))
21     (if (not (hash-ref tweaks key))
22         (hash-set! tweaks key '()))
23     (hash-set! tweaks key
24                (acons when property-pairs
25                       (hash-ref tweaks key)))))
26
27 (define (graceless-moment mom)
28   (ly:make-moment (ly:moment-main-numerator mom)
29                   (ly:moment-main-denominator mom)
30                   0 0))
31
32 (define (moment->skip mom)
33   (let ((main (if (> (ly:moment-main-numerator mom) 0)
34                   (format "\\skip 1*~a/~a"
35                           (ly:moment-main-numerator mom)
36                           (ly:moment-main-denominator mom))
37                     ""))
38         (grace (if (< (ly:moment-grace-numerator mom) 0)
39                    (format "\\grace { \\skip 1*~a/~a }"
40                            (- (ly:moment-grace-numerator mom))
41                            (ly:moment-grace-denominator mom))
42                    "")))
43     (format "~a~a" main grace)))
44
45 (define (dump-tweaks out-port tweak-list last-moment)
46   (if (not (null? tweak-list))
47       (let* ((now (caar tweak-list))
48              (diff (ly:moment-sub now last-moment))
49              (these-tweaks (cdar tweak-list))
50              (skip (moment->skip diff))
51              (line-break-str (if (assoc-get 'line-break these-tweaks #f)
52                                  "\\break\n"
53                                  ""))
54              (page-break-str (if (assoc-get 'page-break these-tweaks #f)
55                                  "\\pageBreak\n"
56                                  ""))
57              (space-tweaks (format "\\spacingTweaks #'~a\n"
58                                    (with-output-to-string
59                                      (lambda ()
60                                        (pretty-print
61                                         (assoc-get 'spacing-parameters
62                                                    these-tweaks '()))))))
63              (base (format "~a~a~a"
64                            line-break-str
65                            page-break-str
66                            space-tweaks)))
67         (format out-port "~a\n~a\n" skip base)
68         (dump-tweaks out-port (cdr tweak-list) (graceless-moment now)))))
69
70 (define (dump-all-tweaks pages tweaks)
71   (let* ((paper (ly:paper-book-paper (page-property  (car pages) 'paper-book)))
72          (parser (ly:output-def-parser paper))
73          (name  (format "~a-page-layout.ly"
74                         (ly:parser-output-name parser)))
75          (out-port (open-output-file name)))
76     (ly:progress "Writing page layout to ~a" name)
77     (hash-for-each
78      (lambda (key val)
79        (format out-port "~a = {" key)
80        (dump-tweaks out-port (reverse val) (ly:make-moment 0 1))
81        (display "}" out-port))
82      tweaks)
83     (close-port out-port)))
84
85 (define (write-page-breaks pages) 
86   "Dump page breaks"
87   (let ((tweaks (make-hash-table 23)))
88     (define (handle-page page)
89       (define index 0)
90       (define music-system-heights
91         (map-in-order (lambda (sys)
92                         (* -1 (car (paper-system-extent sys Y))))
93                       (remove (lambda (sys)
94                                 (ly:prob-property? sys 'is-title))
95                               (page-lines page))))
96       (define (handle-system sys)
97         (let* ((props `((line-break . #t)
98                         (spacing-parameters
99                          . ((system-Y-extent . ,(paper-system-extent sys Y))
100                             (system-refpoint-Y-extent . ,(paper-system-staff-extents sys))
101                             (system-index . ,index)
102                             (music-system-heights . ,music-system-heights)
103                             (page-system-count . ,(length (page-lines page)))
104                             (page-printable-height . ,(page-printable-height page)) 
105                             (page-space-left . ,(page-property page 'space-left)))))))
106           (if (equal? (car (page-lines page)) sys)
107               (set! props (cons '(page-break . #t)
108                                 props)))
109           (if (not (ly:prob-property? sys 'is-title))
110               (record-tweaks (ly:spanner-bound (ly:prob-property sys 'system-grob) LEFT)
111                             props
112                             tweaks))
113           (set! index (1+ index))))
114       (for-each handle-system (page-lines page)))
115     (for-each handle-page pages)
116     (dump-all-tweaks pages tweaks)))