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    "\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
 169   (ly:outputter-dump-stencil putter page)
 170   (ly:outputter-dump-string
 171    putter
 172    (if last?
 173        "}\\vss\n}\n\\vfill\n"
 174        "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
 175
 176 (define-public (output-framework outputter book scopes fields basename )
 177   (let* ((bookpaper (ly:paper-book-book-paper book))
 178          (pages (ly:paper-book-pages book))
 179          (last-page (car (last-pair pages)))
 180          )
 181     (for-each
 182      (lambda (x)
 183        (ly:outputter-dump-string outputter x))
 184      (list
 185       (header bookpaper (length pages) #f)
 186       (define-fonts bookpaper)
 187       (header-end)))
 188
 189     (for-each
 190      (lambda (page) (dump-page outputter page (eq? last-page page)))
 191      pages)
 192     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 193
 194 (define (dump-line putter line last?)
 195   (ly:outputter-dump-string
 196    putter
 197    (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
 198                   (ly:number->string (interval-length (ly:paper-system-extent line Y)))
 199                   "}{"))
 200
 201   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
 202   (ly:outputter-dump-string
 203    putter
 204    (if last?
 205        "}%\n"
 206        "}\\interscoreline\n")))
 207
 208 (define-public (output-classic-framework
 209                 outputter book scopes fields basename)
 210   (let* ((bookpaper (ly:paper-book-book-paper book))
 211          (lines (ly:paper-book-systems book))
 212          (last-line (car (last-pair lines))))
 213     (for-each
 214      (lambda (x)
 215        (ly:outputter-dump-string outputter x))
 216      (list
 217       ;;FIXME
 218       (header bookpaper (length lines) #f)
 219       "\\def\\lilypondclassic{1}%\n"
 220       (output-scopes scopes fields basename)
 221       (define-fonts bookpaper)
 222       (header-end)))
 223
 224     (for-each
 225      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
 226     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 227
 228
 229 (define-public (output-preview-framework
 230                 outputter book scopes fields basename )
 231   (let* ((bookpaper (ly:paper-book-book-paper book))
 232          (lines (ly:paper-book-systems book)))
 233     (for-each
 234      (lambda (x)
 235        (ly:outputter-dump-string outputter x))
 236      (list
 237       ;;FIXME
 238       (header bookpaper (length lines) #f)
 239       "\\def\\lilypondclassic{1}%\n"
 240       (output-scopes scopes fields basename)
 241       (define-fonts bookpaper)
 242       (header-end)))
 243
 244     (dump-line outputter (car lines) #t)
 245     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 246
 247
 248 (define-public (convert-to-pdf book name)
 249   (let*
 250       ((defs (ly:paper-book-book-paper book))
 251        (size (ly:output-def-lookup defs 'papersize)))
 252
 253     (postscript->pdf (if (string? size) size "a4")
 254                      (string-append
 255                       (basename name ".tex")
 256                       ".ps")
 257                      )))
 258
 259 (define-public (convert-to-png book name)
 260   (let*
 261       ((defs (ly:paper-book-book-paper book))
 262        (resolution (ly:output-def-lookup defs 'pngresolution)))
 263
 264     (postscript->png
 265      (if (number? resolution) resolution 90)
 266      (string-append (basename name ".tex") ".ps")
 267      )))
 268
 269 (define-public (convert-to-ps book name)
 270   (let*
 271       ((cmd (string-append "dvips -u+ec-mftrace.map -u+lilypond.map -Ppdf "
 272                            (basename name ".tex"))))
 273
 274     (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
 275     (newline (current-error-port))
 276     (system cmd)))
 277
 278 (define-public (convert-to-dvi book name)
 279   (let*
 280       ((cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
 281
 282     (newline (current-error-port))
 283     (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
 284     (newline (current-error-port))
 285
 286     ;; fixme: set in environment?
 287     (if (ly:get-option 'safe)
 288         (set! cmd (string-append "openout_any=p " cmd)))
 289
 290     (system cmd)))
 291
 292 (define-public (convert-to-tex book name)
 293   #t)
 294