From: Jan Nieuwenhuizen Date: Mon, 31 May 2010 21:23:49 +0000 (+0200) Subject: Svg with woff fonts: include dynamic css font list. X-Git-Tag: release/2.13.26-1~12 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0074bd08e3e2e0016585ffcc5aed52fb1966a821;p=lilypond.git Svg with woff fonts: include dynamic css font list. Refactor and re-use the font query mechanism from framework-ps.scm. --- diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index fcd3604d16..11ab75fbd1 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -48,37 +48,12 @@ "%" "_" name))) "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))))) -(define (define-fonts paper) - (define font-list (ly:paper-fonts paper)) - - (define (define-font command fontname scaling) - (string-append - "/" command - " { /" fontname - " " (ly:number->string scaling) " output-scale div selectfont }" - " bind def\n")) - - (define (font-load-command font) - (let* ((specced-font-name (ly:font-name font)) - (fontname (if specced-font-name - specced-font-name - (ly:font-file-name font))) - (command (ps-font-command font)) - - ;; FIXME -- see (ps-font-command) - (plain (ps-font-command font)) - (designsize (ly:font-design-size font)) - (magnification (* (ly:font-magnification font))) - (ops (ly:output-def-lookup paper 'output-scale)) - (scaling (* ops magnification designsize))) - (if (equal? fontname "unknown") - (display (list font fontname))) - (define-font plain fontname scaling))) - - (apply string-append - (map (lambda (x) (font-load-command x)) - (filter (lambda (x) (not (ly:pango-font? x))) - font-list)))) +(define (ps-define-font font font-name scaling) + (string-append + "/" (ps-font-command font) + " { /" font-name + " " (ly:number->string scaling) " output-scale div selectfont }" + " bind def\n")) ;; FIXME: duplicated in other output backends ;; FIXME: silly interface name @@ -202,7 +177,7 @@ (define (setup-variables paper) (string-append "\n" - (define-fonts paper) + (define-fonts paper ps-define-font) (output-variables paper))) (define (cff-font? font) diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm index 9bc11ae2a3..ebd4eb6b42 100644 --- a/scm/framework-svg.scm +++ b/scm/framework-svg.scm @@ -58,27 +58,36 @@ (define (svg-end) (ec 'svg)) -(define (woff-header) +(define (svg-define-font font font-name scaling) + (string-append + "@font-face { +font-family: '" + font-name +"'; +font-weight: normal; +font-style: normal; +src: url('" + (string-downcase font-name) + ".woff'); +} +")) + +(define (woff-header paper) "TODO: - * dynamically add fonts based on usage * add (ly:version) to font name * copy woff font with version alongside svg output " (string-append (eo 'defs) (eo 'style '(text . "style/css")) - " - " + " +" (ec 'style) (ec 'defs))) - + (define (dump-page paper filename page page-number page-count) (let* ((outputter (ly:make-paper-outputter (open-file filename "wb") 'svg)) (dump (lambda (str) (display str (ly:outputter-port outputter)))) @@ -93,7 +102,7 @@ (dump (svg-begin page-width page-height 0 0 device-width device-height)) (if (ly:get-option 'svg-woff) - (dump (woff-header))) + (dump (woff-header paper))) (dump (comment (format "Page: ~S/~S" page-number page-count))) (ly:outputter-output-scheme outputter `(begin (set! lily-unit-length ,unit-length) @@ -120,7 +129,7 @@ (dump (svg-begin svg-width svg-height left-x (- top-y) device-width device-height)) (if (ly:get-option svg-woff) - (dump (woff-header))) + (dump (woff-header paper))) (ly:outputter-output-scheme outputter `(begin (set! lily-unit-length ,unit-length) "")) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index d29e26498c..5684e1e1ac 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -890,3 +890,24 @@ between the two text elements." ;; (define-public (laissez-vibrer::print grob) (ly:tie::print grob)) + +(define-public (define-fonts paper define-font) + "Return a string of all fonts used in PAPER, invoking the function +DEFINE-FONT for procuding the actual font definition." + + (define font-list (ly:paper-fonts paper)) + + (define (font-load-command font) + (let* ((font-name (ly:font-name font)) + (designsize (ly:font-design-size font)) + (magnification (* (ly:font-magnification font))) + (ops (ly:output-def-lookup paper 'output-scale)) + (scaling (* ops magnification designsize))) + (if (equal? font-name "unknown") + (display (list font font-name))) + (define-font font font-name scaling))) + + (apply string-append + (map (lambda (x) (font-load-command x)) + (filter (lambda (x) (not (ly:pango-font? x))) + font-list)))) diff --git a/scm/output-svg.scm b/scm/output-svg.scm index 8bdcf2a61b..33826dd7e7 100644 --- a/scm/output-svg.scm +++ b/scm/output-svg.scm @@ -114,10 +114,10 @@ (make-regexp "^(<[a-z]+ transform=\")(scale.[-0-9. ]+,[-0-9. ]+.\" .*>)")) (define pango-description-regexp-comma - (make-regexp ",( Bold)?( Italic)?( Small-Caps)? ([0-9.]+)$")) + (make-regexp ",( Bold)?( Italic)?( Small-Caps)?[ -]([0-9.]+)$")) (define pango-description-regexp-nocomma - (make-regexp "( Bold)?( Italic)?( Small-Caps)? ([0-9.]+)$")) + (make-regexp "( Bold)?( Italic)?( Small-Caps)?[ -]([0-9.]+)$")) (define (pango-description-to-text str expr) (define alist '()) @@ -285,14 +285,17 @@ (cache-font font-file scaled-size glyph) (ly:warning (_ "cannot find SVG font ~S") font-file)))) -(define embedded #f) - (define (woff-font-smob-to-text font expr) (let* ((name-style (font-name-style font)) (scaled-size (modified-font-metric-font-scaling font)) (font-file (ly:find-file (string-append name-style ".woff"))) (charcode (ly:font-glyph-name-to-charcode font expr)) - (text (format #f "&#~S;" charcode))) + (char-lookup (format #f "&#~S;" charcode)) + (glyph-by-name (eoc 'altglyph `(glyphname . ,expr))) + (apparently-broken + (comment "FIXME: how to select glyph by name, altglyph is broken?")) + (text (string-regexp-substitute "\n" "" + (string-append glyph-by-name apparently-broken char-lookup)))) (define alist '()) (define (set-attribute attr val) (set! alist (assoc-set! alist attr val))) @@ -387,7 +390,9 @@ path) (define (woff-glyph-string font size cid glyphs) - (named-glyph font glyphs)) + (if (list? glyphs) + (named-glyph font (last (car glyphs))) + (named-glyph font glyphs))) (define glyph-string (if (not (ly:get-option 'svg-woff)) embedded-glyph-string woff-glyph-string))