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 (output-scopes  scopes fields basename)
  29   (define (output-scope scope)
  30     (apply
  31      string-append
  32      (module-map
  33      (lambda (sym var)
  34        (let (;;(val (variable-ref var))
  35              (val (if (variable-bound? var) (variable-ref var) '""))
  36              (tex-key (symbol->string sym)))
  37
  38          (if (and (memq sym fields) (string? val))
  39              (header-to-file basename sym val))
  40
  41          (cond
  42           ((string? val)
  43            (tex-string-def "lilypond" sym val))
  44
  45           ((number? val)                ;why?
  46            (tex-number-def "lilypond" sym
  47                            (if (integer? val)
  48                                (number->string val)
  49                                (number->string (exact->inexact val)))))
  50
  51           (else ""))))
  52      scope)))
  53
  54   (apply string-append
  55          (map output-scope scopes)))
  56 (define (tex-string-def prefix key str)
  57   (if (equal? "" (sans-surrounding-whitespace (output-tex-string str)))
  58       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
  59       (string-append "\\def\\" prefix (symbol->tex-key key)
  60                      "{" (output-tex-string str) "}%\n")))
  61
  62 (define (header creator time-stamp bookpaper page-count classic?)
  63   (string-append
  64    "% Generated by " creator "\n"
  65    "% at " time-stamp "\n"
  66    (if classic?
  67        (tex-string-def "lilypond" 'classic "1")
  68        "")
  69    ;; FIXME: duplicated in every backend
  70    "\\def\\lilypondtagline{Engraved by LilyPond (version "
  71    (lilypond-version)")}\n"
  72
  73    ;; FIXME
  74    ;; this is -of course- severely broken, (--hwn)
  75    (tex-string-def  "lilypondpaper" 'linewidth
  76                     (ly:number->string (/ 18 0.175))) ; 18 cm.
  77    (tex-string-def  "lilypondpaper" 'interscoreline
  78                     (ly:number->string 0.0))
  79    ))
  80
  81 (define (header-end)
  82   (string-append
  83    "\\def\\scaletounit{ "
  84    (number->string (cond
  85                      ((equal? (ly:unit) "mm") (/ 72.0  25.4))
  86                      ((equal? (ly:unit) "pt") (/ 72.0  72.27))
  87                      (else (error "unknown unit" (ly:unit)))
  88                      ))
  89    " mul }%\n"
  90    "\\ifx\\lilypondstart\\undefined\n"
  91    "  \\input lilyponddefs\n"
  92    "\\fi\n"
  93    "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
  94    "\\lilypondstart\n"
  95    "\\lilypondspecial\n"
  96    "\\lilypondpostscript\n"))
  97
  98
  99 (define (dump-page putter page)
 100   (ly:outputter-dump-string
 101    putter
 102    "\n\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
 103    (ly:outputter-dump-stencil putter (ly:page-stencil page))
 104    (ly:outputter-dump-string
 105     putter
 106     (if (ly:page-last? page)
 107         "}\\vss\n}\n\\vfill\n"
 108         "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
 109
 110
 111 (define (dump-line putter line last?)
 112   (ly:outputter-dump-string
 113    putter
 114    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 115                   (ly:number->string (ly:paper-line-height line))
 116                   "}{"))
 117
 118    (ly:outputter-dump-stencil putter (ly:paper-line-stencil line))
 119    (ly:outputter-dump-string
 120     putter
 121     (if last?
 122         "}\\interscoreline\n"
 123         "}%\n"))
 124    )
 125
 126 ;; todo: only pass BOOK, FIELDS arguments
 127 (define-public (output-framework-tex outputter book scopes fields basename)
 128   (let*
 129       ((bookpaper  (ly:paper-book-book-paper book))
 130        (pages (ly:paper-book-pages book))
 131        )
 132   (for-each
 133    (lambda (x)
 134      (ly:outputter-dump-string outputter x))
 135    (list
 136     (header  "creator"
 137              "timestamp"
 138              bookpaper
 139              (length pages)
 140              #f
 141              )
 142
 143    (output-scopes scopes fields basename)
 144    (define-fonts bookpaper)
 145    (header-end)))
 146
 147   (for-each
 148    (lambda (page)
 149      (dump-page outputter page))
 150    pages)
 151   (ly:outputter-dump-string outputter "\\lilypondend\n")
 152   ))
 153
 154 (define-public (output-classic-framework-tex outputter book scopes fields basename)
 155   (let*
 156       ((bookpaper  (ly:paper-book-book-paper book))
 157        (lines (ly:paper-book-lines book))
 158        (last-line (car (last-pair lines))))
 159   (for-each
 160    (lambda (x)
 161      (ly:outputter-dump-string outputter x))
 162    (list
 163     (header  "creator"
 164              "timestamp"
 165              bookpaper
 166              (length lines)
 167              #f)
 168
 169    (output-scopes scopes fields basename)
 170    (define-fonts bookpaper)
 171    (header-end)))
 172
 173   (for-each
 174    (lambda (line)
 175      (dump-line outputter line (eq? line last-line)))
 176    lines)
 177   (ly:outputter-dump-string outputter "\\lilypondend\n")
 178   ))
 179
 180
 181