scm/framework-tex.scm

   1 (define-module (scm framework-tex))
   2
   3 (use-modules (ice-9 regex)
   4              (ice-9 string-fun)
   5              (ice-9 format)
   6              (guile)
   7              (srfi srfi-13)
   8              (scm output-tex)
   9              (lily))
  10
  11
  12 (define (define-fonts bookpaper)
  13   (string-append
  14    "\\def\\lilypondpaperunit{mm}" ;; UGH. FIXME.
  15    (tex-number-def "lilypondpaper" 'outputscale
  16                    (number->string (exact->inexact
  17                                     (ly:bookpaper-outputscale bookpaper))))
  18    (tex-string-def "lilypondpapersize" 'papersize
  19                    (eval 'papersize (ly:output-def-scope bookpaper)))
  20
  21    (apply string-append
  22           (map (lambda (x) (font-load-command bookpaper x))
  23                (ly:bookpaper-fonts bookpaper)
  24                ))))
  25
  26 (define-public (header-to-file fn key val)
  27   (set! key (symbol->string key))
  28   (if (not (equal? "-" fn))
  29       (set! fn (string-append fn "." key))
  30       )
  31   (display
  32    (format "Writing header field `~a' to `~a'..."
  33            key
  34            (if (equal? "-" fn) "<stdout>" fn)
  35            )
  36    (current-error-port))
  37   (if (equal? fn "-")
  38       (display val)
  39       (display val (open-file fn "w"))
  40   )
  41   (display "\n" (current-error-port))
  42   "" )
  43
  44
  45 (define (output-scopes  scopes fields basename)
  46   (define (output-scope scope)
  47     (apply
  48      string-append
  49      (module-map
  50       (lambda (sym var)
  51        (let ((val (if (variable-bound? var) (variable-ref var) ""))
  52              )
  53
  54          (if (and (memq sym fields) (string? val))
  55              (header-to-file basename sym val))
  56          ""))
  57      scope)))
  58
  59   (apply string-append
  60          (map output-scope scopes)))
  61
  62
  63 (define (tex-string-def prefix key str)
  64   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
  65       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
  66       (string-append "\\def\\" prefix (symbol->tex-key key)
  67                      "{" (sanitize-tex-string str) "}%\n")))
  68
  69 (define (header creator time-stamp bookpaper page-count classic?)
  70   (let*
  71       ((scale (ly:output-def-lookup bookpaper 'outputscale)))
  72
  73   (string-append
  74    "% Generated by " creator "\n"
  75    "% at " time-stamp "\n"
  76    (if classic?
  77        (tex-string-def "lilypond" 'classic "1")
  78        "")
  79
  80    (tex-string-def  "lilypondpaper" 'linewidth
  81                     (ly:number->string (* scale
  82                                           (ly:output-def-lookup bookpaper 'linewidth))))
  83
  84    (tex-string-def  "lilypondpaper" 'interscoreline
  85                     (ly:number->string
  86                      (* scale
  87                      (ly:output-def-lookup bookpaper 'interscoreline))))
  88    )))
  89
  90 (define (header-end)
  91   (string-append
  92    "\\def\\scaletounit{ "
  93    (number->string (cond
  94                      ((equal? (ly:unit) "mm") (/ 72.0  25.4))
  95                      ((equal? (ly:unit) "pt") (/ 72.0  72.27))
  96                      (else (error "unknown unit" (ly:unit)))
  97                      ))
  98    " mul }%\n"
  99    "\\ifx\\lilypondstart\\undefined\n"
 100    "  \\input lilyponddefs\n"
 101    "\\fi\n"
 102    "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
 103    "\\lilypondstart\n"
 104    "\\lilypondspecial\n"
 105    "\\lilypondpostscript\n"))
 106
 107
 108 (define (dump-page putter page)
 109   (ly:outputter-dump-string
 110    putter
 111    "\n\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
 112    (ly:outputter-dump-stencil putter (ly:page-stencil page))
 113    (ly:outputter-dump-string
 114     putter
 115     (if (ly:page-last? page)
 116         "}\\vss\n}\n\\vfill\n"
 117         "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
 118
 119
 120
 121 (define-public (output-framework-tex outputter book scopes fields basename)
 122   (let*
 123       ((bookpaper  (ly:paper-book-book-paper book))
 124        (pages (ly:paper-book-pages book))
 125        )
 126   (for-each
 127    (lambda (x)
 128      (ly:outputter-dump-string outputter x))
 129    (list
 130     (header  "creator"
 131              "timestamp"
 132              bookpaper
 133              (length pages)
 134              #f
 135              )
 136
 137    (define-fonts bookpaper)
 138    (header-end)))
 139
 140   (for-each
 141    (lambda (page)
 142      (dump-page outputter page))
 143    pages)
 144   (ly:outputter-dump-string outputter "\\lilypondend\n")
 145   ))
 146
 147 (define (dump-line putter line last?)
 148   (ly:outputter-dump-string
 149    putter
 150    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 151                   (ly:number->string (ly:paper-line-extent line Y))
 152                   "}{"))
 153
 154    (ly:outputter-dump-stencil putter (ly:paper-line-stencil line))
 155    (ly:outputter-dump-string
 156     putter
 157     (if last?
 158         "}%\n"
 159         "}\\interscoreline\n"
 160         )) )
 161
 162 (define-public (output-classic-framework-tex outputter book scopes fields basename)
 163   (let*
 164       ((bookpaper  (ly:paper-book-book-paper book))
 165        (lines (ly:paper-book-lines book))
 166        (last-line (car (last-pair lines))))
 167   (for-each
 168    (lambda (x)
 169      (ly:outputter-dump-string outputter x))
 170    (list
 171     (header  "creator"                  ;FIXME
 172              "timestamp"
 173              bookpaper
 174              (length lines)
 175              #f)
 176     "\\def\\lilypondclassic{1}%\n"
 177     (output-scopes scopes fields basename)
 178     (define-fonts bookpaper)
 179     (header-end)))
 180
 181   (for-each
 182    (lambda (line)
 183      (dump-line outputter line (eq? line last-line)))
 184    lines)
 185   (ly:outputter-dump-string outputter "\\lilypondend\n")
 186   ))
 187
 188
 189