scm/framework-tex.scm

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