Merge branch 'lilypond/translation' of ssh://git.sv.gnu.org/srv/git/lilypond

[lilypond.git] / scm / framework-ps.scm

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index c091a44f47759303f9d041e9b9db55ab7557166b..7ecfee560589ef91afb441f192cc623ac2de7b1b 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -1,8 +1,19 @@
-;;;; framework-ps.scm -- structure for PostScript output
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
+;;;; Copyright (C) 2004--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
-;;;; (c) 2004--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; 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 framework-ps))
 
@@ -345,7 +356,7 @@
                  (else
                   (ly:warning (_ "do not know how to embed font ~s ~s ~s")
                               name file-name font))))))
-       
+
   (define (load-fonts paper)
     (let* ((fonts (ly:paper-fonts paper))
 
@@ -509,7 +520,7 @@ fonts inline."
     (display "stroke grestore\n%%Trailer\n%%EOF\n" port)
     (ly:outputter-close outputter)))
 
-(define (clip-systems-to-region basename paper systems region do-pdf)
+(define (clip-systems-to-region basename paper systems region do-pdf do-png)
   (let* ((extents-system-pairs
          (filtered-map (lambda (paper-system)
                          (let* ((x-ext (system-clipped-x-extent
@@ -537,12 +548,17 @@ fonts inline."
                                        (ly:get-option 'include-eps-fonts)
                                        bbox)
         (if do-pdf
-            (postscript->pdf 0 0 (format "~a.eps" filename)))))
+            (postscript->pdf 0 0 (format "~a.eps" filename)))
+        (if do-png
+            (postscript->png (ly:get-option 'resolution) 0 0
+                             (format "~a.eps" filename)))))
      extents-system-pairs)))
 
 (define-public (clip-system-EPSes basename paper-book)
   (define do-pdf
     (member "pdf" (ly:output-formats)))
+  (define do-png
+    (member "png" (ly:output-formats)))
 
   (define (clip-score-systems basename systems)
     (let* ((layout (ly:grob-layout (paper-system-system-grob (car systems))))
@@ -555,7 +571,7 @@ fonts inline."
                  (rhythmic-location->file-string (car region))
                  (rhythmic-location->file-string (cdr region)))
          layout systems region
-         do-pdf))
+         do-pdf do-png))
        regions)))
 
   ;; partition in system lists sharing their layout blocks
@@ -575,11 +591,13 @@ fonts inline."
      #f
      systems)
     (for-each (lambda (system-list)
-               (clip-score-systems
-                (if (> count 0)
-                    (format "~a-~a" basename count)
-                    basename)
-                system-list))
+               ;; filter out headers and top-level markup
+               (if (pair? system-list)
+                   (clip-score-systems
+                    (if (> count 0)
+                        (format "~a-~a" basename count)
+                        basename)
+                    system-list)))
              score-system-list)))
 
 (define-public (output-preview-framework basename book scopes fields)