From: wl <wl>
Date: Tue, 18 Jan 2005 22:27:08 +0000 (+0000)
Subject: * scm/framework-ps.scm (ps-embed-pfa): New function to define a font
X-Git-Tag: release/2.5.23~648
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=24dd75a59099149065baf7bf0ed4f230de67c655;p=lilypond.git
* 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 cfc1f0f4a4..c638ac6156 100644
--- 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 71a59115c1..5b11abc29e 100644
--- 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 35813d046c..df6e14cabb 100644
--- 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))