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