Add system-by-system output to SVG backend (issue 323440043 by address@hidden)

[beauleetienne0]

Reviewers: ,

Message:
This is the next step towards the use of the SVG backend for
lilypond-book use.

Description:
Add system-by-system output to SVG backend

This change enables the output of separate files for each system of
music. In addition, snippet (-dclip-systems) functionality has been
added to the backend.

For consistency with other backends, the page suffix is reduced from
"-page-~a" to simply "-~a".

Please review this at https://codereview.appspot.com/323440043/

Affected files (+87, -1 lines):
  M Documentation/changes.tely
  M scm/framework-svg.scm


Index: Documentation/changes.tely
diff --git a/Documentation/changes.tely b/Documentation/changes.tely
index  
3428a084944f3585bfbeef417e229c8ec3bdaa19..366168f17f95e036add62add31c87e09901f4dd1  
100644
--- a/Documentation/changes.tely
+++ b/Documentation/changes.tely
@@ -62,6 +62,10 @@ which scares away people.
 @end ignore

 @item
+The @code{output-classic-framework} procedure and the @code{-dclip-systems}
+are now available with the @code{SVG} backend.
+
address@hidden
 An argument, @code{-dcrop}, has been added, formatting @code{SVG} and
 @code{PDF} output without margins or page-breaks.

Index: scm/framework-svg.scm
diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index  
85cbe1c2c11bb52a4473a6757de4b150819a525b..23167305f47664146c3b5383ce3ece6fbe723d63  
100644
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -37,6 +37,7 @@
  (scm page)
  (scm paper-system)
  (scm output-svg)
+ (scm clip-region)
  (srfi srfi-1)
  (srfi srfi-2)
  (srfi srfi-13)
@@ -170,6 +171,68 @@ src: url('~a');
     (dump (svg-end))
     (ly:outputter-close outputter)))

+(define (clip-systems-to-region basename paper systems region)
+  (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* ((paper-system (cdr ext-system-pair))
+              (filename (if (< 0 count)
+                            (format #f "~a-~a.svg" basename count)
+                            (string-append basename ".svg"))))
+         (set! count (1+ count))
+         (dump-preview paper
+                       (paper-system-stencil paper-system)
+                       filename)))
+     extents-system-pairs)))
+
+(define (clip-system-SVG basename paper-book)
+  (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 #f "~a-from-~a-to-~a-clip"
+                  basename
+                  (rhythmic-location->file-string (car region))
+                  (rhythmic-location->file-string (cdr region)))
+          layout systems region))
+       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)
+                ;; filter out headers and top-level markup
+                (if (pair? system-list)
+                    (clip-score-systems
+                     (if (> count 0)
+                         (format #f "~a-~a" basename count)
+                         basename)
+                     system-list)))
+              score-system-list)))

 (define (output-framework basename book scopes fields)
   (let* ((paper (ly:paper-book-paper book))
@@ -178,7 +241,25 @@ src: url('~a');
          (page-count (length page-stencils))
          (filename "")
          (file-suffix (lambda (num)
-                        (if (= page-count 1) "" (format #f "-page-~a"  
num)))))
+                        (if (= page-count 1) "" (format #f "-~a" num)))))
+    (if (ly:get-option 'clip-systems) (clip-system-SVG basename book))
+    (for-each
+     (lambda (page)
+       (set! page-number (1+ page-number))
+       (set! filename (format #f "~a~a.svg"
+                              basename
+                              (file-suffix page-number)))
+       (dump-page paper filename page page-number page-count))
+     page-stencils)))
+
+(define-public (output-classic-framework basename book scopes fields)
+  (let* ((paper (ly:paper-book-paper book))
+         (page-stencils (map paper-system-stencil (ly:paper-book-systems  
book)))
+         (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
+         (page-count (length page-stencils))
+         (filename "")
+         (file-suffix (lambda (num)
+                        (if (= page-count 1) "" (format #f "-~a" num)))))
     (for-each
      (lambda (page)
        (set! page-number (1+ page-number))
@@ -204,4 +285,5 @@ src: url('~a');
          (page-stencils (stack-stencils Y DOWN 0.0
                                         (map paper-system-stencil
                                              (reverse (reverse  
systems))))))
+    (if (ly:get-option 'clip-systems) (clip-system-SVG basename book))
     (dump-preview paper page-stencils (format #f "~a.cropped.svg"  
basename))))