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