From: Jan Nieuwenhuizen Date: Sun, 17 Dec 2006 14:14:16 +0000 (+0100) Subject: Only use color in png if necessary. X-Git-Tag: release/2.11.3-1~14^2~1^2~5 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a981d3f71e1170a6ef12716ea3e8f61b0a3e7cf6;p=lilypond.git Only use color in png if necessary. --- diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc index 142e7c2bef..5e031c07ab 100644 --- a/lily/general-scheme.cc +++ b/lily/general-scheme.cc @@ -48,8 +48,8 @@ LY_DEFINE (ly_gulp_file, "ly:gulp-file", "The file is looked up using the search path. ") { SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string"); - int sz = -1; - if (size != SCM_UNDEFINED) + int sz = INT_MAX; + if (size != SCM_UNDEFINED && size != SCM_UNSPECIFIED) { SCM_ASSERT_TYPE (scm_is_number (size), size, SCM_ARG2, __FUNCTION__, "number"); sz = scm_to_int (size); diff --git a/scm/backend-library.scm b/scm/backend-library.scm index 5258bcf516..02cd759ff9 100644 --- a/scm/backend-library.scm +++ b/scm/backend-library.scm @@ -94,8 +94,7 @@ (ly:message (_ "Converting to `~a'...") pdf-name) (ly:progress "\n") - (ly:system cmd) - )) + (ly:system cmd))) (use-modules (scm ps-to-png)) @@ -104,58 +103,45 @@ ;; GS produces PNG files like BASE-page%d.png. ;;(ly:message (_ "Converting to `~a'...") ;; (string-append (basename name ".ps") "-page1.png" ))) - (let ((verbose (ly:get-option 'verbose)) - (rename-page-1 #f)) - + (let* ((verbose (ly:get-option 'verbose)) + (rename-page-1 #f) + (pixmap-default 'png16m) + (pixmap-setting (ly:get-option 'pixmap-format)) + (pixmap-format (if (or (not (eq pixmap-setting pixmap-default)) + (ps-has-color name)) + pixmap-setting + 'pnggray))) (ly:message (_ "Converting to ~a...") "PNG") - (make-ps-images name #:resolution resolution - #:page-width paper-width + #:page-width paper-width #:page-height paper-height #:rename-page-1 rename-page-1 #:be-verbose verbose #:anti-alias-factor (ly:get-option 'anti-alias-factor) - #:pixmap-format (ly:get-option 'pixmap-format) - ) - + #:pixmap-format pixmap-format) (ly:progress "\n"))) (define-public (postprocess-output paper-book module filename formats) - (let* - ((completed (completize-formats formats)) - (base (string-regexp-substitute "\\.[a-z]+$" "" filename)) - (intermediate (remove - (lambda (x) - (member x formats)) - completed))) - - (for-each - (lambda (f) - ((eval (string->symbol (format "convert-to-~a" f)) module) - paper-book filename)) - completed) - + (let* ((completed (completize-formats formats)) + (base (string-regexp-substitute "\\.[a-z]+$" "" filename)) + (intermediate (remove (lambda (x) (member x formats)) completed))) + (for-each (lambda (f) + ((eval (string->symbol (format "convert-to-~a" f)) + module) paper-book filename)) completed) (if (ly:get-option 'delete-intermediate-files) - (for-each - (lambda (f) - (delete-file (string-append base "." f))) - intermediate)) - )) + (for-each (lambda (f) + (delete-file (string-append base "." f))) intermediate)))) (define-public (completize-formats formats) (define new-fmts '()) - (if (member "png" formats) (set! formats (cons "ps" formats))) (if (member "pdf" formats) (set! formats (cons "ps" formats))) - - (for-each - (lambda (x) - (if (member x formats) (set! new-fmts (cons x new-fmts)))) - '("tex" "dvi" "ps" "pdf" "png")) - + (for-each (lambda (x) + (if (member x formats) (set! new-fmts (cons x new-fmts)))) + '("tex" "dvi" "ps" "pdf" "png")) (uniq-list (reverse new-fmts))) (define (header-to-file file-name key value) diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm index 2d429886f3..11515f1dea 100644 --- a/scm/ps-to-png.scm +++ b/scm/ps-to-png.scm @@ -47,19 +47,16 @@ (read-string!/partial str port 0 max-length) str)) -(define (gulp-file nm len) - +(define-public (gulp-file file-name . max-size) ;; string routines barf when strlen() != string-length,. ;; which may happen as side effect of read-string!/partial. - - ; (gulp-port (open-file nm "r") len)) - (ly:gulp-file nm len)) - + ;; (gulp-port (open-file nm "r") len)) + (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 (get-bbox file-name) +(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\ @@ -71,7 +68,7 @@ -c quit 2>~S" file-name bbox)) (status (system cmd)) - (s (gulp-file d bbox 10240)) + (s (gulp-file bbox 10240)) (m (string-match BOUNDING_BOX_RE s))) (if m @@ -87,17 +84,12 @@ (begin (format (current-error-port) (_ "Invoking `~a'...") cmd) (newline (current-error-port)))) - - (set! status (system cmd)) - (if (not (= status 0)) (begin (format (current-error-port) (format #f (_ "~a exited with status: ~S") "GS" status)) - (if exit-on-error - (exit 1)))) - + (if exit-on-error (exit 1)))) status) (define (scale-down-image be-verbose factor file) @@ -106,39 +98,36 @@ (old (string-append file ".old"))) (rename-file file old) - (my-system be-verbose - #t - (format #f "convert -scale \"~a%\" -depth 8 ~a ~a" percentage old file)) - (delete-file old) - )) + (my-system + be-verbose #t + (format #f "convert -scale \"~a%\" -depth 8 ~a ~a" percentage old file)) + (delete-file old))) (define-public (ps-page-count ps-name) - (let* - ((byte-count 10240) - (header (gulp-file ps-name byte-count)) - (first-null (string-index header #\nul)) - (match (string-match "%%Pages: ([0-9]+)" - (if (number? first-null) - (substring header 0 first-null) - header)))) - - (if match - (string->number (match:substring match 1)) - 0))) + (let* ((byte-count 10240) + (header (gulp-file ps-name byte-count)) + (first-null (string-index header #\nul)) + (match (string-match "%%Pages: ([0-9]+)" + (if (number? first-null) + (substring header 0 first-null) + header)))) + (if match (string->number (match:substring match 1)) 0))) + +(define-public (ps-has-color ps-name) + (string-contains (gulp-file ps-name) " setrgbcolor")) (define-public (make-ps-images ps-name . rest) (let-keywords* rest #f - ((resolution 90) - (page-width 100) - (page-height 100) - (rename-page-1 #f) - (be-verbose #f) - (pixmap-format 'png16m) - (anti-alias-factor 1)) - - (let* ( - (format-str (format "~a" pixmap-format)) + ((resolution 90) + (page-width 100) + (page-height 100) + (rename-page-1 #f) + (be-verbose #f) + (pixmap-format 'png16m) + (anti-alias-factor 1)) + + (let* ((format-str (format "~a" pixmap-format)) (extension (cond ((string-contains format-str "png") "png") ((string-contains format-str "jpg") "jpeg") @@ -154,9 +143,9 @@ (gs-variable-options (if multi-page? - (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f" page-width page-height) + (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f" + page-width page-height) "-dEPSCrop")) - (cmd (format #f "~a\ ~a\ ~a\