From: Patrick McCarty Date: Tue, 14 Jul 2009 01:22:13 +0000 (-0700) Subject: SVG backend: convert music font glyphs to paths X-Git-Tag: release/2.13.4-1~292 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=7149acc8389e8c4309ae1ce08e2e2faea74a5dc2;p=lilypond.git SVG backend: convert music font glyphs to paths This patch implements on-the-fly conversion of the Emmentaler/Aybabtu glyphs to SVG elements. Note that this patch depends on the previous 4 patches to work correctly. --- diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm index c1afaf8d2d..3d03aa6e30 100644 --- a/scm/framework-svg.scm +++ b/scm/framework-svg.scm @@ -49,7 +49,6 @@ `(viewBox . ,(ly:format "0 0 ~4f ~4f" paper-width paper-height)))) - (dump (dump-fonts outputter paper)) (dump (string-append ;; FIXME: only use pages if there are more than one, pageSet is @@ -84,22 +83,3 @@ (ly:outputter-dump-stencil outputter page) (if (or landscape? page-set?) (dump (ec 'page)))) - -(define (embed-font string) - (let ((start (string-contains string "")) - (end (string-contains string ""))) - (substring string (+ start 7) (- end 1)))) - -(define (dump-fonts outputter paper) - (let* ((fonts (ly:paper-fonts paper)) - (font-names (uniq-list (sort - (filter string? - (map ly:font-file-name fonts)) stringentity x)) (string->list string)))) (define svg-element-regexp - (make-regexp "^(<[a-z]+) (.*>)")) + (make-regexp "^(<[a-z]+) ?(.*>)")) + +(define scaled-element-regexp + (make-regexp "^(<[a-z]+ transform=\")(scale.[-0-9. ]+,[-0-9. ]+.\" .*>)")) (define pango-description-regexp-comma (make-regexp ",( Bold)?( Italic)?( Small-Caps)? ([0-9.]+)$")) @@ -117,7 +120,7 @@ (define pango-description-regexp-nocomma (make-regexp "( Bold)?( Italic)?( Small-Caps)? ([0-9.]+)$")) -(define (pango-description-to-svg-font str expr) +(define (pango-description-to-text str expr) (define alist '()) (define (set-attribute attr val) (set! alist (assoc-set! alist attr val))) @@ -146,21 +149,150 @@ (apply entity 'text expr (reverse! alist)))) -(define (font-smob-to-svg-font font expr) - (let ((name-style (font-name-style font)) - (size (modified-font-metric-font-scaling font))) +(define (dump-path path scale . rest) + (define alist '()) + (define (set-attribute attr val) + (set! alist (assoc-set! alist attr val))) + (if (not (null? rest)) + (let* ((dx (car rest)) + (dy (cadr rest)) + (total-x (+ dx next-horiz-adv))) + (if (or (not (= 0 (inexact->exact total-x))) + (not (= 0 (inexact->exact dy)))) + (let ((x (ly:format "~4f" total-x)) + (y (ly:format "~4f" dy))) + (set-attribute 'transform + (string-append + "translate(" x ", " y ") " + "scale(" scale ", -" scale ")"))) + (set-attribute 'transform + (string-append + "scale(" scale ", -" scale ")")))) + (set-attribute 'transform (string-append + "scale(" scale ", -" scale ")"))) + + (set-attribute 'd path) + (apply entity 'path "" (reverse alist))) + + +;; A global variable for keeping track of the *cumulative* +;; horizontal advance for glyph strings, but only if there +;; is more than one glyph. +(define next-horiz-adv 0.0) + +;; Matches the required "unicode" attribute from +(define glyph-unicode-value-regexp + (make-regexp "unicode=\"([^\"]+)\"")) + +;; Matches the optional path data from +(define glyph-path-regexp + (make-regexp "d=\"([-MmZzLlHhVvCcSsQqTt0-9.\n ]*)\"")) + +;; Matches a complete element with the glyph-name +;; attribute value of NAME. For example: +;; +;; +;; +;; TODO: it would be better to use an XML library to extract +;; the glyphs instead, and store them in a hash table. --pmccarty +;; +(define (glyph-element-regexp name) + (make-regexp (string-append ""))) + +(define (extract-glyph all-glyphs name size . rest) + (let* ((new-name (regexp-quote name)) + (regexp (regexp-exec (glyph-element-regexp new-name) all-glyphs)) + (glyph (match:substring regexp)) + (unicode-attr (regexp-exec glyph-unicode-value-regexp glyph)) + (unicode-attr-value (match:substring unicode-attr 1)) + (unicode-attr? (regexp-match? unicode-attr)) + (d-attr (regexp-exec glyph-path-regexp glyph)) + (d-attr-value "") + (d-attr? (regexp-match? d-attr)) + ;; TODO: not urgent, but do not hardcode this value + (units-per-em 1000) + (font-scale (ly:format "~4f" (/ size units-per-em))) + (path "")) + + (if (and unicode-attr? (not unicode-attr-value)) + (ly:warning (_ "Glyph must have a unicode value"))) + + (if d-attr? (set! d-attr-value (match:substring d-attr 1))) + + (cond ( + ;; Glyph-strings with path data + (and d-attr? (not (null? rest))) + (begin + (set! path (apply dump-path d-attr-value + font-scale + (list (cadr rest) (caddr rest)))) + (set! next-horiz-adv (+ next-horiz-adv + (car rest))) + path)) + ;; Glyph-strings without path data ("space") + ((and (not d-attr?) (not (null? rest))) + (begin + (set! next-horiz-adv (+ next-horiz-adv + (car rest))) + "")) + ;; Font smobs with path data + ((and d-attr? (null? rest)) + (set! path (dump-path d-attr-value font-scale)) + path) + ;; Font smobs without path data ("space") + (else + "")))) + +(define (extract-glyph-info all-glyphs glyph size) + (let* ((offsets (list-head glyph 3)) + (glyph-name (car (reverse glyph)))) + (apply extract-glyph all-glyphs glyph-name size offsets))) + +(define (svg-defs svg-font) + (let ((start (string-contains svg-font "")) + (end (string-contains svg-font ""))) + (substring svg-font (+ start 7) (- end 1)))) + +(define (cache-font svg-font size glyph) + (let ((all-glyphs (svg-defs (cached-file-contents svg-font)))) + (if (list? glyph) + (extract-glyph-info all-glyphs glyph size) + (extract-glyph all-glyphs glyph size)))) + + +(define (feta-alphabet-to-path font size glyph) + (let* ((name-style (font-name-style font)) + (scaled-size (/ size lily-unit-length)) + (font-file (ly:find-file (string-append name-style ".svg")))) + + (if font-file + (cache-font font-file scaled-size glyph) + (ly:warning (_ "cannot find SVG font ~S") font-file)))) + + +(define (font-smob-to-path font glyph) + (let* ((name-style (font-name-style font)) + (scaled-size (modified-font-metric-font-scaling font)) + (font-file (ly:find-file (string-append name-style ".svg")))) + + (if font-file + (cache-font font-file scaled-size glyph) + (ly:warning (_ "cannot find SVG font ~S") font-file)))) - (entity 'text expr - ;; FIXME: The cdr of `name-style' cannot select the - ;; correct SVG font, so we ignore this information for now - `(font-family . ,(car name-style)) - `(font-size . ,size) - '(text-anchor . "start")))) (define (fontify font expr) (if (string? font) - (pango-description-to-svg-font font expr) - (font-smob-to-svg-font font expr))) + (pango-description-to-text font expr) + (font-smob-to-path font expr))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; stencil outputters @@ -224,14 +356,27 @@ (define (embedded-svg string) string) +(define (glyph-string font size cid glyphs) + (define path "") + (if (= 1 (length glyphs)) + (set! path (feta-alphabet-to-path font size (car glyphs))) + (begin + (set! path + (string-append (eo 'g) + (string-join + (map (lambda (x) + (feta-alphabet-to-path font size x)) + glyphs) + "\n") + (ec 'g))))) + (set! next-horiz-adv 0.0) + path) + (define (grob-cause offset grob) "") (define (named-glyph font name) - (dispatch - `(fontify ,font ,(entity 'tspan - (integer->entity - (ly:font-glyph-name-to-charcode font name)))))) + (dispatch `(fontify ,font ,name))) (define (no-origin) "") @@ -292,21 +437,26 @@ `(d . ,(string-join (convert-path-exps commands) " ")))) (define (placebox x y expr) - (if (not (string-null? expr)) + (if (string-null? expr) + "" (let* - ((match (regexp-exec svg-element-regexp expr)) - (tagname (match:substring match 1)) - (attributes (match:substring match 2))) - - (string-append tagname - ;; FIXME: Not using GNU coding standards - ;; [translate ()] here to work around a - ;; bug in Microsoft Internet Explorer 6.0 - (ly:format " transform=\"translate(~f, ~f)\" " - x (- y)) - attributes - "\n")) - "")) + ((normal-element (regexp-exec svg-element-regexp expr)) + (scaled-element (regexp-exec scaled-element-regexp expr)) + (scaled? (if scaled-element #t #f)) + (match (if scaled? scaled-element normal-element)) + (string1 (match:substring match 1)) + (string2 (match:substring match 2))) + + (if scaled? + (string-append string1 + (ly:format "translate(~4f, ~4f) " x (- y)) + string2 + "\n") + (string-append string1 + (ly:format " transform=\"translate(~4f, ~4f)\" " + x (- y)) + string2 + "\n"))))) (define (polygon coords blot-diameter is-filled) (entity