Issue 1434: Fix text spacing in SVG (issue 321460043 by address@hidden)

[beauleetienne0]

Reviewers: pkx, dak,

Message:
This patch provides a more thorough solution to the spacing problem than
my other patch, specifically for metronome marks:
https://codereview.appspot.com/323420043/ .

Description:
Issue 1434: Fix text spacing in SVG

This change makes every SVG contain a style tag with the `white-space`
property set to include all white-space (`pre`). This will cause all
white-space to be applied, and not be ignored.

As SVG files with `-dsvg-woff` set already appended a style tag, the
woff-header now only appends their settings, with a new define to close
the style tag.

The main difficulty arising with this change was with the newline
character that appears after each opening tag. To rectify, a boolean
parameter was added to define(s) on whether to insert a newline for
opening tags, and the appropriate value was passed to all uses of the
define(s).

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

Affected files (+47, -41 lines):
  M scm/framework-svg.scm
  M scm/output-svg.scm


Index: scm/framework-svg.scm
diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index  
85cbe1c2c11bb52a4473a6757de4b150819a525b..e82912c0be9b437b63f03a1b87e54089504ec4cc  
100644
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -45,15 +45,20 @@
 (define format ergonomic-simple-format)

 (define (svg-begin . rest)
-  (eo 'svg
-      '(xmlns . "http://www.w3.org/2000/svg";)
-      '(xmlns:xlink . "http://www.w3.org/1999/xlink";)
-      '(version . "1.2")
-      `(width . ,(ly:format "~2fmm" (first rest)))
-      `(height . ,(ly:format "~2fmm" (second rest)))
-      `(viewBox . ,(ly:format "~4f ~4f ~4f ~4f"
-                              (third rest) (fourth rest)
-                              (fifth rest) (sixth rest)))))
+  (string-append
+    (eo 'svg #t
+        '(xmlns . "http://www.w3.org/2000/svg";)
+        '(xmlns:xlink . "http://www.w3.org/1999/xlink";)
+        '(version . "1.2")
+        `(width . ,(ly:format "~2fmm" (first rest)))
+        `(height . ,(ly:format "~2fmm" (second rest)))
+        `(viewBox . ,(ly:format "~4f ~4f ~4f ~4f"
+                                (third rest) (fourth rest)
+                                (fifth rest) (sixth rest))))
+    (eo 'style #t '(text . "style/css"))
+     "<![CDATA[
+tspan { white-space: pre; }
+"))

 (define (svg-end)
   (ec 'svg))
@@ -96,22 +101,19 @@ src: url('~a');
            font-name url))
         "")))

+(define (style-defs-end)
+  (string-append
+   "]]>
+"
+   (ec 'style)))
+
 (define (woff-header paper dir)
   "TODO:
       * add (ly:version) to font name
       * copy woff font with version alongside svg output
 "
   (set! output-dir dir)
-  (string-append
-   (eo 'defs)
-   (eo 'style '(text . "style/css"))
-   "<![CDATA[
-"
-   (define-fonts paper svg-define-font svg-define-font)
-   "]]>
-"
-   (ec 'style)
-   (ec 'defs)))
+  (define-fonts paper svg-define-font svg-define-font))

 (define (dump-page paper filename page page-number page-count)
   (let* ((outputter (ly:make-paper-outputter (open-file  
filename "wb") 'svg))
@@ -132,6 +134,7 @@ src: url('~a');
         (module-remove! (ly:outputter-module outputter) 'paper))
     (if (ly:get-option 'svg-woff)
         (dump (woff-header paper (dirname filename))))
+    (dump (style-defs-end))
     (dump (comment (format #f "Page: ~S/~S" page-number page-count)))
     (ly:outputter-output-scheme outputter
                                 `(begin (set!  
lily-unit-length ,unit-length)
@@ -163,6 +166,7 @@ src: url('~a');
         (module-remove! (ly:outputter-module outputter) 'paper))
     (if (ly:get-option 'svg-woff)
         (dump (woff-header paper (dirname filename))))
+    (dump (style-defs-end))
     (ly:outputter-output-scheme outputter
                                 `(begin (set!  
lily-unit-length ,unit-length)
                                         ""))
Index: scm/output-svg.scm
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index  
653664122cd5d20befb84ed84fa4147ec6690840..1e89fccfb5aeb79732bccb9588bef8a6fa1b42ec  
100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -49,9 +49,11 @@
             (format #f " ~s=\"~a\"" attr value)))
         attributes-alist)))

-(define-public (eo entity . attributes-alist)
+(define-public (eo entity tNewline . attributes-alist)
   "o = open"
-  (format #f "<~S~a>\n" entity (attributes attributes-alist)))
+  (format #f "<~S~a>~a" entity
+                      (attributes attributes-alist)
+                      (if tNewline "\n" "")))

 (define-public (eoc entity . attributes-alist)
   "oc = open/close"
@@ -75,11 +77,11 @@
 (define-public (comment s)
   (string-append "<!-- " s " -->\n"))

-(define-public (entity entity string . attributes-alist)
+(define-public (entity entity string tNewline . attributes-alist)
   (if (string-null? string)
       (apply eoc entity attributes-alist)
       (string-append
-       (apply eo entity attributes-alist) string (ec entity))))
+       (apply eo entity tNewline attributes-alist) string (ec entity))))

 (define (offset->point o)
   (ly:format "~4f ~4f" (car o) (- (cdr o))))
@@ -152,7 +154,7 @@
           (set-attribute 'fill "currentColor"))
         (ly:warning (_ "cannot decypher Pango description: ~a") str))

-    (apply entity 'text expr (reverse! alist))))
+    (apply entity 'text expr #t (reverse! alist))))

 (define (dump-path path scale . rest)
   (define alist '())
@@ -178,7 +180,7 @@

   (set-attribute 'd path)
   (set-attribute 'fill "currentColor")
-  (apply entity 'path "" (reverse alist)))
+  (apply entity 'path "" #t (reverse alist)))


 ;; A global variable for keeping track of the *cumulative*
@@ -310,7 +312,7 @@
       (set! alist (assoc-set! alist attr val)))
     (set-attribute 'font-family name-style)
     (set-attribute 'font-size scaled-size)
-    (apply entity 'text text (reverse! alist))))
+    (apply entity 'text text #t (reverse! alist))))

 (define font-smob-to-text
   (if (not (ly:get-option 'svg-woff))
@@ -326,11 +328,11 @@
 ;;;

 (define (char font i)
-  (fontify font (entity 'tspan (char->entity (integer->char i)))))
+  (fontify font (entity 'tspan (char->entity (integer->char i)) #f)))

 (define (circle radius thick is-filled)
   (entity
-   'circle ""
+   'circle "" #f
    '(stroke-linejoin . "round")
    '(stroke-linecap . "round")
    `(fill . ,(if is-filled "currentColor" "none"))
@@ -343,7 +345,7 @@
              `(stroke-dasharray . ,(format #f "~a,~a" on off))))

 (define (draw-line thick x1 y1 x2 y2 . alist)
-  (apply entity 'line ""
+  (apply entity 'line "" #t
          (append
           `((stroke-linejoin . "round")
             (stroke-linecap . "round")
@@ -357,7 +359,7 @@

 (define (ellipse x-radius y-radius thick is-filled)
   (entity
-   'ellipse ""
+   'ellipse "" #t
    '(stroke-linejoin . "round")
    '(stroke-linecap . "round")
    `(fill . ,(if is-filled "currentColor" "none"))
@@ -385,7 +387,7 @@
                  (* start-radius (sin new-start-angle)))))
     (if (and (< (abs x-end) epsilon) (< (abs y-end) epsilon))
         (entity
-         'ellipse ""
+         'ellipse "" #t
          `(fill . ,(if fill "currentColor" "none"))
          `(stroke . "currentColor")
          `(stroke-width . ,thick)
@@ -396,7 +398,7 @@
          `(rx . ,x-radius)
          `(ry . ,y-radius))
         (entity
-         'path ""
+         'path "" #t
          `(fill . ,(if fill "currentColor" "none"))
          `(stroke . "currentColor")
          `(stroke-width . ,thick)
@@ -429,7 +431,7 @@
       (set! path (music-string-to-path font size (car glyphs)))
       (begin
         (set! path
-              (string-append (eo 'g)
+              (string-append (eo 'g #t)
                              (string-join
                               (map (lambda (x)
                                      (music-string-to-path font size x))
@@ -495,13 +497,13 @@
                      (file (if (is-absolute? raw-file)
                                raw-file
                                (string-append (ly-getcwd) "/" raw-file))))
-
+
                 (ly:format "<a style=\"color:inherit;\"  
xlink:href=\"textedit://~a:~a:~a:~a\">\n"
                            ;; Backslashes are not valid
                            ;; file URI path separators.
                            (ly:string-percent-encode
                             (ly:string-substitute "\\" "/" file))
-
+
                            (cadr location)
                            (caddr location)
                            (1+ (cadddr location))))))))
@@ -551,7 +553,7 @@
                                        (symbol->string join))
                            'round)
                          join)))
-    (entity 'path ""
+    (entity 'path "" #t
             `(stroke-width . ,thick)
             `(stroke-linejoin . ,(symbol->string join-style))
             `(stroke-linecap . ,(symbol->string cap-style))
@@ -583,7 +585,7 @@

 (define (polygon coords blot-diameter is-filled)
   (entity
-   'polygon ""
+   'polygon "" #t
    '(stroke-linejoin . "round")
    '(stroke-linecap . "round")
    `(stroke-width . ,blot-diameter)
@@ -603,7 +605,7 @@

 (define (round-filled-box breapth width depth height blot-diameter)
   (entity
-   'rect ""
+   'rect "" #t
    ;; The stroke will stick out.  To use stroke,
    ;; the stroke-width must be subtracted from all other dimensions.
    ;;'(stroke-linejoin . "round")
@@ -633,11 +635,11 @@
              x y))

 (define (text font string)
-  (fontify font (entity 'tspan (string->entities string))))
+  (fontify font (entity 'tspan (string->entities string) #f)))

 (define (url-link url x y)
   (string-append
-   (eo 'a `(xlink:href . ,url))
+   (eo 'a #t `(xlink:href . ,url))
    (eoc 'rect
         `(x . ,(car x))
         `(y . ,(car y))
@@ -653,4 +655,4 @@
                          "<" "&lt;"
                          (string-regexp-substitute "&" "&amp;" string))))
     (fontify pango-font-description
-             (entity 'tspan escaped-string))))
+             (entity 'tspan escaped-string #f))))