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 ;; FIXME: rename
  20 ;; what is bla supposed to do?  It breaks the default output terribly:
  21
  22 ;; \def\lilypondpaperbla$\backslash${$\backslash$}{bla$\backslash${$\backslash$}}%
  23 ;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
  24 ;; --jcn
  25 (define-public (sanitize-tex-string s)
  26    (if (ly:get-option 'safe)
  27       (regexp-substitute/global #f "\\\\"
  28                                 (regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
  29                                 'pre "$\\backslash$" 'post)
  30
  31       s))
  32
  33 (define (symbol->tex-key sym)
  34   (regexp-substitute/global
  35    #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
  36
  37 (define (tex-number-def prefix key number)
  38   (string-append
  39    "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
  40
  41 (define-public (tex-font-command font)
  42   (string-append
  43    "magfont"
  44    (string-encode-integer
  45     (hashq (ly:font-filename font) 1000000))
  46    "m"
  47    (string-encode-integer
  48     (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
  49
  50 (define (font-load-command bookpaper font)
  51   (let* ((coding-alist (ly:font-encoding-alist font))
  52          (font-encoding (assoc-get 'output-name coding-alist))
  53          )
  54     (string-append
  55      "\\font\\lilypond" (tex-font-command font) "="
  56      (ly:font-filename font)
  57      " scaled "
  58      (ly:number->string (inexact->exact
  59                          (round (* 1000
  60                                    (ly:font-magnification font)
  61                                    (ly:bookpaper-outputscale bookpaper)))))
  62      "\n"
  63      "\\def\\" (tex-font-command font) "{%\n"
  64      ;; UGH.  Should be handled via alist.
  65      (if (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
  66          "  \\fontencoding{T1}\\selectfont"
  67          "  ")
  68      "\\lilypond" (tex-font-command font)
  69      "}\n"
  70      )))
  71
  72
  73 (define (define-fonts bookpaper)
  74   (string-append
  75    ;; UGH. FIXME.
  76    "\\def\\lilypondpaperunit{mm}\n"
  77    (tex-number-def "lilypondpaper" 'outputscale
  78                    (number->string (exact->inexact
  79                                     (ly:bookpaper-outputscale bookpaper))))
  80    (tex-string-def "lilypondpaper" 'papersize
  81                    (eval 'papersize (ly:output-def-scope bookpaper)))
  82    (tex-string-def "lilypondpaper" 'inputencoding
  83                    (eval 'inputencoding (ly:output-def-scope bookpaper)))
  84
  85    (apply string-append
  86           (map (lambda (x) (font-load-command bookpaper x))
  87                (ly:bookpaper-fonts bookpaper)))))
  88
  89 (define (header-to-file fn key val)
  90   (set! key (symbol->string key))
  91   (if (not (equal? "-" fn))
  92       (set! fn (string-append fn "." key)))
  93   (display
  94    (format (_ "Writing header field `~a' to `~a'...")
  95            key
  96            (if (equal? "-" fn) "<stdout>" fn))
  97    (current-error-port))
  98   (if (equal? fn "-")
  99       (display val)
 100       (display val (open-file fn "w")))
 101   (newline (current-error-port))
 102   "")
 103
 104 (define (output-scopes  scopes fields basename)
 105   (define (output-scope scope)
 106     (apply
 107      string-append
 108      (module-map
 109       (lambda (sym var)
 110         (let ((val (if (variable-bound? var) (variable-ref var) ""))
 111               )
 112
 113           (if (and (memq sym fields) (string? val))
 114               (header-to-file basename sym val))
 115           ""))
 116       scope)))
 117   (apply string-append (map output-scope scopes)))
 118
 119 (define (tex-string-def prefix key str)
 120   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
 121       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
 122       (string-append "\\def\\" prefix (symbol->tex-key key)
 123                      "{" (sanitize-tex-string str) "}%\n")))
 124
 125 (define (header bookpaper page-count classic?)
 126   (let ((scale (ly:output-def-lookup bookpaper 'outputscale)))
 127
 128     (string-append
 129      "% Generated by LilyPond "
 130      (lilypond-version) "\n"
 131      "% at " "time-stamp,FIXME" "\n"
 132      (if classic?
 133          (tex-string-def "lilypond" 'classic "1")
 134          "")
 135
 136      (if (ly:get-option 'safe)
 137          "\\nofiles\n"
 138          "")
 139
 140      (tex-string-def
 141       "lilypondpaper" 'linewidth
 142       (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth))))
 143
 144      (tex-string-def
 145       "lilypondpaper" 'interscoreline
 146       (ly:number->string
 147        (* scale (ly:output-def-lookup bookpaper 'interscoreline)))))))
 148
 149 (define (header-end)
 150   (string-append
 151    "\\def\\scaletounit{ "
 152    (number->string (cond
 153                     ((equal? (ly:unit) "mm") (/ 72.0 25.4))
 154                     ((equal? (ly:unit) "pt") (/ 72.0 72.27))
 155                     (else (error "unknown unit" (ly:unit)))))
 156    " mul }%\n"
 157    "\\ifx\\lilypondstart\\undefined\n"
 158    "  \\input lilyponddefs\n"
 159    "\\fi\n"
 160    "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
 161    "\\lilypondstart\n"
 162    "\\lilypondspecial\n"
 163    "\\lilypondpostscript\n"))
 164
 165 (define (dump-page putter page last?)
 166   (ly:outputter-dump-string
 167    putter
 168    (format "\\vbox to ~a\\outputscale{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n"
 169            (interval-length (ly:stencil-extent page Y))
 170            ))
 171   (ly:outputter-dump-stencil putter page)
 172   (ly:outputter-dump-string
 173    putter
 174    (if last?
 175        "}\\vss\n}\n\\vfill\n"
 176        "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
 177
 178 (define-public (output-framework outputter book scopes fields basename )
 179   (let* ((bookpaper (ly:paper-book-book-paper book))
 180          (pages (ly:paper-book-pages book))
 181          (last-page (car (last-pair pages)))
 182          )
 183     (for-each
 184      (lambda (x)
 185        (ly:outputter-dump-string outputter x))
 186      (list
 187       (header bookpaper (length pages) #f)
 188       (define-fonts bookpaper)
 189       (header-end)))
 190
 191     (for-each
 192      (lambda (page) (dump-page outputter page (eq? last-page page)))
 193      pages)
 194     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 195
 196 (define (dump-line putter line last?)
 197   (ly:outputter-dump-string
 198    putter
 199    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 200                   (ly:number->string (interval-length (ly:paper-system-extent line Y)))
 201                   "}{"))
 202
 203   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
 204   (ly:outputter-dump-string
 205    putter
 206    (if last?
 207        "}%\n"
 208        "}\\interscoreline\n")))
 209
 210 (define-public (output-classic-framework
 211                 outputter book scopes fields basename)
 212   (let* ((bookpaper (ly:paper-book-book-paper book))
 213          (lines (ly:paper-book-systems book))
 214          (last-line (car (last-pair lines))))
 215     (for-each
 216      (lambda (x)
 217        (ly:outputter-dump-string outputter x))
 218      (list
 219       ;;FIXME
 220       (header bookpaper (length lines) #f)
 221       "\\def\\lilypondclassic{1}%\n"
 222       (output-scopes scopes fields basename)
 223       (define-fonts bookpaper)
 224       (header-end)))
 225
 226     (for-each
 227      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
 228     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 229
 230
 231 (define-public (output-preview-framework
 232                 outputter book scopes fields basename )
 233   (let* ((bookpaper (ly:paper-book-book-paper book))
 234          (lines (ly:paper-book-systems book)))
 235     (for-each
 236      (lambda (x)
 237        (ly:outputter-dump-string outputter x))
 238      (list
 239       ;;FIXME
 240       (header bookpaper (length lines) #f)
 241       "\\def\\lilypondclassic{1}%\n"
 242       (output-scopes scopes fields basename)
 243       (define-fonts bookpaper)
 244       (header-end)))
 245
 246     (dump-line outputter (car lines) #t)
 247     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 248
 249
 250 (define-public (convert-to-pdf book name)
 251   (let*
 252       ((defs (ly:paper-book-book-paper book))
 253        (size (ly:output-def-lookup defs 'papersize)))
 254
 255     (postscript->pdf (if (string? size) size "a4")
 256                      (string-append
 257                       (basename name ".tex")
 258                       ".ps")
 259                      )))
 260
 261 (define-public (convert-to-png book name)
 262   (let*
 263       ((defs (ly:paper-book-book-paper book))
 264        (resolution (ly:output-def-lookup defs 'pngresolution)))
 265
 266     (postscript->png
 267      (if (number? resolution) resolution 90)
 268      (string-append (basename name ".tex") ".ps")
 269      )))
 270
 271 (define-public (convert-to-ps book name)
 272   (let*
 273       ((cmd (string-append "dvips -u+ec-mftrace.map -u+lilypond.map -Ppdf "
 274                            (basename name ".tex"))))
 275
 276     (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
 277     (newline (current-error-port))
 278     (system cmd)))
 279
 280 (define-public (convert-to-dvi book name)
 281   (let*
 282       ((cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
 283
 284     (newline (current-error-port))
 285     (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
 286     (newline (current-error-port))
 287
 288     ;; fixme: set in environment?
 289     (if (ly:get-option 'safe)
 290         (set! cmd (string-append "openout_any=p " cmd)))
 291
 292     (system cmd)))
 293
 294 (define-public (convert-to-tex book name)
 295   #t)
 296