From: Werner Lemberg 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.14~235 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=233032344e92522ec0088321f6ff5c6d74cb6594;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 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 -% 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 + +% 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 + +% 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))