Only use color in png if necessary.

diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc
index 142e7c2befa8179363c96a2ff10ea261faf655c1..5e031c07abbc0e2a790eb41b072f9daa7c9a7886 100644 (file)
--- 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 5258bcf516249978a06d25166fa46b6b50964dc4..02cd759ff9e608aba19f72fcd034a33eae2f5651 100644 (file)
--- 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 2d429886f30b24ffd0b3f7bef81250e351b9b0f5..11515f1dea47b6f89d9ab3c4159ec05ce1ff9e44 100644 (file)
--- 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\