]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-ps.scm
* scm/framework-ps.scm (ps-embed-pfa): New function to define a font
[lilypond.git] / scm / framework-ps.scm
index 35813d046c7babc856bd245472e9aae5e9c1253a..df6e14cabb988833b6f9562a60941e9906b2096f 100644 (file)
    (equal? (substring fontname 0 2) "cm")
    (equal? (substring fontname 0 2) "ec")))
 
+(define (ps-embed-pfa body font-name version)
+  (string-append
+   (format
+    "%%BeginResource: font ~a
+~a
+%%EndResource"
+    font-name body)))
+
 (define (ps-embed-cff body font-set-name version)
   (let* ((binary-data
          (string-append
           (ops (ly:output-def-lookup paper 'outputscale))
           (scaling (* ops magnification designsize)))
 
-
       ;; Bluesky pfbs have UPCASE names (sigh.)
       ;; FIXME - don't support Bluesky?
       (if (standard-tex-font? fontname)
 "
     name (ly:gulp-file name))))
 
+(define (setup paper)
+  (string-append
+   "\n"
+   "%%BeginSetup\n"
+   (define-fonts paper)
+   (output-variables paper)
+   "init-lilypond-parameters\n"
+   "%%EndSetup\n"))
+
 (define (preamble paper load-fonts?)
   (define (load-fonts paper)
     (let* ((fonts (ly:paper-fonts paper))
                                           (ly:pfb->pfa bare-file-name)
                                           (ly:gulp-file bare-file-name)))
                       (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))
+                      (a-file-name (ps-embed-pfa (ly:gulp-file a-file-name) x 0))
+                      (b-file-name (ps-embed-pfa (ly:pfb->pfa b-file-name) x 0))
                       (else
                        (ly:warn "cannot find CFF/PFA/PFB font ~S" x)
                        ""))))
       (string-join pfas "\n")))
 
   (list
-   (output-variables paper)
    (procset "music-drawing-routines.ps")
    (procset "lilyponddefs.ps")
    (if load-fonts?
        (load-fonts paper))
-   (define-fonts paper)))
+   (setup paper)))
 
 (define-public (output-framework basename book scopes fields)
   (let* ((filename (format "~a.ps" basename))