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   (string-append
  73    "% Generated by " creator "\n"
  74    "% at " time-stamp "\n"
  75    (if classic?
  76        (tex-string-def "lilypond" 'classic "1")
  77        "")
  78    ;; FIXME: duplicated in every backend
  79    "\\def\\lilypondtagline{Engraved by LilyPond (version "
  80    (lilypond-version)")}\n"
  81
  82    ;; FIXME
  83    ;; this is -of course- severely broken, (--hwn)
  84    (tex-string-def  "lilypondpaper" 'linewidth
  85                     (ly:number->string (/ 18 0.175))) ; 18 cm.
  86    (tex-string-def  "lilypondpaper" 'interscoreline
  87                     (ly:number->string 0.0))
  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 (define (dump-line putter line last?)
 121   (ly:outputter-dump-string
 122    putter
 123    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 124                   (ly:number->string (ly:paper-line-extent line Y))
 125                   "}{"))
 126
 127    (ly:outputter-dump-stencil putter (ly:paper-line-stencil line))
 128    (ly:outputter-dump-string
 129     putter
 130     (if last?
 131         "}%\n"
 132         "}\\interscoreline\n"
 133         )) )
 134
 135 (define-public (output-framework-tex outputter book scopes fields basename)
 136   (let*
 137       ((bookpaper  (ly:paper-book-book-paper book))
 138        (pages (ly:paper-book-pages book))
 139        )
 140   (for-each
 141    (lambda (x)
 142      (ly:outputter-dump-string outputter x))
 143    (list
 144     (header  "creator"
 145              "timestamp"
 146              bookpaper
 147              (length pages)
 148              #f
 149              )
 150
 151    (define-fonts bookpaper)
 152    (header-end)))
 153
 154   (for-each
 155    (lambda (page)
 156      (dump-page outputter page))
 157    pages)
 158   (ly:outputter-dump-string outputter "\\lilypondend\n")
 159   ))
 160
 161 (define-public (output-classic-framework-tex outputter book scopes fields basename)
 162   (let*
 163       ((bookpaper  (ly:paper-book-book-paper book))
 164        (lines (ly:paper-book-lines book))
 165        (last-line (car (last-pair lines))))
 166   (for-each
 167    (lambda (x)
 168      (ly:outputter-dump-string outputter x))
 169    (list
 170     (header  "creator"                  ;FIXME
 171              "timestamp"
 172              bookpaper
 173              (length lines)
 174              #f)
 175     "\\def\\lilypondclassic{1}%\n"
 176     (output-scopes scopes fields basename)
 177     (define-fonts bookpaper)
 178     (header-end)))
 179
 180   (for-each
 181    (lambda (line)
 182      (dump-line outputter line (eq? line last-line)))
 183    lines)
 184   (ly:outputter-dump-string outputter "\\lilypondend\n")
 185   ))
 186
 187
 188