* mf/GNUmakefile: Genereate combined aybabtu info.

[lilypond.git] / scm / framework-tex.scm

diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm
index f0e3321a2ca9c3f6194f9244fc630e82a6b56f37..75785aa6166a1f530a3b10dd19d44c86c1da398d 100644 (file)
--- a/scm/framework-tex.scm
+++ b/scm/framework-tex.scm
@@ -12,15 +12,10 @@
             (ice-9 string-fun)
             (ice-9 format)
             (guile)
+            (srfi srfi-1)
             (srfi srfi-13)
             (lily))
 
-;; FIXME: rename
-;; what is bla supposed to do?  It breaks the default output terribly:
-
-;; \def\lilypondpaperbla$\backslash${$\backslash$}{bla$\backslash${$\backslash$}}%
-;; \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
@@ -37,21 +32,64 @@
   (string-append
    "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
 
-(define-public (tex-font-command font)
+(define-public (digits->letters str)
+  (regexp-substitute/global
+   #f "[-\\._]"
+   (regexp-substitute/global
+    #f "([0-9])" str
+    'pre
+    (lambda (match)
+      (make-string
+       1
+       (integer->char
+       (+ (char->integer #\A)
+          (- (char->integer #\0))
+          (char->integer (string-ref (match:substring match 1) 0)))
+       )))
+    'post)
+   'pre ""
+   'post))
+
+(define-public (tex-font-command-raw name magnification)
   (string-append
    "magfont"
    (string-encode-integer
-    (hashq (ly:font-filename font) 1000000))
+    (hash name 1000000))
    "m"
    (string-encode-integer
-    (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
+    (inexact->exact (round (* 1000 magnification))))))
 
-(define (font-load-command paper font)
+(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
+     (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)))))))
+            sub-fonts)))))
+
+(define (simple-font-load-command paper font)
   (let* ((coding-alist (ly:font-encoding-alist font))
         (font-encoding (assoc-get 'output-name coding-alist)))
     (string-append
      "\\font\\lilypond" (tex-font-command font) "="
-     (ly:font-filename 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
                         (round (* 1000
@@ -67,6 +105,11 @@
      "\\lilypond" (tex-font-command font)
      "}%\n")))
 
+(define (font-load-command paper font)
+  (if (pair? (ly:font-sub-fonts font))
+      (otf-font-load-command paper font)
+      (simple-font-load-command paper font)))
+
 (define (define-fonts paper)
   (string-append
    ;; UGH. FIXME.
@@ -239,11 +282,16 @@
 (define-public (output-preview-framework
                outputter book scopes fields basename )
   (let* ((paper (ly:paper-book-paper book))
-        (lines (ly:paper-book-systems book)))
+        (lines (ly:paper-book-systems book))
+        (first-notes-index (list-index
+                            (lambda (s) (not (ly:paper-system-title? s)))
+                            lines)))
+
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
+      
       ;;FIXME
       (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
@@ -251,7 +299,10 @@
       (define-fonts paper)
       (header-end)))
 
-    (dump-line outputter (car lines) #t)
+    (for-each
+     (lambda (l)
+       (dump-line outputter l (not (ly:paper-system-title? l))))
+     (take lines (1+ first-notes-index)))
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
 (define-public (convert-to-pdf book name)
@@ -271,32 +322,28 @@
         (ly:get-option 'resolution))
      (string-append (basename name ".tex") ".ps"))))
 
-
-;;
-;; ugh  -   double check this. We are leaking
-;; untrusted (user-settable) info to a command-line 
-;;
-
-
 (define-public (convert-to-ps book name)
   (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)))
         (base (basename name ".tex"))
         (cmd (string-append "dvips "
                             (if preview?
-                                " -E "
+                                "-E "
                                 (string-append
-                                 " -t "
-                                 (sanitize-command-option papersizename)))
-                                
-                            (if landscape?
-                                " -t landscape "
-                                " ")
-                            "  -u+ec-mftrace.map -u+lilypond.map -Ppdf "
+                                 "-t"
+                                 ;; careful: papersizename is user-set.
+                                 (sanitize-command-option papersizename)
+                                 " "))
+                            (if landscape? "-t landscape " "")
+                            (if (ly:kpathsea-find-file "lm.map")
+                                "-u+lm.map " "")
+                            (if (ly:kpathsea-find-file "ecrm10.pfa")
+                                "-u+ec-mftrace.map " "")
+                            "-u+lilypond.map -Ppdf " ""
                             base)))
-    
     (let ((ps-name (string-append base ".ps")))
       (if (access? ps-name W_OK)
          (delete-file ps-name)))