X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-ps.scm;h=f06424d72ca3cb844198947baa762732008891ad;hb=3ee0df13c3fe001cef0bef15adcbadfb2c394fd8;hp=8cb0d3610bf8b32ef3534d05315da05214c1097d;hpb=ab0d9d4f66ccb02968443b5cd3af2d1a880c55c8;p=lilypond.git

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 8cb0d3610b..f06424d72c 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -409,7 +409,6 @@
 	     (sort (apply append all-font-names)
 		   (lambda (x y) (string<? (cadr x) (cadr y))))))
 
-
 	   (font-loader (if (ly:get-option 'gs-load-fonts)
 			    load-font-via-GS
 			    load-font))
@@ -488,7 +487,7 @@
   (let*
       ((xext (ly:stencil-extent dump-me X))
        (yext (ly:stencil-extent dump-me Y))
-       (left-overshoot -3)
+       (left-overshoot (ly:get-option 'eps-box-padding))
        (bbox
 	(map
 	 (lambda (x)
@@ -503,7 +502,7 @@
 	   ;;
 	   (list
 	    
-	    (if (ly:get-option 'pad-eps-boxes) 
+	    (if (number? left-overshoot)
 		(min left-overshoot (car xext))
 		(car xext))
 	    (car yext) (cdr xext) (cdr yext)))))
@@ -553,35 +552,39 @@
 
 
 
-(define (clip-system-EPS basename paper paper-system clip-regions
-			 do-pdf)
+(define (clip-systems-to-region
+	 basename paper systems region
+	 do-pdf)
 
   (let*
-      ((system-grob (paper-system-system-grob paper-system))
-       (extents-region-pairs
+      ((extents-system-pairs
 	(filtered-map
-	 (lambda (region)
+	 (lambda (paper-system)
 	   (let*
-	       ((x-ext (system-clipped-x-extent system-grob region)))
+	       ((x-ext (system-clipped-x-extent
+			(paper-system-system-grob paper-system)
+			region)))
 
 	     (if x-ext
-		 (cons x-ext region)
+		 (cons x-ext paper-system)
 		 #f)))
 	 
-	 clip-regions)))
+	 systems))
+       (count 0))
     
     (for-each
-     (lambda (ext-region-pair)
+     (lambda (ext-system-pair)
        (let*
-	   ((xext (car ext-region-pair))
-	    (region (cdr ext-region-pair))
+	   ((xext (car ext-system-pair))
+	    (paper-system (cdr ext-system-pair))
 	    (yext (paper-system-extent paper-system Y))
 	    (bbox (list (car  xext) (car yext)
 			(cdr xext) (cdr yext)))
-	    (filename (format "~a-clip-~a-~a" basename
-			      (rhythmic-location->file-string (car region))
-			      (rhythmic-location->file-string (cdr region)))))
+	    (filename (if (< 0 count)
+			  (format "~a-~a" basename count)
+			  basename)))
 
+	 (set! count (1+ count))
 	 (dump-stencil-as-EPS-with-bbox
 	  paper
 	  (paper-system-stencil paper-system)
@@ -593,32 +596,65 @@
 	     (postscript->pdf  0 0  (format "~a.eps" filename)))
 	 ))
 
-     extents-region-pairs)
-    
-    
+     extents-system-pairs)
     ))
 
+
 (define (clip-system-EPSes basename paper-book)
+  (define do-pdf (member  "pdf" (ly:output-formats)))
+
+  (define (clip-score-systems basename systems)
+    (let*
+	((layout (ly:grob-layout (paper-system-system-grob (car systems))))
+	 (regions (ly:output-def-lookup layout 'clip-regions)))
+      
+      (for-each
+       (lambda (region)
+	 (clip-systems-to-region
+	  (format "~a-from-~a-to-~a-clip"
+		  basename
+		  (rhythmic-location->file-string (car region))
+		  (rhythmic-location->file-string (cdr region)))
+	  layout systems region
+	  do-pdf))
+       
+       regions)))
+  
+
+  ;; partition in system lists sharing their layout blocks
   (let*
-      ((paper-def  (ly:paper-book-paper paper-book))
-       (do-pdf (member  "pdf" (ly:output-formats)))
+      ((systems (ly:paper-book-systems paper-book))
+       (count 0)
+       (score-system-list '()))
+
+    (fold 
+     (lambda (system last-system)
+    
+       
+       (if (not (and last-system
+		     (equal? (paper-system-layout last-system)
+			     (paper-system-layout system))))
+	   (set! score-system-list (cons '() score-system-list)))
+       
+       (if (paper-system-layout system)
+	   (set-car! score-system-list (cons system (car score-system-list))))
 
-       (regions
-	(ly:output-def-lookup paper-def
-			      'clip-regions))
-       (count 1)
-       (systems
-	(ly:paper-book-systems paper-book)))
+       ;; pass value.
+       system)
+
+     #f 
+     systems)
 
     (for-each
-     (lambda (system)
-       (clip-system-EPS
-	(format "~a-system-~a" basename count) paper-def system regions
-	do-pdf)
-       (set! count (1+ count))
-
-       )
-     systems)))
+     (lambda (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)
   (let* ((paper (ly:paper-book-paper book))