*** empty log message ***

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

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 626ecfca65cf3b6c76988035772c5b1d8c79d7a3..ade34dcba03460f019c895c9554b87bdd34bae23 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -45,27 +45,56 @@
    (equal? (substring fontname 0 2) "cm")
    (equal? (substring fontname 0 2) "ec")))
 
+(define (ps-embed-cff body font-set-name version)
+  (let*
+      ((binary-data 
+       (string-append
+        (format "/~a ~s StartData " font-set-name (string-length body))
+        body)))
+    
+    (string-append
+     (format
+    "%!PS-Adobe-3.0 Resource-FontSet
+%%DocumentNeededResources: ProcSet (FontSetInit)
+%%EndComments
+%%IncludeResource: ProcSet (FontSetInit)
+%%BeginResource: FontSet (~a)
+%%Title: (FontSet/~a)
+%%Version: ~s
+/FontSetInit /ProcSet findresource begin
+%%BeginData: ~s Binary Bytes
+"
+    font-set-name font-set-name version (string-length binary-data)
+    )
+    binary-data
+   "%%EndData
+%%EndResource
+%%EOF
+"
+
+   )))
+
+
 (define (load-fonts paper)
   (let* ((fonts (ly:paper-fonts paper))
         (font-names (uniq-list (sort (map ly:font-file-name fonts) string<?)))
         (pfas (map
                (lambda (x)
-               
-                 (let* ((aname (string-append x ".pfa"))
-                        (apath (ly:kpathsea-find-file aname))
-                        
-                        (bpath (if (not apath)
-                                   (ly:kpathsea-find-file
-                                    (string-append x ".pfb"))
-                                   #f)))
+                 (let* ((cffname (string-append x ".cff"))
+                        (aname (string-append x ".pfa"))
+                        (bname (string-append x ".pfb"))
+                        (cff-file-name (ly:find-file cffname))
+                        (a-file-name (ly:kpathsea-find-file aname))
+                        (b-file-name (ly:kpathsea-find-file bname)))
                    (cond
-                    (apath (ly:gulp-file apath))
-                    (bpath (ly:pfb->pfa bpath))
+                    (cff-file-name (ps-embed-cff (ly:gulp-file cff-file-name) x 0))
+                    (a-file-name (ly:gulp-file a-file-name))
+                    (b-file-name (ly:pfb->pfa b-file-name))
                     (else
-                     (ly:warn "cannot find PFA font ~S" x)
+                     (ly:warn "cannot find CFF/PFA/PFB font ~S" x)
                      ""))))
                (filter string? font-names))))
-  
+    
     (string-join pfas "\n")))
 
 (define (define-fonts paper)