(clip-system-EPSes): change ordering, so

system-count starts at 0 for each clip-region. Change name to
file-FROM-TO-clip-COUNT. Take clip-regions from layout block, per
score.

diff --git a/ChangeLog b/ChangeLog
index fdf468055b661fcfe2d9f8afbfafc69295fa2135..d79178e76a199e933770850471b6b4344eb9d76f 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-10-13  Han-Wen Nienhuys  <hanwen@lilypond.org>
+
+       * scm/framework-ps.scm (clip-system-EPSes): change ordering, so
+       system-count starts at 0 for each clip-region. Change name to
+       file-FROM-TO-clip-COUNT. Take clip-regions from layout block, per
+       score.
+
 2006-10-13  Erik Sandberg  <mandolaerik@gmail.com>
 
        * lily/input-smob.cc: add equal_p for Input
@@ -31,6 +38,8 @@
 
 2006-10-12  Han-Wen Nienhuys  <hanwen@lilypond.org>
 
+       * VERSION: release 2.9.23
+
        * lily/paper-column-engraver.cc (stop_translation_timestep): also
        typecheck barnumber.
 

diff --git a/scm/clip-region.scm b/scm/clip-region.scm
index ce1bd4d66baa37a6790598d0139acb3171ded580..eaf473058af7371ed6c0aabbe40ae9cfb0e0841e 100644 (file)
--- a/scm/clip-region.scm
+++ b/scm/clip-region.scm
@@ -63,6 +63,13 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  Actual clipping logic.
 
+;;
+;; the total of this will be
+;; O(#systems * #regions)
+;; 
+;; we can actually do better by sorting the regions as well,
+;; but let's leave that for future extensions.
+;;
 (define-public (system-clipped-x-extent system-grob clip-region)
   "Return the X-extent of the SYSTEM-GROB when clipped with
 CLIP-REGION. Return #f if not appropriate."

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 8cb0d3610bf8b32ef3534d05315da05214c1097d..fbab6a03a2ea9001c1ffb3bad39800a528bb1bb8 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -553,35 +553,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 +597,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))

diff --git a/scm/paper-system.scm b/scm/paper-system.scm
index d3a140531fac845276815dc18dccb11426bbdac3..55e48ebed8dd402a2ad29b5a7388753667c33b8e 100644 (file)
--- a/scm/paper-system.scm
+++ b/scm/paper-system.scm
@@ -17,6 +17,14 @@
 (define-public (paper-system-stencil system)
   (ly:prob-property system 'stencil))
 
+(define-public (paper-system-layout system)
+  (let*
+      ((g (paper-system-system-grob system)))
+
+    (if (ly:grob? g)
+       (ly:grob-layout  g)
+       #f)))
+
 (define-public (paper-system-system-grob paper-system)
   (ly:prob-property paper-system 'system-grob))
 
@@ -150,4 +158,4 @@
                (ly:stencil-expr annotations)
                (ly:stencil-extent empty-stencil X)
                (ly:stencil-extent empty-stencil Y)))))
-    (ly:prob-property system 'stencil)))
\ No newline at end of file
+    (ly:prob-property system 'stencil)))