X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fps-to-png.scm;h=c70dbf8628572ad6f6125b2d583a39034351b836;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=4f6d322e4825a69b55ca30a3002cc922c2028601;hpb=4ad6b8dc67387dbfb08097417e70570e855b7f44;p=lilypond.git diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm index 4f6d322e48..c70dbf8628 100644 --- a/scm/ps-to-png.scm +++ b/scm/ps-to-png.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2005--2006 Jan Nieuwenhuizen +;;;; (c) 2005--2008 Jan Nieuwenhuizen (define-module (scm ps-to-png)) @@ -50,30 +50,6 @@ (define-public (gulp-file file-name . max-size) (ly:gulp-file file-name (if (pair? max-size) (car max-size)))) -(define BOUNDING-BOX-RE - "^%%BoundingBox: (-?[0-9]+) (-?[0-9]+) (-?[0-9]+) (-?[0-9]+)") - -(define (unused-found-broken-get-bbox file-name) - (let* ((bbox (string-append file-name ".bbox")) - ;; -sOutputFile does not work with bbox? - (cmd (format #t "gs\ - -sDEVICE=bbox\ - -q\ - -dNOPAUSE\ - ~S\ - -c showpage\ - -c quit 2>~S" - file-name bbox)) - (status (system cmd)) - (s (gulp-file bbox 10240)) - (m (string-match BOUNDING_BOX_RE s))) - - (if m - (list->vector - (map (lambda (x) (string->number (car x))) (vector->list m))) - #f))) - - ;; copy of ly:system. ly:* not available via lilypond-ps2png.scm (define (my-system be-verbose exit-on-error cmd) (define status 0) @@ -90,16 +66,19 @@ status) (define (scale-down-image be-verbose factor file) - (let* ((status 0) - (old (string-append file ".old"))) - - (rename-file file old) - (my-system - be-verbose #t - (format #f - "pngtopnm ~a | pnmscale -reduce ~a 2>/dev/null | pnmtopng -compression 9 2>/dev/null > ~a" - old factor file)) - (delete-file old))) + (define (with-pbm) + (let* ((status 0) + (old (string-append file ".old"))) + + (rename-file file old) + (my-system + be-verbose #t + (format #f + "pngtopnm ~a | pnmscale -reduce ~a 2>/dev/null | pnmtopng -compression 9 2>/dev/null > ~a" + old factor file)) + (delete-file old))) + + (with-pbm)) (define-public (ps-page-count ps-name) (let* ((byte-count 10240) @@ -118,7 +97,7 @@ (page-width 100) (page-height 100) (rename-page-1 #f) - (be-verbose #f) + (be-verbose (ly:get-option 'verbose)) (pixmap-format 'png16m) (anti-alias-factor 1)) @@ -129,7 +108,7 @@ ((string-contains format-str "jpeg") "jpeg") (else (ly:error "Unknown pixmap format ~a" pixmap-format)))) - (base (basename (re-sub "[.]e?ps" "" ps-name))) + (base (dir-basename ps-name ".ps" ".eps")) (png1 (format "~a.~a" base extension)) (pngn (format "~a-page%d.~a" base extension)) (page-count (ps-page-count ps-name))