* scm/framework-ps.scm (ps-embed-pfa): New function to define a font

resource.
(setup): New function to define a `Setup' environment.
(preamble): Use new functions.

* ps/lilypond.defs (init-lilypond-parameters): New function to get rid of
directly executed PS code.  Used in scm/framework-ps.scm.

diff --git a/ChangeLog b/ChangeLog
index cfc1f0f4a4048613c832abd4dc03ee43021c05c1..c638ac6156a1e7b742f2e1b9c4ec8f2a3b216e36 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -10,7 +10,12 @@
 
        * scm/framework-ps.scm (ps-embed-cff): Fix DSC comments.
        (procset): New function to define a procset resource.
-       (preamble): Use it.
+       (ps-embed-pfa): New function to define a font resource.
+       (setup): New function to define a `Setup' environment.
+       (preamble): Use new functions.
+
+       * ps/lilypond.defs (init-lilypond-parameters): New function to
+       get rid of directly executed PS code.  Used in scm/framework-ps.scm.
 
 2005-01-18  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 

diff --git a/ps/lilyponddefs.ps b/ps/lilyponddefs.ps
index 71a59115c11b86e98a3f28e7c9c24808730cdf54..5b11abc29ec0d8eecdf3d2b90576fd7b220722c7 100644 (file)
--- a/ps/lilyponddefs.ps
+++ b/ps/lilyponddefs.ps
@@ -11,27 +11,28 @@
 
 
 /set-ps-scale-to-lily-scale {
-    lily-output-units output-scale mul
-    lily-output-units output-scale mul scale } bind def
+       lily-output-units output-scale mul
+       lily-output-units output-scale mul scale
+} bind def
+
 
 /init-paper {
-       gsave
-       .1 setlinewidth
-       clippath pathbbox newpath
-       /vsize exch def
-       /hsize exch def pop pop pop
-       % FIXME
-       /top-margin 2 def
+       gsave
+       .1 setlinewidth
+       clippath pathbbox newpath
+       /vsize exch def
+       /hsize exch def pop pop pop
+       % FIXME
+       /top-margin 2 def
        hsize line-width sub 2 div /left-margin exch def
-       grestore
+       grestore
 } bind def
 
 
-/place-box
-{
+/place-box {
        /object exch def
        gsave
-       %exch translate
+       % exch translate
        translate
        0 0 moveto
        object
@@ -42,51 +43,54 @@
 
 %/FONTLENGTH 256 bind def
 
-%<font> <encoding> <name> reencode-font
+
 /reencode-dict 5 dict def
-/reencode-font
-{
-    reencode-dict
-    begin
-    /name exch def
-    /encoding exch def
-    /base-font exch def
-    % note: Needs ps level 2
-    /font base-font maxlength dict def
-    base-font {
-        exch dup dup /FID ne exch /Encoding ne and
-        { exch font 3 1 roll put }
-        { pop pop } ifelse
-    } forall
-    font /FontName name put
-    font /Encoding encoding put
-    name font definefont pop
-    end
-} bind def
 
-/start-system % x y
-{
-    gsave
-    0
-    vsize translate
+
+%<font> <encoding> <name> reencode-font
+/reencode-font {
+       reencode-dict begin
+               /name exch def
+               /encoding exch def
+               /base-font exch def
+               % note: Needs ps level 2
+               /font base-font maxlength dict def
+               base-font {
+                       exch dup dup /FID ne exch /Encoding ne and
+                       { exch font 3 1 roll put }
+                       { pop pop } ifelse
+               } forall
+               font /FontName name put
+               font /Encoding encoding put
+               name font definefont pop
+       end
 } bind def
 
-/stop-system
-{
-    /the-line exch def
-    the-line stroke grestore
+
+% <x> <y> start-system
+/start-system {
+       gsave
+       0
+       vsize translate
 } bind def
 
-/end-lilypond-output
-{
-%    showpage
+
+/stop-system {
+       /the-line exch def
+       the-line stroke grestore
 } bind def
 
-staff-line-thickness setlinewidth
+
+/end-lilypond-output {
+%      showpage
+} bind def
 
 
-staff-height init-paper
+/init-lilypond-parameters {
+       staff-line-thickness setlinewidth
+       staff-height init-paper
+       pstack
+} bind def
 
-pstack
 
 % end lilyponddefs.ps

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 35813d046c7babc856bd245472e9aae5e9c1253a..df6e14cabb988833b6f9562a60941e9906b2096f 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -41,6 +41,14 @@
    (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
@@ -94,7 +102,6 @@
           (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)
@@ -202,6 +209,15 @@
 "
     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))
@@ -230,8 +246,8 @@
                                           (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)
                        ""))))
@@ -240,12 +256,11 @@
       (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))