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