scm/framework-tex.scm

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