X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-ps.scm;h=7ecfee560589ef91afb441f192cc623ac2de7b1b;hb=712e575fb12d02d58e04553a3474afb9f6d2391b;hp=c091a44f47759303f9d041e9b9db55ab7557166b;hpb=6140c6eb657080939fa4aef3d00d717bd85b5028;p=lilypond.git

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index c091a44f47..7ecfee5605 100644
--- 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)