X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-ps.scm;h=58026ff726c0c7472b6374c538e708dca32b0f38;hb=0387f04497978e37b335a8b99eec905499d6ad0f;hp=a5fd02fb1c21136449ea8aaa480b7c00cf84c479;hpb=b089f84f7978bbbb0e90dbb6c4a6988ad678da38;p=lilypond.git diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index a5fd02fb1c..58026ff726 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004--2006 Han-Wen Nienhuys +;;;; (c) 2004--2008 Han-Wen Nienhuys (define-module (scm framework-ps)) @@ -17,10 +17,7 @@ (scm clip-region) (lily)) -(define (format dest . rest) - (if (string? dest) - (apply simple-format (cons #f (cons dest rest))) - (apply simple-format (cons dest rest)))) +(define format ergonomic-simple-format) (define framework-ps-module (current-module)) @@ -41,11 +38,6 @@ "%" "_" name))) "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))))) -(define (tex-font? fontname) - (or - (equal? (substring fontname 0 2) "cm") - (equal? (substring fontname 0 2) "ec"))) - (define (define-fonts paper) (define font-list (ly:paper-fonts paper)) (define (define-font command fontname scaling) @@ -121,7 +113,7 @@ "set-ps-scale-to-lily-scale " "\n")) (ly:outputter-dump-stencil outputter page) - (ly:outputter-dump-string outputter "stroke grestore \nshowpage\n")) + (ly:outputter-dump-string outputter "stroke grestore\nshowpage\n")) (define (supplies-or-needs paper load-fonts?) (define (extract-names font) @@ -249,14 +241,21 @@ (define (write-preamble paper load-fonts? port) - - (define (load-font-via-GS font-name-filename) - (define (ps-load-file name) - (format - (if (string? name) - "(~a) (r) file .loadfont\n" - "% cannot find font file: ~a\n") - name)) + (define (internal-font? file-name) + (or (string-startswith file-name "Emmentaler") + (string-startswith file-name "emmentaler") + (string-startswith file-name "aybabtu") + (string-startswith file-name "Aybabtu"))) + (define (load-font-via-GS font-name-filename) + (define (ps-load-file file-name) + (if (string? file-name) + (if (string-contains file-name (ly:get-option 'datadir)) + (begin + (set! file-name (ly:string-substitute (ly:get-option 'datadir) "" file-name)) + (format "lilypond-datadir (~a) concatstrings (r) file .loadfont" file-name)) + + (format "(~a) (r) file .loadfont\n" file-name)) + (format "% cannot find font file: ~a\n" file-name))) (let* ((font (car font-name-filename)) (name (cadr font-name-filename)) @@ -269,10 +268,7 @@ (if (mac-font? bare-file-name) (handle-mac-font name bare-file-name) (cond - ((or (string-startswith file-name "Emmentaler") - (string-startswith file-name "emmentaler") - (string-startswith file-name "aybabtu") - (string-startswith file-name "Aybabtu")) + ((internal-font? file-name) (ps-load-file (ly:find-file (format "~a.otf" file-name)))) ((string? bare-file-name) @@ -330,7 +326,7 @@ (if (not embed) (begin - (set! embed "% failed \n") + (set! embed "% failed\n") (ly:warning (_ "cannot extract file matching ~a from ~a") name filename))) embed)) @@ -385,6 +381,8 @@ (define (load-fonts paper) (let* ((fonts (ly:paper-fonts paper)) + + ;; todo - doc format of list. (all-font-names (map (lambda (font) @@ -411,14 +409,30 @@ (sort (apply append all-font-names) (lambda (x y) (stringexact - (round (/ (* x scale) (ly:bp 1)))))) mmbox))) - - (list (car box) - (cadr box) - (max (1+ (car box)) (caddr box)) - (max (1+ (cadr box)) (cadddr box)) + (strip-non-number (lambda (x) + (if (or (nan? x) (inf? x)) 0.0 x))) + (directed-round (lambda (x rounder) + (inexact->exact + (rounder (/ (* (strip-non-number x) scale) + (ly:bp 1))))))) + (list (directed-round (car box) floor) + (directed-round (cadr box) floor) + (directed-round (max (1+ (car box)) (caddr box)) ceiling) + (directed-round (max (1+ (cadr box)) (cadddr box)) ceiling) ))) (let* ((outputter (ly:make-paper-outputter @@ -539,13 +556,13 @@ 'ps)) (port (ly:outputter-port outputter)) - (rounded-bbox (to-bp-box bbox)) + (rounded-bbox (to-rounded-bp-box bbox)) (port (ly:outputter-port outputter)) (header (eps-header paper rounded-bbox load-fonts))) (display header port) (write-preamble paper load-fonts port) - (display "gsave set-ps-scale-to-lily-scale \n" port) + (display "gsave set-ps-scale-to-lily-scale\n" port) (ly:outputter-dump-stencil outputter dump-me) (display "stroke grestore\n%%Trailer\n%%EOF\n" port) (ly:outputter-close outputter))) @@ -578,7 +595,7 @@ ((xext (car ext-system-pair)) (paper-system (cdr ext-system-pair)) (yext (paper-system-extent paper-system Y)) - (bbox (list (car xext) (car yext) + (bbox (list (car xext) (car yext) (cdr xext) (cdr yext))) (filename (if (< 0 count) (format "~a-~a" basename count) @@ -746,12 +763,6 @@ (* paper-height output-scale (/ (ly:bp 1))) name))) -(define-public (convert-to-dvi book name) - (ly:warning (_ "cannot generate ~S using the postscript back-end") "DVI")) - -(define-public (convert-to-tex book name) - (ly:warning (_ "cannot generate ~S using the postscript back-end") "TeX")) - (define-public (convert-to-ps book name) #t) @@ -760,7 +771,7 @@ (ly:error (_ "\nThe PostScript backend does not support the system-by-system output. For that, use the EPS backend instead, - lilypond -b eps + lilypond -dbackend=eps FILE If have cut & pasted a lilypond fragment from a webpage, be sure to only remove anything before @@ -768,5 +779,4 @@ to only remove anything before %% **************************************************************** %% Start cut-&-pastable-section %% **************************************************************** - ")))