X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fps-to-png.scm;h=529d405d9a44d63b63119a6cbd389306000f4a4b;hb=7b215091cc974bd45e068563c826f77bd9faea9b;hp=19473b9a638fa08c559bbffb319a7693edaa7207;hpb=1759a10e0e322868d2eefb13ebd13b047c6afd55;p=lilypond.git

diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 19473b9a63..529d405d9a 100644
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -1,8 +1,19 @@
-;;;; ps-to-png.scm --
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2005--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 2005--2009 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (scm ps-to-png))
 
@@ -48,35 +59,8 @@
     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
-  "^%%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)
@@ -93,18 +77,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
-     ;; convert -scale creates (a large rgb) png from a grayscale
-     ;; (format #f "convert -scale \"~a%\" -depth 8 ~a ~a" percentage old file))
-
-     (format #f "pngtopnm ~a | pnmscale -reduce ~a | pnmtopng > ~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)
@@ -116,9 +101,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
@@ -126,7 +108,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))
 
@@ -137,7 +119,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))
@@ -149,7 +131,7 @@
 	       (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f"
 		       page-width page-height)
 	       "-dEPSCrop"))
-	  (cmd (format #f "~a\
+	  (cmd (ly:format "~a\
  ~a\
  ~a\
  -dGraphicsAlphaBits=4\
@@ -157,7 +139,7 @@
  -dNOPAUSE\
  -sDEVICE=~a\
  -sOutputFile=~S\
- -r~S\
+ -r~a\
  ~S\
  -c quit"
 		       (search-gs)