X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-ps.scm;h=a2d7fa822a8e70ac1fcee21d0889df5aa5c70a32;hb=e58f03944cce661e4732af3e63aeb60edae97846;hp=b7a308479f6cae64fbb21c5b35e730872b906c7e;hpb=d02446a61d3eabfde67ed48928ae07766c97750f;p=lilypond.git diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index b7a308479f..a2d7fa822a 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -24,11 +24,8 @@ ;;(define pdebug stderr) (define (pdebug . rest) #f) -(define mm-to-bigpoint - (/ 72 25.4)) - (define-public (ps-font-command font) - (let* ((name (munge-lily-font-name (ly:font-file-name font))) + (let* ((name (ly:font-file-name font)) (magnify (ly:font-magnification font))) (string-append @@ -45,8 +42,7 @@ (define font-list (ly:paper-fonts paper)) (define (define-font command fontname scaling) (string-append - "/" command " { /" fontname " findfont " - (ly:number->string scaling) " output-scale div scalefont } bind def\n")) + "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n")) (define (standard-tex-font? x) (or (equal? (substring x 0 2) "ms") @@ -55,7 +51,7 @@ (define (font-load-command font) (let* ((specced-font-name (ly:font-name font)) (fontname (if specced-font-name - (munge-lily-font-name specced-font-name) + specced-font-name (ly:font-file-name font))) (command (ps-font-command font)) @@ -97,7 +93,7 @@ (string-append "/lily-output-units " - (number->string mm-to-bigpoint) + (number->string (/ (ly:bp 1))) " def %% millimeter\n" (output-entry "staff-line-thickness" 'line-thickness) (output-entry "line-width" 'line-width) @@ -113,9 +109,7 @@ (ly:outputter-dump-string outputter (string-append - "%%Page: " - (number->string page-number) " " (number->string page-count) "\n" - + (format "%%Page: ~a ~a\n" page-number page-number) "%%BeginPageSetup\n" (if landscape? "page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n" @@ -132,7 +126,7 @@ (define (extract-names font) (if (ly:pango-font? font) (map car (ly:pango-font-physical-fonts font)) - (list (munge-lily-font-name (ly:font-name font))))) + (list (ly:font-name font)))) (let* ((fonts (ly:paper-fonts paper)) (names (apply append (map extract-names fonts)))) @@ -160,7 +154,26 @@ (supplies-or-needs paper load-fonts?) "%%EndComments\n")) -(define (page-header paper page-count load-fonts?) +(define (ps-document-media paper) + (let* ((w (/ (* + (ly:output-def-lookup paper 'output-scale) + (ly:output-def-lookup paper 'paper-width)) (ly:bp 1))) + (h (/ (* + (ly:output-def-lookup paper 'paper-height) + (ly:output-def-lookup paper 'output-scale)) + (ly:bp 1))) + (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))) + (format "%%DocumentMedia: ~a ~$ ~$ ~a ~a ~a\n" + (ly:output-def-lookup paper 'papersizename) + (if landscape? h w) + (if landscape? w h) + 80 ;; weight + "()" ;; color + "()" ;; type + ))) + + +(define (file-header paper page-count load-fonts?) (string-append "%!PS-Adobe-3.0\n" "%%Creator: LilyPond " (lilypond-version) @@ -172,34 +185,31 @@ (if (eq? (ly:output-def-lookup paper 'landscape) #t) "Landscape\n" "Portrait\n") - "%%DocumentPaperSizes: " - (ly:output-def-lookup paper 'papersizename) "\n" + (ps-document-media paper) (supplies-or-needs paper load-fonts?) "%%EndComments\n")) (define (procset file-name) - (string-append - (format + (format "%%BeginResource: procset (~a) 1 0 ~a %%EndResource " - file-name (cached-file-contents file-name)))) + file-name (cached-file-contents file-name))) -(define (setup paper) +(define (embed-document file-name) + (format "%%BeginDocument: ~a +~a +%%EndDocument +" + file-name (cached-file-contents file-name))) + +(define (setup-variables paper) (string-append "\n" - "%%BeginSetup\n" (define-fonts paper) (output-variables paper) - "%%EndSetup\n")) - -(define-public (munge-lily-font-name name) - ;; FIXME: this fixes PFAPAFemmentaler.pfapfa, and also - ;; PFAaybabtu.otf.pfa, but the second case now produces aybabtu.otf, - ;; which still fails because .otf files cannot be embedded. - (regexp-substitute/global #f "^([eE]mmentaler|[aA]ybabtu)" - name 'pre "PFA" 1 'post)) + )) (define (cff-font? font) (let* @@ -229,7 +239,6 @@ (string-length binary-data))) (footer "\n%%EndData %%EndResource -%%EOF %%EndResource\n")) (string-append @@ -254,13 +263,13 @@ (bare-file-name (ly:find-file file-name))) (cons - (munge-lily-font-name name) + name (cond - ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name) - (ps-load-file (ly:find-file - (format "~a.pfa" (munge-lily-font-name file-name))))) + ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name) + (ps-load-file (ly:find-file + (format "~a.otf" file-name)))) ((string? bare-file-name) - (ps-load-file (munge-lily-font-name file-name))) + (ps-load-file file-name)) (else (ly:warning (_ "can't embed ~S=~S") name file-name) ""))))) @@ -322,7 +331,7 @@ (cond ((and file-name (string-match "\\.pfa" downcase-file-name)) - (cached-file-contents file-name)) + (embed-document file-name)) ((and file-name (string-match "\\.pfb" downcase-file-name)) (ly:pfb->pfa file-name)) ((and file-name (string-match "\\.ttf" downcase-file-name)) @@ -340,11 +349,9 @@ (bare-file-name (ly:find-file file-name))) (cons - (munge-lily-font-name name) + name (cond - ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name) - (cached-file-contents - (format "~a.pfa" (munge-lily-font-name file-name)))) + ((and (eq? PLATFORM 'darwin) bare-file-name (string-match "\\.dfont" bare-file-name)) @@ -402,6 +409,7 @@ (pfas (map font-loader font-names))) pfas)) + (display "%%BeginProlog\n" port) (if load-fonts? (for-each (lambda (f) @@ -410,12 +418,15 @@ (display "\n%%EndFont\n" port)) (load-fonts paper))) - (display (setup paper) port) + (display (setup-variables paper) port) ;; adobe note 5002: should initialize variables before loading routines. (display (procset "music-drawing-routines.ps") port) (display (procset "lilyponddefs.ps") port) - (display "init-lilypond-parameters\n" port)) + + (display "%%EndProlog\n" port) + + (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port)) (define-public (output-framework basename book scopes fields) (let* ((filename (format "~a.ps" basename)) @@ -434,7 +445,11 @@ (port (ly:outputter-port outputter))) (output-scopes scopes fields basename) - (display (page-header paper page-count #t) port) + (display (file-header paper page-count #t) port) + (display "\n%%BeginDefaults +%%PageMedia: a4 +%%EndDefaults\n" port) + (write-preamble paper #t port) (for-each @@ -448,20 +463,16 @@ (postprocess-output book framework-ps-module filename (ly:output-formats)))) -(if (not (defined? 'nan?)) - (define (nan? x) #f)) - -(if (not (defined? 'inf?)) - (define (inf? x) #f)) - (define-public (dump-stencil-as-EPS paper dump-me filename load-fonts?) - (define (mm-to-bp-box mmbox) + (define (to-bp-box mmbox) (let* ((scale (ly:output-def-lookup paper 'output-scale)) (box (map (lambda (x) - (inexact->exact - (round (* x scale mm-to-bigpoint)))) mmbox))) - + (if (or (nan? x) (inf? x)) + 0 + (inexact->exact + (round (/ (* x scale) (ly:bp 1)))))) mmbox))) + (list (car box) (cadr box) (max (1+ (car box)) (caddr box)) @@ -493,7 +504,7 @@ ;; (list (min left-overshoot (car xext)) (car yext) (cdr xext) (cdr yext)))) - (rounded-bbox (mm-to-bp-box bbox)) + (rounded-bbox (to-bp-box bbox)) (port (ly:outputter-port outputter)) (header (eps-header paper rounded-bbox load-fonts?)))