Make TTCs work. Fixes #710.

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

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 0c7ab8624f13ec4e1d73c0b1fd73439d8a62c457..cfd72cf041be283e68984afdca24bcc1f7f549a1 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -117,7 +117,7 @@
   (define (extract-names font)
     (if (ly:pango-font? font)
        (map car (ly:pango-font-physical-fonts font))
-       (list  (ly:font-name font))))
+       (list (ly:font-name font))))
 
   (let* ((fonts (ly:paper-fonts paper))
         (names (apply append (map extract-names fonts))))
@@ -155,7 +155,7 @@
               (ly:output-def-lookup paper 'papersizename)
               (if landscape? h w)
               (if landscape? w h)
-              80  ;; weight
+              80   ;; weight
               "()" ;; color
               "()" ;; type
     )))
@@ -240,7 +240,7 @@
                (set! file-name (ly:string-substitute (ly:get-option 'datadir)
                                                      "" file-name))
                (format
-                "lilypond-datadir (~a) concatstrings (r) file .loadfont"
+                "lilypond-datadir (~a) concatstrings (r) file .loadfont\n"
                 file-name))
              (format "(~a) (r) file .loadfont\n" file-name))
          (format "% cannot find font file: ~a\n" file-name)))
@@ -255,7 +255,7 @@
                (cond
                 ((internal-font? file-name)
                  (ps-load-file (ly:find-file
-                                (format "~a.otf"  file-name))))
+                                (format "~a.otf" file-name))))
                 ((string? bare-file-name)
                  (ps-load-file file-name))
                 (else
@@ -276,7 +276,7 @@
     (reverse (dir-helper (opendir dir-name) '())))
 
   (define (handle-mac-font name filename)
-    (let* ((dir-name  (tmpnam))
+    (let* ((dir-name (tmpnam))
           (files '())
           (status 0)
           (embed #f))
@@ -304,7 +304,7 @@
                        name filename)))
       embed))
 
-  (define (font-file-as-ps-string name file-name)
+  (define (font-file-as-ps-string name file-name font-index)
     (let* ((downcase-file-name (string-downcase file-name)))
       (cond
        ((and file-name (string-endswith downcase-file-name ".pfa"))
@@ -314,7 +314,7 @@
        ((and file-name (string-endswith downcase-file-name ".ttf"))
        (ly:ttf->pfa file-name))
        ((and file-name (string-endswith downcase-file-name ".ttc"))
-       (ly:ttf->pfa file-name))
+       (ly:ttf->pfa file-name font-index))
        ((and file-name (string-endswith downcase-file-name ".otf"))
        (ps-embed-cff (ly:otf->cff file-name) name 0))
        (else
@@ -327,10 +327,11 @@
         (or (string-endswith bare-file-name ".dfont")
             (= (stat:size (stat bare-file-name)) 0))))
 
-  (define (load-font font-name-filename)
-    (let* ((font (car font-name-filename))
-          (name (cadr font-name-filename))
-          (file-name (caddr font-name-filename))
+  (define (load-font font-psname-filename-fontindex)
+    (let* ((font (list-ref font-psname-filename-fontindex 0))
+          (name (list-ref font-psname-filename-fontindex 1))
+          (file-name (list-ref font-psname-filename-fontindex 2))
+          (font-index (list-ref font-psname-filename-fontindex 3))
           (bare-file-name (ly:find-file file-name)))
       (cons name
            (cond ((mac-font? bare-file-name)
@@ -340,7 +341,7 @@
                                 name
                                 0))
                  (bare-file-name (font-file-as-ps-string
-                                  name bare-file-name))
+                                  name bare-file-name font-index))
                  (else
                   (ly:warning (_ "do not know how to embed font ~s ~s ~s")
                               name file-name font))))))
@@ -355,12 +356,14 @@
               (cond ((string? (ly:font-file-name font))
                      (list (list font
                                  (ly:font-name font)
-                                 (ly:font-file-name font))))
+                                 (ly:font-file-name font)
+                                 #f)))
                     ((ly:pango-font? font)
-                     (map (lambda (name-psname-pair)
+                     (map (lambda (psname-filename-fontindex)
                             (list #f
-                                  (car name-psname-pair)
-                                  (cdr name-psname-pair)))
+                                  (list-ref psname-filename-fontindex 0)
+                                  (list-ref psname-filename-fontindex 1)
+                                  (list-ref psname-filename-fontindex 2)))
                           (ly:pango-font-physical-fonts font)))
                     (else
                      (ly:font-sub-fonts font))))
@@ -395,7 +398,7 @@
       (for-each (lambda (f)
                  (format port "\n%%BeginFont: ~a\n" (car f))
                  (display (cdr f) port)
-                 (display "\n%%EndFont\n" port))
+                 (display "%%EndFont\n" port))
                (load-fonts paper)))
   (display (setup-variables paper) port)
 
@@ -468,7 +471,7 @@
               0.0 x))
 
           ;; the left-overshoot is to make sure that
-          ;; bar numbers  stick out of margin uniformly.
+          ;; bar numbers stick out of margin uniformly.
           ;;
           (list
        
@@ -564,7 +567,7 @@
          bbox)
 
         (if do-pdf
-            (postscript->pdf  0 0  (format "~a.eps" filename)))
+            (postscript->pdf 0 0 (format "~a.eps" filename)))
         ))
 
      extents-system-pairs)
@@ -572,7 +575,7 @@
 
 
 (define-public (clip-system-EPSes basename paper-book)
-  (define do-pdf (member  "pdf" (ly:output-formats)))
+  (define do-pdf (member "pdf" (ly:output-formats)))
 
   (define (clip-score-systems basename systems)
     (let*