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 bookpaper page-count classic?)
 107   (let ((scale (ly:output-def-lookup bookpaper 'outputscale)))
 108
 109     (string-append
 110      "% Generated by LilyPond "
 111      (lilypond-version) "\n"
 112      "% at " "time-stamp,FIXME" "\n"
 113      (if classic?
 114          (tex-string-def "lilypond" 'classic "1")
 115          "")
 116
 117      (tex-string-def
 118       "lilypondpaper" 'linewidth
 119       (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth))))
 120
 121      (tex-string-def
 122       "lilypondpaper" 'interscoreline
 123       (ly:number->string
 124        (* scale (ly:output-def-lookup bookpaper 'interscoreline)))))))
 125
 126 (define (header-end)
 127   (string-append
 128    "\\def\\scaletounit{ "
 129    (number->string (cond
 130                     ((equal? (ly:unit) "mm") (/ 72.0 25.4))
 131                     ((equal? (ly:unit) "pt") (/ 72.0 72.27))
 132                     (else (error "unknown unit" (ly:unit)))))
 133    " mul }%\n"
 134    "\\ifx\\lilypondstart\\undefined\n"
 135    "  \\input lilyponddefs\n"
 136    "\\fi\n"
 137    "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
 138    "\\lilypondstart\n"
 139    "\\lilypondspecial\n"
 140    "\\lilypondpostscript\n"))
 141
 142 (define (dump-page putter page last?)
 143   (ly:outputter-dump-string
 144    putter
 145    "\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
 146   (ly:outputter-dump-stencil putter page)
 147   (ly:outputter-dump-string
 148    putter
 149    (if last?
 150        "}\\vss\n}\n\\vfill\n"
 151        "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
 152
 153 (define-public (output-framework outputter book scopes fields basename )
 154   (let* ((bookpaper (ly:paper-book-book-paper book))
 155          (pages (ly:paper-book-pages book))
 156          (last-page (car (last-pair pages)))
 157          )
 158     (for-each
 159      (lambda (x)
 160        (ly:outputter-dump-string outputter x))
 161      (list
 162       (header bookpaper (length pages) #f)
 163       (define-fonts bookpaper)
 164       (header-end)))
 165
 166     (for-each
 167      (lambda (page) (dump-page outputter page (eq? last-page page)))
 168      pages)
 169     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 170
 171 (define (dump-line putter line last?)
 172   (ly:outputter-dump-string
 173    putter
 174    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 175                   (ly:number->string (interval-length (ly:paper-system-extent line Y)))
 176                   "}{"))
 177
 178   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
 179   (ly:outputter-dump-string
 180    putter
 181    (if last?
 182        "}%\n"
 183        "}\\interscoreline\n")))
 184
 185 (define-public (output-classic-framework
 186                 outputter book scopes fields basename)
 187   (let* ((bookpaper (ly:paper-book-book-paper book))
 188          (lines (ly:paper-book-systems book))
 189          (last-line (car (last-pair lines))))
 190     (for-each
 191      (lambda (x)
 192        (ly:outputter-dump-string outputter x))
 193      (list
 194       ;;FIXME
 195       (header bookpaper (length lines) #f)
 196       "\\def\\lilypondclassic{1}%\n"
 197       (output-scopes scopes fields basename)
 198       (define-fonts bookpaper)
 199       (header-end)))
 200
 201     (for-each
 202      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
 203     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 204
 205
 206 (define-public (output-preview-framework
 207                 outputter book scopes fields basename )
 208   (let* ((bookpaper (ly:paper-book-book-paper book))
 209          (lines (ly:paper-book-systems book)))
 210     (for-each
 211      (lambda (x)
 212        (ly:outputter-dump-string outputter x))
 213      (list
 214       ;;FIXME
 215       (header "creator" "timestamp" bookpaper (length lines) #f)
 216       "\\def\\lilypondclassic{1}%\n"
 217       (output-scopes scopes fields basename)
 218       (define-fonts bookpaper)
 219       (header-end)))
 220
 221     (dump-line outputter (car lines) #t)
 222     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 223
 224
 225 (define-public (convert-to-pdf book name)
 226   (let*
 227       ((defs (ly:paper-book-book-paper book))
 228        (size (ly:output-def-lookup defs 'papersize)))
 229
 230     (postscript->pdf (if (string? size) size "a4")
 231                      (string-append
 232                       (basename name ".tex")
 233                       ".ps")
 234                      )))
 235
 236 (define-public (convert-to-png book name)
 237   (let*
 238       ((defs (ly:paper-book-book-paper book))
 239        (resolution (ly:output-def-lookup defs 'pngresolution)))
 240
 241     (postscript->png
 242      (if (number? resolution) resolution 90)
 243      (string-append (basename name ".tex") ".ps")
 244      )))
 245
 246 (define-public (convert-to-ps book name)
 247   (let*
 248       ((cmd (string-append "dvips -u+ec-mftrace.map -u+lilypond.map -Ppdf " (basename name ".tex"))))
 249
 250     (display (format #f "invoking ~S" cmd))
 251     (system cmd)))
 252
 253 (define-public (convert-to-dvi book name)
 254   (let*
 255       ((cmd (string-append "latex " name)))
 256
 257     (display (format #f "invoking ~S\n" cmd))
 258     (system cmd)))
 259
 260 (define-public (convert-to-tex book name)
 261   #t)
 262