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