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