X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fps-to-png.scm;fp=scm%2Fps-to-png.scm;h=948e56e145a5a4ea7a12f5e988c49cc2ef848afd;hb=0ac07f31e0f95fc18e5916ce756b9c746af7cc58;hp=5e78d0c7c0d3997267972f5d11053a3cc0d8bbb5;hpb=2f1263e2ccdddcac2eb9f7d8ce2ed92867d3d160;p=lilypond.git

diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 5e78d0c7c0..948e56e145 100644
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -42,9 +42,9 @@
 (define (search-executable names)
   (define (helper path lst)
     (if (null? (cdr lst))
-	(car lst)
-	(if (search-path path (car lst)) (car lst)
-	    (helper path (cdr lst)))))
+        (car lst)
+        (if (search-path path (car lst)) (car lst)
+            (helper path (cdr lst)))))
 
   (let ((path (parse-path (getenv "PATH"))))
     (helper path names)))
@@ -67,33 +67,33 @@
   (set! status (system cmd))
   (if (not (= status 0))
       (begin
-	(ly:error (_ "~a exited with status: ~S") "GS" status)
-	(if exit-on-error (exit 1))))
+        (ly:error (_ "~a exited with status: ~S") "GS" status)
+        (if exit-on-error (exit 1))))
   status)
 
 (define (scale-down-image be-verbose factor file)
   (define (with-pbm)
     (let* ((status 0)
-	   (old (string-append file ".old")))
-      
+           (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))
+               "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)
-	 (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))))
+         (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 (make-ps-images ps-name . rest)
@@ -108,25 +108,27 @@
     (anti-alias-factor 1))
 
    (let* ((format-str (format #f "~a" pixmap-format))
-	  (extension (cond
-		      ((string-contains format-str "png") "png")
-		      ((string-contains format-str "jpg") "jpeg")
-		      ((string-contains format-str "jpeg") "jpeg")
-		      (else
-		       (ly:error "Unknown pixmap format ~a" pixmap-format))))
-	  (base (dir-basename ps-name ".ps" ".eps"))
-	  (png1 (format #f "~a.~a" base extension))
-	  (pngn (format #f "~a-page%d.~a" base extension))
-	  (page-count (ps-page-count ps-name))
-	  (multi-page? (> page-count 1))
-	  (output-file (if multi-page? pngn png1))
-
-	  (gs-variable-options
-	    (if (string-suffix-ci? ".eps" ps-name)
-		"-dEPSCrop"
-		(format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f"
-			page-width page-height)))
-	  (cmd (ly:format "~a\
+          (extension (cond
+                      ((string-contains format-str "png") "png")
+                      ((string-contains format-str "jpg") "jpeg")
+                      ((string-contains format-str "jpeg") "jpeg")
+                      (else
+                       (ly:error "Unknown pixmap format ~a" pixmap-format))))
+          (base (string-join
+                 (string-split (dir-basename ps-name ".ps" ".eps") #\%)
+                 "%%"))
+          (png1 (format #f "~a.~a" base extension))
+          (pngn (format #f "~a-page%d.~a" base extension))
+          (page-count (ps-page-count ps-name))
+          (multi-page? (> page-count 1))
+          (output-file (if multi-page? pngn png1))
+
+          (gs-variable-options
+           (if (string-suffix-ci? ".eps" ps-name)
+               "-dEPSCrop"
+               (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f"
+                       page-width page-height)))
+          (cmd (ly:format "~a\
  ~a\
  ~a\
  -dGraphicsAlphaBits=4\
@@ -137,46 +139,46 @@
  -r~a\
  ~S\
  -c quit"
-		       (search-gs)
-		       (if be-verbose "" "-q")
-		       gs-variable-options
-		       pixmap-format
-		       output-file 
-		       (* anti-alias-factor resolution) ps-name))
-	  (status 0)
-	  (files '()))
+                          (search-gs)
+                          (if be-verbose "" "-q")
+                          gs-variable-options
+                          pixmap-format
+                          output-file
+                          (* anti-alias-factor resolution) ps-name))
+          (status 0)
+          (files '()))
 
      ;; The wrapper on windows cannot handle `=' signs,
      ;; gs has a workaround with #.
      (if (eq? PLATFORM 'windows)
-	 (begin
-	   (set! cmd (re-sub "=" "#" cmd))
-	   (set! cmd (re-sub "-dSAFER " "" cmd))))
+         (begin
+           (set! cmd (re-sub "=" "#" cmd))
+           (set! cmd (re-sub "-dSAFER " "" cmd))))
 
      (set! status (my-system be-verbose #f cmd))
 
      (set! files
-	   (if multi-page?
-	       (map
-		(lambda (n)
-		  (format #f "~a-page~a.png" base (1+ n)))
-		(iota page-count))
-	       (list (format #f "~a.png" base))))
-     
+           (if multi-page?
+               (map
+                (lambda (n)
+                  (format #f "~a-page~a.png" base (1+ n)))
+                (iota page-count))
+               (list (format #f "~a.png" base))))
+
      (if (not (= 0 status))
-	 (begin
-	   (map delete-file files)
-	   (exit 1)))
+         (begin
+           (for-each delete-file files)
+           (exit 1)))
 
      (if (and rename-page-1 multi-page?)
-	 (begin
-	   (rename-file (re-sub "%d" "1" pngn) png1)
-	   (set! files
-		 (cons png1
-		       (cdr files)))
-	   ))
+         (begin
+           (rename-file (re-sub "%d" "1" pngn) png1)
+           (set! files
+                 (cons png1
+                       (cdr files)))
+           ))
 
      (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)))