Fix #287.

[lilypond.git] / scm / backend-library.scm

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index df1314679c7184f41ae01d7b90c1939c0833d2cf..eaefaf786752821a525cdfa406a353cbac0e18c9 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -3,7 +3,7 @@
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
 ;;;; (c) 2005--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
 ;;;; (c) 2005--2006 Jan Nieuwenhuizen <janneke@gnu.org>

-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; backend helpers.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; backend helpers.


@@ -47,16 +47,25 @@
 (define-public (search-gs)
   
   ;; must be sure that we don't catch stuff from old GUBs.
 (define-public (search-gs)
   
   ;; must be sure that we don't catch stuff from old GUBs.

-  (search-executable '("gs"))
+  (search-executable '("gs")))
+  
+(define-public (postscript->pdf paper-width paper-height name)
+  (let* ((pdf-name (string-append
+                   (basename (basename name ".ps") ".eps")
+                   ".pdf"))
+        (is-eps (string-match "\\.eps$" name))
+        (paper-size-string (if is-eps
+                               " -dEPSCrop "
+                               (format "-dDEVICEWIDTHPOINTS=~,2f \
+-dDEVICEHEIGHTPOINTS=~,2f "
+                                       paper-width paper-height )))

 
 

-(define-public (postscript->pdf papersizename name)
-  (let* ((pdf-name (string-append (basename name ".ps") ".pdf"))

         (cmd (format #f
                      "~a\
  ~a\
  ~a\
         (cmd (format #f
                      "~a\
  ~a\
  ~a\

+ ~a\

  -dCompatibilityLevel=1.4 \
  -dCompatibilityLevel=1.4 \

- -sPAPERSIZE=~a\

  -dNOPAUSE\
  -dBATCH\
  -r1200 \
  -dNOPAUSE\
  -dBATCH\
  -r1200 \


@@ -67,10 +76,10 @@
 "
                      (search-gs)
                      (if (ly:get-option 'verbose) "" "-q")
 "
                      (search-gs)
                      (if (ly:get-option 'verbose) "" "-q")

-                     (if (ly:get-option 'gs-font-load)
+                     (if (ly:get-option 'gs-load-fonts)

                          " -dNOSAFER "
                          " -dSAFER ")
                          " -dNOSAFER "
                          " -dSAFER ")

-                     (sanitize-command-option papersizename)
+                     paper-size-string

                      pdf-name
                      name)))
     ;; The wrapper on windows cannot handle `=' signs,
                      pdf-name
                      name)))
     ;; The wrapper on windows cannot handle `=' signs,


@@ -85,59 +94,49 @@
 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")
 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")

-    (ly:system cmd)
-    ))
+    (ly:system cmd)))

 
 (use-modules (scm ps-to-png))
 
 
 (use-modules (scm ps-to-png))
 

-(define-public (postscript->png resolution paper-size-name name)
+(define-public (postscript->png resolution paper-width paper-height name)

     ;; Do not try to guess the name of the png file,
     ;; GS produces PNG files like BASE-page%d.png.
     ;;(ly:message (_ "Converting to `~a'...")
     ;;     (string-append (basename name ".ps") "-page1.png" )))
     ;; Do not try to guess the name of the png file,
     ;; GS produces PNG files like BASE-page%d.png.
     ;;(ly:message (_ "Converting to `~a'...")
     ;;     (string-append (basename name ".ps") "-page1.png" )))

-  (let ((paper-size (sanitize-command-option paper-size-name))
-       (verbose (ly:get-option 'verbose))
-       (rename-page-1 #f))
-
+  (let* ((verbose (ly:get-option 'verbose))
+        (rename-page-1 #f))

     (ly:message (_ "Converting to ~a...") "PNG")
     (ly:message (_ "Converting to ~a...") "PNG")

-    (make-ps-images name resolution paper-size rename-page-1 verbose
-                   (ly:get-option 'anti-alias-factor))
+    (make-ps-images name
+                   #:resolution resolution
+                   #: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))

     (ly:progress "\n")))
 
 (define-public (postprocess-output paper-book module filename formats)
     (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 (string-append "convert-to-" 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)
     (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 '())
 
 (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)))
   (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)
   (uniq-list (reverse new-fmts)))
 
 (define (header-to-file file-name key value)


@@ -149,7 +148,10 @@
              (if (equal? "-" file-name) "<stdout>" file-name))
   (if (equal? file-name "-")
       (display value)
              (if (equal? "-" file-name) "<stdout>" file-name))
   (if (equal? file-name "-")
       (display value)

-      (display value (open-file file-name "w")))
+      (let ((port (open-file file-name "w")))
+       (display value port)
+       (close-port port)))
+

   (ly:progress "\n")
   "")
 
   (ly:progress "\n")
   "")