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@xs4all.nl>
   6 ;;;;     2006 Nicolas Sceaux <nicolas.sceaux@free.fr>
   7
   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)
  14   #:use-module (lily)
  15   #:export (write-page-breaks
  16             ;; utilisties for writing other page dump functions
  17             record-tweaks dump-all-tweaks))
  18
  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))))))
  25
  26 (define (record-tweaks what property-pairs tweaks)
  27   (let ((key (ly:output-def-lookup (ly:grob-layout what)
  28                                    'tweak-key
  29                                    "tweaks"))
  30         (when (ly:grob-property what 'when)))
  31     (if (not (hash-ref tweaks key))
  32         (hash-set! tweaks key '()))
  33     (hash-set! tweaks key
  34                (acons when property-pairs
  35                       (hash-ref tweaks key)))))
  36
  37 (define (graceless-moment mom)
  38   (ly:make-moment (ly:moment-main-numerator mom)
  39                   (ly:moment-main-denominator mom)
  40                   0 0))
  41
  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))
  47                     ""))
  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))
  52                    "")))
  53     (format "~a~a" main grace)))
  54
  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)
  62                                  "\\break\n"
  63                                  ""))
  64              (page-break-str (if (assoc-get 'page-break these-tweaks #f)
  65                                  "\\pageBreak\n"
  66                                  ""))
  67              (space-tweaks (format "\\spacingTweaks #'~a\n"
  68                                    (with-output-to-string
  69                                      (lambda ()
  70                                        (pretty-print
  71                                         (assoc-get 'spacing-parameters
  72                                                    these-tweaks '()))))))
  73              (base (format "~a~a~a"
  74                            line-break-str
  75                            page-break-str
  76                            space-tweaks)))
  77         (format out-port "~a\n~a\n" skip base)
  78         (dump-tweaks out-port (cdr tweak-list) (graceless-moment now)))))
  79
  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)))
  84
  85     (ly:message "Writing page layout to ~a" name)
  86     (hash-for-each
  87      (lambda (key val)
  88        (format out-port "~a = {" key)
  89        (dump-tweaks out-port (reverse val) (ly:make-moment 0 1))
  90        (display "}" out-port))
  91      tweaks)
  92     (close-port out-port)))
  93
  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
 105                                                                        'paper-book))
 106                                     'system-maximum-stretch-procedure))
 107              (page-number (page-property page 'page-number)))
 108         (let set-line-stretch! ((sorted-lines (sort lines
 109                                                     (lambda (l1 l2)
 110                                                       (< (line-height l1)
 111                                                          (line-height l2)))))
 112                                 (rest-height ;; sum of stretchable line heights
 113                                  (reduce + 0.0
 114                                          (map line-height
 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)
 124                                        0.0))))
 125                 (set! (ly:prob-property line 'stretch) stretch)
 126                 (set-line-stretch! (cdr sorted-lines)
 127                                    (if (stretchable-line? line)
 128                                        (- rest-height height)
 129                                        rest-height)
 130                                    (- space-left stretch)))))
 131         (let record-line-tweak ((lines lines)
 132                                 (is-first-line #t)
 133                                 (index 0))
 134           (if (not (null? lines))
 135               (let ((line (first lines)))
 136                 (if (not (ly:prob-property? line 'is-title))
 137                     (record-tweaks
 138                      (ly:spanner-bound (ly:prob-property line 'system-grob) LEFT)
 139                      `((line-break . #t)
 140                        (page-break . ,is-first-line)
 141                        (spacing-parameters
 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)))))
 150                      tweaks))
 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)))