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 (use-modules (ice-9 regex)
  12              (ice-9 string-fun)
  13              (ice-9 format)
  14              (guile)
  15              (srfi srfi-13)
  16              (srfi srfi-1)
  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
  28        #f "\\\\"
  29        (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post )
  30        'pre "$\\backslash$" 'post)
  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     (string-append
  54      "\\font\\lilypond" (tex-font-command font) "="
  55      (ly:font-filename font)
  56      " scaled "
  57      (ly:number->string (inexact->exact
  58                          (round (* 1000
  59                                    (ly:font-magnification font)
  60                                    (ly:paper-outputscale paper)))))
  61      "\n"
  62      "\\def\\" (tex-font-command font) "{%\n"
  63      ;; UGH.  Should be handled via alist.
  64      (if (or (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
  65              (not font-encoding))
  66          "  \\lilypondfontencoding{T1}"
  67          "  ")
  68      "\\lilypond" (tex-font-command font)
  69      "}%\n")))
  70
  71 (define (define-fonts paper)
  72   (string-append
  73    ;; UGH. FIXME.
  74    "\\def\\lilypondpaperunit{mm}%\n"
  75    (tex-number-def "lilypondpaper" 'outputscale
  76                    (number->string (exact->inexact
  77                                     (ly:paper-outputscale paper))))
  78    (tex-string-def "lilypondpaper" 'papersize
  79                    (eval 'papersizename (ly:output-def-scope paper)))
  80    ;; paper/layout?
  81    (tex-string-def "lilypondpaper" 'inputencoding
  82                    (eval 'inputencoding (ly:output-def-scope paper)))
  83
  84    (apply string-append
  85           (map (lambda (x) (font-load-command paper x))
  86                (ly:paper-fonts paper)))))
  87
  88 (define (header-to-file fn key val)
  89   (set! key (symbol->string key))
  90   (if (not (equal? "-" fn))
  91       (set! fn (string-append fn "." key)))
  92   (display
  93    (format (_ "Writing header field `~a' to `~a'...")
  94            key
  95            (if (equal? "-" fn) "<stdout>" fn))
  96    (current-error-port))
  97   (if (equal? fn "-")
  98       (display val)
  99       (display val (open-file fn "w")))
 100   (newline (current-error-port))
 101   "")
 102
 103 (define (output-scopes scopes fields basename)
 104   (define (output-scope scope)
 105     (apply
 106      string-append
 107      (module-map
 108       (lambda (sym var)
 109         (let ((val (if (variable-bound? var) (variable-ref var) "")))
 110           (if (and (memq sym fields) (string? val))
 111               (header-to-file basename sym val))
 112           ""))
 113       scope)))
 114   (apply string-append (map output-scope scopes)))
 115
 116 (define (tex-string-def prefix key str)
 117   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
 118       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
 119       (string-append "\\def\\" prefix (symbol->tex-key key)
 120                      "{" (sanitize-tex-string str) "}%\n")))
 121
 122 (define (header paper page-count classic?)
 123   (let ((scale (ly:output-def-lookup paper 'outputscale))
 124         (texpaper (string-append
 125                    (ly:output-def-lookup paper 'papersizename)
 126                    "paper"))
 127         (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
 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 paper 'linewidth))))
 143      "\\def\\lilyponddocumentclassoptions{"
 144      (sanitize-tex-string texpaper)
 145      (if landscape? ",landscape" "")
 146      "}%\n"
 147      (tex-string-def
 148       "lilypondpaper" 'interscoreline
 149       (ly:number->string
 150        (* scale (ly:output-def-lookup paper 'interscoreline)))))))
 151
 152 (define (header-end)
 153   (string-append
 154    "\\def\\scaletounit{ "
 155    (number->string (cond
 156                     ((equal? (ly:unit) "mm") (/ 72.0 25.4))
 157                     ((equal? (ly:unit) "pt") (/ 72.0 72.27))
 158                     (else (error "unknown unit" (ly:unit)))))
 159    " mul }%\n"
 160    "\\ifx\\lilypondstart\\undefined\n"
 161    "  \\input lilyponddefs\n"
 162    "\\fi\n"
 163    "\\lilypondstart\n"
 164    "\\lilypondspecial\n"
 165    "\\lilypondpostscript\n"))
 166
 167 (define (dump-page putter page last? with-extents?)
 168   (ly:outputter-dump-string
 169    putter
 170    (format "\\lybox{~a}{~a}{%\n"
 171            (if with-extents?
 172                (interval-start (ly:stencil-extent page X))
 173                0.0)
 174            (if with-extents?
 175                (- (interval-start (ly:stencil-extent page Y)))
 176                0.0)))
 177   (ly:outputter-dump-stencil putter page)
 178   (ly:outputter-dump-string
 179    putter
 180    (if last?
 181        "}%\n\\vfill\n"
 182        "}%\n\\vfill\n\\lilypondpagebreak\n")))
 183
 184 (define-public (output-framework outputter book scopes fields basename )
 185   (let* ((paper (ly:paper-book-paper book))
 186          (pages (ly:paper-book-pages book))
 187          (last-page (car (last-pair pages)))
 188          (with-extents
 189           (eq? #t (ly:output-def-lookup paper 'dump-extents))))
 190     (for-each
 191      (lambda (x)
 192        (ly:outputter-dump-string outputter x))
 193      (list
 194       (header paper (length pages) #f)
 195       (define-fonts paper)
 196       (header-end)))
 197     (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
 198     (for-each
 199      (lambda (page)
 200        (dump-page outputter page (eq? last-page page) with-extents))
 201      pages)
 202     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 203
 204 (define (dump-line putter line last?)
 205   (ly:outputter-dump-string
 206    putter
 207    (format "\\lybox{~a}{~a}{%\n"
 208            (ly:number->string
 209             (max 0 (interval-end (ly:paper-system-extent line X))))
 210            (ly:number->string
 211             (interval-length (ly:paper-system-extent line Y)))))
 212
 213   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
 214   (ly:outputter-dump-string
 215    putter
 216    (if last?
 217        "}%\n"
 218        "}\\interscoreline\n")))
 219
 220 (define-public (output-classic-framework
 221                 outputter book scopes fields basename)
 222   (let* ((paper (ly:paper-book-paper book))
 223          (lines (ly:paper-book-systems book))
 224          (last-line (car (last-pair lines))))
 225     (for-each
 226      (lambda (x)
 227        (ly:outputter-dump-string outputter x))
 228      (list
 229       ;;FIXME
 230       (header paper (length lines) #f)
 231       "\\def\\lilypondclassic{1}%\n"
 232       (output-scopes scopes fields basename)
 233       (define-fonts paper)
 234       (header-end)))
 235
 236     (for-each
 237      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
 238     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 239
 240 (define-public (output-preview-framework
 241                 outputter book scopes fields basename )
 242   (let* ((paper (ly:paper-book-paper book))
 243          (lines (ly:paper-book-systems book))
 244          (first-notes-index (list-index
 245                              (lambda (s) (not (ly:paper-system-title? s)))
 246                              lines)))
 247
 248     (for-each
 249      (lambda (x)
 250        (ly:outputter-dump-string outputter x))
 251      (list
 252       ;;FIXME
 253       (header paper (length lines) #f)
 254       "\\def\\lilypondclassic{1}%\n"
 255       (output-scopes scopes fields basename)
 256       (define-fonts paper)
 257       (header-end)))
 258
 259     (for-each
 260      (lambda (l)
 261        (dump-line outputter l (not (ly:paper-system-title? l))))
 262      (take lines (1+ first-notes-index)))
 263     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 264
 265 (define-public (convert-to-pdf book name)
 266   (let* ((defs (ly:paper-book-paper book))
 267          (papersizename (ly:output-def-lookup defs 'papersizename)))
 268     (postscript->pdf (if (string? papersizename) papersizename "a4")
 269                      (string-append
 270                       (basename name ".tex")
 271                       ".ps"))))
 272
 273 (define-public (convert-to-png book name)
 274   (let* ((defs (ly:paper-book-paper book))
 275          (resolution (ly:output-def-lookup defs 'pngresolution)))
 276     (postscript->png
 277      (if (number? resolution)
 278          resolution
 279          (ly:get-option 'resolution))
 280      (string-append (basename name ".tex") ".ps"))))
 281
 282 (define-public (convert-to-ps book name)
 283   (let* ((paper (ly:paper-book-paper book))
 284          (preview? (string-contains name ".preview"))
 285
 286          (papersizename (ly:output-def-lookup paper 'papersizename))
 287          (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
 288          (base (basename name ".tex"))
 289          (cmd (string-append "dvips "
 290                              (if preview?
 291                                  " -E "
 292                                  (string-append
 293                                   " -t "
 294
 295                                   ;; careful: papersizename is user-set.
 296                                   (sanitize-command-option papersizename)))
 297
 298                              (if landscape?
 299                                  " -t landscape "
 300                                  " ")
 301                              "  -u+ec-mftrace.map -u+lilypond.map -Ppdf "
 302                              base)))
 303
 304     (let ((ps-name (string-append base ".ps")))
 305       (if (access? ps-name W_OK)
 306           (delete-file ps-name)))
 307     (if (not (ly:get-option 'verbose))
 308         (begin
 309           (format (current-error-port) (_ "Converting to `~a.ps'...") base)
 310           (newline (current-error-port))))
 311     (ly:system cmd)))
 312
 313 (define-public (convert-to-dvi book name)
 314   (let* ((curr-extra-mem
 315           (string->number
 316            (regexp-substitute/global
 317             #f " *%.*\n?"
 318             (ly:kpathsea-expand-variable "$extra_mem_top")
 319             'pre "" 'post)))
 320          (base (basename name ".tex"))
 321          (cmd (string-append
 322                "latex \\\\nonstopmode \\\\input " name)))
 323     (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
 324     (let ((dvi-name (string-append base ".dvi")))
 325       (if (access? dvi-name W_OK)
 326           (delete-file dvi-name)))
 327     (if (not (ly:get-option 'verbose))
 328         (begin
 329           (format (current-error-port) (_ "Converting to `~a.dvi'...") base)
 330           (newline (current-error-port))))
 331
 332     ;; fixme: set in environment?
 333     (if (ly:get-option 'safe)
 334         (set! cmd (string-append "openout_any=p " cmd)))
 335
 336     (ly:system cmd)))
 337
 338 (define-public (convert-to-tex book name)
 339   #t)