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 "lilypondpaper" '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 last?)
 142   (ly:outputter-dump-string
 143    putter
 144    "\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
 145   (ly:outputter-dump-stencil putter page)
 146   (ly:outputter-dump-string
 147    putter
 148    (if last?
 149        "}\\vss\n}\n\\vfill\n"
 150        "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
 151
 152 (define-public (output-framework outputter book scopes fields basename)
 153   (let* ((bookpaper (ly:paper-book-book-paper book))
 154          (pages (ly:paper-book-pages book))
 155          (last-page (car (last-pair pages)))
 156          )
 157     (for-each
 158      (lambda (x)
 159        (ly:outputter-dump-string outputter x))
 160      (list
 161       (header "creator" "timestamp" bookpaper (length pages) #f)
 162       (define-fonts bookpaper)
 163       (header-end)))
 164
 165     (for-each
 166      (lambda (page) (dump-page outputter page (eq? last-page page)))
 167      pages)
 168     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 169
 170 (define (dump-line putter line last?)
 171   (ly:outputter-dump-string
 172    putter
 173    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 174                   (ly:number->string (ly:paper-system-extent line Y))
 175                   "}{"))
 176
 177   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
 178   (ly:outputter-dump-string
 179    putter
 180    (if last?
 181        "}%\n"
 182        "}\\interscoreline\n")))
 183
 184 (define-public (output-classic-framework
 185                 outputter book scopes fields basename)
 186   (let* ((bookpaper (ly:paper-book-book-paper book))
 187          (lines (ly:paper-book-lines book))
 188          (last-line (car (last-pair lines))))
 189     (for-each
 190      (lambda (x)
 191        (ly:outputter-dump-string outputter x))
 192      (list
 193       ;;FIXME
 194       (header "creator" "timestamp" bookpaper (length lines) #f)
 195       "\\def\\lilypondclassic{1}%\n"
 196       (output-scopes scopes fields basename)
 197       (define-fonts bookpaper)
 198       (header-end)))
 199
 200     (for-each
 201      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
 202     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 203
 204
 205 (define-public (output-preview-framework
 206                 outputter book scopes fields basename)
 207   (let* ((bookpaper (ly:paper-book-book-paper book))
 208          (lines (ly:paper-book-lines book)))
 209     (for-each
 210      (lambda (x)
 211        (ly:outputter-dump-string outputter x))
 212      (list
 213       ;;FIXME
 214       (header "creator" "timestamp" bookpaper (length lines) #f)
 215       "\\def\\lilypondclassic{1}%\n"
 216       (output-scopes scopes fields basename)
 217       (define-fonts bookpaper)
 218       (header-end)))
 219
 220     (dump-line outputter (car lines) #t)
 221     (ly:outputter-dump-string outputter "\\lilypondend\n")))