]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-tex.scm
* lily/kpath.cc:
[lilypond.git] / scm / framework-tex.scm
index 1d20344a431477468c8040c5b9fcde460b207f84..54f6539e4f7f8831755e1a52e8ae9e481589d0fd 100644 (file)
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;;
-;;;; (c)  2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2004--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 (define-module (scm framework-tex)
   #:export (output-framework-tex       
             (srfi srfi-13)
             (lily))
 
+(define (output-formats)
+  (define formats (ly:output-formats))
+  (set! formats (completize-formats formats))
+  (if (member "ps" formats)
+      (set! formats (cons "dvi" formats))) 
+  (if (member "dvi" formats)
+      (set! formats (cons "tex" formats)))
+
+  (uniq-list formats))
+
+(define framework-tex-module (current-module))
 (define-public (sanitize-tex-string s)
   (if (ly:get-option 'safe)
       (regexp-substitute/global
        #f "\\\\"
-       (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post )
+       (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post)
        'pre "$\\backslash$" 'post)
       s))
 
 (define (symbol->tex-key sym)
   (regexp-substitute/global
-   #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
+   #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
 
 (define (tex-number-def prefix key number)
   (string-append
    "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
 
-
 (define-public (digits->letters str)
   (regexp-substitute/global
    #f "[-\\._]"
    'pre ""
    'post))
 
-(define (otf-font-load-command paper font)
-  (let*
-      ((sub-fonts (ly:font-sub-fonts font))
-       (base-name (tex-font-command font)))
-
-    (string-append
-     (apply string-append
-           (map
-            (lambda (sub-name)
-              (string-append
-               "\\font\\" (string-append base-name (digits->letters sub-name)) "="
-               sub-name 
-               " scaled "
-               (ly:number->string (inexact->exact
-                                   (round (* 1000
-                                             (ly:font-magnification font)
-                                             (ly:paper-outputscale paper)))))
-               "%\n"))
-            sub-fonts)))
-
-    "\\def\\" (tex-font-command font) "{"
-    (apply string-append
-          (map (lambda (name)
-                 "\\def\\" (string-append base-name (digits->letters name))
-                 )
-    ))))
-
-(define-public (tex-font-command font)
+(define-public (tex-font-command-raw name magnification)
   (string-append
    "magfont"
-   (string-encode-integer
-    (hashq (ly:font-file-name font) 1000000))
+   (digits->letters (format "~a" name))
    "m"
    (string-encode-integer
-    (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
+    (inexact->exact (round (* 1000 magnification))))))
 
-(define (simple-font-load-command paper font)
-  (let* ((coding-alist (ly:font-encoding-alist font))
-        (font-encoding (assoc-get 'output-name coding-alist)))
+(define-public (tex-font-command font)
+  (tex-font-command-raw
+   (ly:font-file-name font) (ly:font-magnification font)))
+
+(define (otf-font-load-command paper font)
+  (let* ((sub-fonts (ly:font-sub-fonts font)))
     (string-append
-     "\\font\\lilypond" (tex-font-command font) "="
-     (if (or (equal? (ly:font-encoding font) "cork-lm")
-            ;; FIXME: encoding: FontSpecific for cork-lm
-            (string-prefix? "lm" (ly:font-file-name font)))
-        "cork-" "")
-     (ly:font-file-name font)
-     " scaled "
-     (ly:number->string (inexact->exact
+     (apply string-append
+           (map
+            (lambda (sub-name)
+              (format #f "\\font\\~a=~a scaled ~a%\n"
+                      (tex-font-command-raw
+                       sub-name (ly:font-magnification font))
+                      sub-name
+                      (ly:number->string
+                       (inexact->exact
                         (round (* 1000
                                   (ly:font-magnification font)
-                                  (ly:paper-outputscale paper)))))
-     "\n"
-     "\\def\\" (tex-font-command font) "{%\n"
-     ;; UGH.  Should be handled via alist.
-     (if (or (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
-            (not font-encoding))
-        "  \\lilypondfontencoding{T1}"
-        "  ")
-     "\\lilypond" (tex-font-command font)
-     "}%\n")))
+                                  (ly:paper-outputscale paper)))))))
+            sub-fonts)))))
+
+(define (simple-font-load-command paper font)
+   (format
+    "\\font\\~a=~a scaled ~a%\n"
+    (tex-font-command font)
+    (ly:font-file-name font)
+    (inexact->exact
+     (round (* 1000
+              (ly:font-magnification font)
+              (ly:paper-outputscale paper))))))
 
 (define (font-load-command paper font)
   (if (pair? (ly:font-sub-fonts font))
        "}%\n\\vfill\n"
        "}%\n\\vfill\n\\lilypondpagebreak\n")))
 
-(define-public (output-framework outputter book scopes fields basename )
-  (let* ((paper (ly:paper-book-paper book))
+(define-public (output-framework basename book scopes fields)
+  (let* ((filename (format "~a.tex" basename))
+        (outputter  (ly:make-paper-outputter filename "tex"))
+        (paper (ly:paper-book-paper book))
         (pages (ly:paper-book-pages book))
         (last-page (car (last-pair pages)))
         (with-extents
      (lambda (page)
        (dump-page outputter page (eq? last-page page) with-extents))
      pages)
-    (ly:outputter-dump-string outputter "\\lilypondend\n")))
+    (ly:outputter-dump-string outputter "\\lilypondend\n")
+    (ly:outputter-close outputter)
+    (postprocess-output book framework-tex-module filename
+                       (output-formats))))
 
 (define (dump-line putter line last?)
   (ly:outputter-dump-string
        "}\\interscoreline\n")))
 
 (define-public (output-classic-framework
-               outputter book scopes fields basename)
-  (let* ((paper (ly:paper-book-paper book))
+               basename book scopes fields)
+  (let* ((filename (format "~a.tex" basename))
+        (outputter  (ly:make-paper-outputter filename "tex"))
+        (paper (ly:paper-book-paper book))
         (lines (ly:paper-book-systems book))
         (last-line (car (last-pair lines))))
     (for-each
 
     (for-each
      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
-    (ly:outputter-dump-string outputter "\\lilypondend\n")))
+    (ly:outputter-dump-string outputter "\\lilypondend\n")
+    (ly:outputter-close outputter)
+    (postprocess-output book framework-tex-module filename
+                       (output-formats))
+    ))
 
 (define-public (output-preview-framework
-               outputter book scopes fields basename )
-  (let* ((paper (ly:paper-book-paper book))
+               basename book scopes fields)
+  (let* ((filename (format "~a.tex" basename))
+        (outputter  (ly:make-paper-outputter filename
+                                             "tex"))
+        (paper (ly:paper-book-paper book))
         (lines (ly:paper-book-systems book))
         (first-notes-index (list-index
                             (lambda (s) (not (ly:paper-system-title? s)))
       (header-end)))
 
     (for-each
-     (lambda (l)
-       (dump-line outputter l (not (ly:paper-system-title? l))))
+     (lambda (lst)
+       (dump-line outputter lst (not (ly:paper-system-title? lst))))
      (take lines (1+ first-notes-index)))
-    (ly:outputter-dump-string outputter "\\lilypondend\n")))
+    (ly:outputter-dump-string outputter "\\lilypondend\n")
+    (ly:outputter-close outputter)
+    (postprocess-output book framework-tex-module filename
+                       (output-formats))
+
+))
 
 (define-public (convert-to-pdf book name)
   (let* ((defs (ly:paper-book-paper book))
          (delete-file ps-name)))
     (if (not (ly:get-option 'verbose))
        (begin
-         (format (current-error-port) (_ "Converting to `~a.ps'...") base)
+         (format (current-error-port) (_ "Converting to `~a'...")
+                 (string-append base ".dvi"))
          (newline (current-error-port))))
     (ly:system cmd)))
 
          (delete-file dvi-name)))
     (if (not (ly:get-option 'verbose))
        (begin
-         (format (current-error-port) (_ "Converting to `~a.dvi'...") base)
+         (format (current-error-port) (_ "Converting to `~a'...")
+                 (string-append base ".dvi"))
          (newline (current-error-port))))
 
     ;; fixme: set in environment?