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 @@
"<" "<"
(string-regexp-substitute "&" "&" string))))
(fontify pango-font-description
- (entity 'tspan escaped-string))))
+ (entity 'tspan escaped-string #f))))
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-devel