+
+
+(define (clip-systems-to-region
+ basename paper systems region
+ do-pdf)
+
+ (let*
+ ((extents-system-pairs
+ (filtered-map
+ (lambda (paper-system)
+ (let*
+ ((x-ext (system-clipped-x-extent
+ (paper-system-system-grob paper-system)
+ region)))
+
+ (if x-ext
+ (cons x-ext paper-system)
+ #f)))
+
+ systems))
+ (count 0))
+
+ (for-each
+ (lambda (ext-system-pair)
+ (let*
+ ((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 (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)
+ filename
+ (ly:get-option 'include-eps-fonts)
+ bbox)
+
+ (if do-pdf
+ (postscript->pdf 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 (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*
+ ((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))))
+
+ ;; pass value.
+ system)
+
+ #f
+ systems)
+
+ (for-each
+ (lambda (system-list)
+ (clip-score-systems
+ (if (> count 0)
+ (format "~a-~a" basename count)
+ basename)
+ system-list))
+
+ score-system-list)))
+
+