]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-tex.scm
* scm/framework-tex.scm (dump-page): Add width to \lybox call.
[lilypond.git] / scm / framework-tex.scm
index a1358c9506a0f0992a82bcfa97499599599cacdf..c119578c520303cde030401ffe444d34e7e830dd 100644 (file)
@@ -5,9 +5,8 @@
 ;;;; (c)  2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 (define-module (scm framework-tex)
-  #:export (output-framework-tex           
-           output-classic-framework-tex
-))
+  #:export (output-framework-tex       
+           output-classic-framework-tex))
 
 (use-modules (ice-9 regex)
             (ice-9 string-fun)
 ;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
 ;; --jcn
 (define-public (sanitize-tex-string s)
-   (if (ly:get-option 'safe)
-      (regexp-substitute/global #f "\\\\"
-                               (regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
-                               'pre "$\\backslash$" 'post)
-      
+  (if (ly:get-option 'safe)
+      (regexp-substitute/global
+       #f "\\\\"
+       (regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
+       'pre "$\\backslash$" 'post)
       s))
 
 (define (symbol->tex-key sym)
    (string-encode-integer
     (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
 
-(define (font-load-command bookpaper font)
+(define (font-load-command paper font)
   (let* ((coding-alist (ly:font-encoding-alist font))
-        (font-encoding (assoc-get 'output-name coding-alist))
-        )
+        (font-encoding (assoc-get 'output-name coding-alist)))
     (string-append
      "\\font\\lilypond" (tex-font-command font) "="
      (ly:font-filename font)
      (ly:number->string (inexact->exact
                         (round (* 1000
                                   (ly:font-magnification font)
-                                  (ly:bookpaper-outputscale bookpaper)))))
+                                  (ly:paper-outputscale paper)))))
      "\n"
      "\\def\\" (tex-font-command font) "{%\n"
      ;; UGH.  Should be handled via alist.
      (if (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
-        "  \\fontencoding{T1}\\selectfont"
+        "  \\lilypondfontencoding{T1}"
         "  ")
      "\\lilypond" (tex-font-command font)
-     "}\n"
-     )))
+     "}%\n")))
 
-
-(define (define-fonts bookpaper)
+(define (define-fonts paper)
   (string-append
-   ;; UGH. FIXME.   
-   "\\def\\lilypondpaperunit{mm}\n"
+   ;; UGH. FIXME.
+   "\\def\\lilypondpaperunit{mm}%\n"
    (tex-number-def "lilypondpaper" 'outputscale
                   (number->string (exact->inexact
-                                   (ly:bookpaper-outputscale bookpaper))))
+                                   (ly:paper-outputscale paper))))
    (tex-string-def "lilypondpaper" 'papersize
-                  (eval 'papersize (ly:output-def-scope bookpaper)))
+                  (eval 'papersizename (ly:output-def-scope paper)))
+   ;; paper/layout?
    (tex-string-def "lilypondpaper" 'inputencoding
-                  (eval 'inputencoding (ly:output-def-scope bookpaper)))
+                  (eval 'inputencoding (ly:output-def-scope paper)))
 
    (apply string-append
-         (map (lambda (x) (font-load-command bookpaper x))
-              (ly:bookpaper-fonts bookpaper)))))
+         (map (lambda (x) (font-load-command paper x))
+              (ly:paper-fonts paper)))))
 
 (define (header-to-file fn key val)
   (set! key (symbol->string key))
   (newline (current-error-port))
   "")
 
-(define (output-scopes  scopes fields basename)
+(define (output-scopes scopes fields basename)
   (define (output-scope scope)
     (apply
      string-append
      (module-map
       (lambda (sym var)
-       (let ((val (if (variable-bound? var) (variable-ref var) ""))
-             )
-         
+       (let ((val (if (variable-bound? var) (variable-ref var) "")))
          (if (and (memq sym fields) (string? val))
              (header-to-file basename sym val))
          ""))
       (string-append "\\def\\" prefix (symbol->tex-key key)
                     "{" (sanitize-tex-string str) "}%\n")))
 
-(define (header bookpaper page-count classic?)
-  (let ((scale (ly:output-def-lookup bookpaper 'outputscale)))
-
+(define (header paper page-count classic?)
+  (let ((scale (ly:output-def-lookup paper 'outputscale))
+       (texpaper (string-append
+                  (ly:output-def-lookup paper 'papersizename)
+                  "paper"))
+       (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
     (string-append
      "% Generated by LilyPond "
      (lilypond-version) "\n"
 
      (tex-string-def
       "lilypondpaper" 'linewidth
-      (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth))))
-
+      (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
+     "\\def\\lilyponddocumentclassoptions{"
+     texpaper
+     (if landscape? ",landscape" "")
+     "}%\n"
      (tex-string-def
       "lilypondpaper" 'interscoreline
       (ly:number->string
-       (* scale (ly:output-def-lookup bookpaper 'interscoreline)))))))
+       (* scale (ly:output-def-lookup paper 'interscoreline)))))))
 
 (define (header-end)
   (string-append
    "\\ifx\\lilypondstart\\undefined\n"
    "  \\input lilyponddefs\n"
    "\\fi\n"
-   "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
    "\\lilypondstart\n"
    "\\lilypondspecial\n"
    "\\lilypondpostscript\n"))
 (define (dump-page putter page last? with-extents?)
   (ly:outputter-dump-string
    putter
-   (format "\\vbox to ~a\\outputscale{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n"
+   (format "\\lybox{~a}{~a}{%\n"
+          (if with-extents?
+              (interval-start (ly:stencil-extent page X))
+              0.0)
           (if with-extents?
               (- (interval-start (ly:stencil-extent page Y)))
-                      0.0
-              )))
+              0.0)))
   (ly:outputter-dump-stencil putter page)
   (ly:outputter-dump-string
    putter
    (if last?
-       "}\\vss\n}\n\\vfill\n"
-       "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
+       "}%\n\\vfill\n"
+       "}%\n\\vfill\n\\lilypondpagebreak\n")))
 
 (define-public (output-framework outputter book scopes fields basename )
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+  (let* ((paper (ly:paper-book-paper book))
         (pages (ly:paper-book-pages book))
         (last-page (car (last-pair pages)))
         (with-extents
-         (eq? #t (ly:output-def-lookup bookpaper 'dump-extents)))
-        )
+         (eq? #t (ly:output-def-lookup paper 'dump-extents))))
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
-      (header bookpaper (length pages) #f)
-      (define-fonts bookpaper)
+      (header paper (length pages) #f)
+      (define-fonts paper)
       (header-end)))
-    (ly:outputter-dump-string outputter "\\nopagebreak")
+    (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
     (for-each
-     (lambda (page) (dump-page outputter page (eq? last-page page) with-extents))
+     (lambda (page)
+       (dump-page outputter page (eq? last-page page) with-extents))
      pages)
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
 (define (dump-line putter line last?)
   (ly:outputter-dump-string
    putter
-   (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
-                 (ly:number->string (interval-length (ly:paper-system-extent line Y)))
-                 "}{"))
+   (string-append "\\lybox{"
+                 (ly:number->string
+                  (interval-length (ly:paper-system-extent line X)))
+                 "}{"
+                 (ly:number->string
+                  (interval-length (ly:paper-system-extent line Y)))
+                 "}{%\n"))
 
   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
   (ly:outputter-dump-string
 
 (define-public (output-classic-framework
                outputter book scopes fields basename)
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+  (let* ((paper (ly:paper-book-paper book))
         (lines (ly:paper-book-systems book))
         (last-line (car (last-pair lines))))
     (for-each
        (ly:outputter-dump-string outputter x))
      (list
       ;;FIXME
-      (header bookpaper (length lines) #f)
+      (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
       (output-scopes scopes fields basename)
-      (define-fonts bookpaper)
+      (define-fonts paper)
       (header-end)))
 
     (for-each
      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
-
 (define-public (output-preview-framework
                outputter book scopes fields basename )
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+  (let* ((paper (ly:paper-book-paper book))
         (lines (ly:paper-book-systems book)))
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
       ;;FIXME
-      (header bookpaper (length lines) #f)
+      (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
       (output-scopes scopes fields basename)
-      (define-fonts bookpaper)
+      (define-fonts paper)
       (header-end)))
 
     (dump-line outputter (car lines) #t)
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
-
 (define-public (convert-to-pdf book name)
-  (let*
-      ((defs (ly:paper-book-book-paper book))
-       (size (ly:output-def-lookup defs 'papersize)))
-
-    (postscript->pdf (if (string? size) size "a4")
+  (let* ((defs (ly:paper-book-paper book))
+        (papersizename (ly:output-def-lookup defs 'papersizename)))
+    (postscript->pdf (if (string? papersizename) papersizename "a4")
                     (string-append
                      (basename name ".tex")
-                     ".ps")
-                    )))
+                     ".ps"))))
 
 (define-public (convert-to-png book name)
-  (let*
-      ((defs (ly:paper-book-book-paper book))
-       (resolution (ly:output-def-lookup defs 'pngresolution)))
-
+  (let* ((defs (ly:paper-book-paper book))
+        (resolution (ly:output-def-lookup defs 'pngresolution)))
     (postscript->png
      (if (number? resolution) resolution 90)
-     (string-append (basename name ".tex") ".ps")
-     )))
+     (string-append (basename name ".tex") ".ps"))))
 
 (define-public (convert-to-ps book name)
-  (let*
-      ((cmd (string-append "dvips -u+ec-mftrace.map -u+lilypond.map -Ppdf "
-                          (basename name ".tex"))))
-
+  (let* ((paper (ly:paper-book-paper book))
+        (preview? (string-contains name ".preview"))
+        (papersizename (ly:output-def-lookup paper 'papersizename))
+        (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
+        (cmd (string-append "dvips "
+                            (if preview?
+                                " -E "
+                                (string-append " -t " papersizename))
+                            (if landscape?
+                                " -t landscape "
+                                " ")
+                            "  -u+ec-mftrace.map -u+lilypond.map -Ppdf "
+                            (basename name ".tex"))))
     (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
     (newline (current-error-port))
     (system cmd)))
 
 (define-public (convert-to-dvi book name)
-  (let*
-      ((cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
-
+  (let* ((curr-extra-mem
+         (string->number
+          (regexp-substitute/global
+           #f " *%.*\n?"
+           (ly:kpathsea-expand-variable "$extra_mem_top")
+           'pre "" 'post)))
+        (cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
+    (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
     (newline (current-error-port))
     (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
     (newline (current-error-port))
     ;; fixme: set in environment?
     (if (ly:get-option 'safe)
        (set! cmd (string-append "openout_any=p " cmd)))
-    
+
     (system cmd)))
 
 (define-public (convert-to-tex book name)
   #t)
-