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