coding style nits

[lilypond.git] / scm / ps-to-png.scm

diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 11515f1dea47b6f89d9ab3c4159ec05ce1ff9e44..9959afdbfe6f48b24da675dfbdc713c7dc61f23a 100644 (file)
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -48,9 +48,6 @@
     str))
 
 (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 file-name (if (pair? max-size) (car max-size))))
 
 (define BOUNDING-BOX-RE
@@ -93,15 +90,19 @@
   status)
 
 (define (scale-down-image be-verbose factor file)
-  (let* ((status 0)
-        (percentage (* 100 (/ 1.0 factor)))
-        (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)))
+  (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)
@@ -113,9 +114,6 @@
                                  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
@@ -197,7 +195,6 @@
           ))
 
      (if (not (= 1 anti-alias-factor))
-        (for-each  (lambda (f) (scale-down-image be-verbose anti-alias-factor f))
-                   files))
-
+        (for-each
+         (lambda (f) (scale-down-image be-verbose anti-alias-factor f)) files))
      files)))