]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/ps-to-png.scm
Revert "Apply scripts/auxiliar/fixscm.sh"
[lilypond.git] / scm / ps-to-png.scm
index 0becaeef97dcecbe595f174f305968fc22bc3bb1..5e78d0c7c0d3997267972f5d11053a3cc0d8bbb5 100644 (file)
@@ -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)))
   (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)
     (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 (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\
  -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
+          (map 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)))