Svg with woff fonts: also extract and define pango-fonts from paper.

Fixes emmentaler usage as text, such as the fingering number in: c-1

diff --git a/lily/include/paper-outputter.hh b/lily/include/paper-outputter.hh
index f1ff1a2131db81465c064b489d8b157bbb59c99b..25e9d8759794fbf14960c0ad6a9e1dfd16bdd722 100644 (file)
--- a/lily/include/paper-outputter.hh
+++ b/lily/include/paper-outputter.hh
@@ -40,13 +40,15 @@ public:
   DECLARE_SMOBS (Paper_outputter);
 
 public:
   DECLARE_SMOBS (Paper_outputter);
 
 public:

-  SCM file () const;
+  Paper_outputter (SCM port, string format);
+
+  void close ();

   SCM dump_string (SCM);
   SCM dump_string (SCM);

+  SCM file () const;
+  SCM module () const;

   void output_scheme (SCM scm);
   void output_scheme (SCM scm);

-  Paper_outputter (SCM port, string format);
-  SCM scheme_to_string (SCM);

   void output_stencil (Stencil);
   void output_stencil (Stencil);

-  void close ();
+  SCM scheme_to_string (SCM);

 };
 
 Paper_outputter *get_paper_outputter (string, string);
 };
 
 Paper_outputter *get_paper_outputter (string, string);

diff --git a/lily/paper-outputter-scheme.cc b/lily/paper-outputter-scheme.cc
index d482ad45f1be5e1d350affdc7fabd09bd0457d69..1022f7693eba26b9f8da9ae3c2e981028928c5db 100644 (file)
--- a/lily/paper-outputter-scheme.cc
+++ b/lily/paper-outputter-scheme.cc
@@ -108,3 +108,13 @@ LY_DEFINE (ly_outputter_output_scheme, "ly:outputter-output-scheme",
 
   return SCM_UNSPECIFIED;
 }
 
   return SCM_UNSPECIFIED;
 }

+
+LY_DEFINE (ly_outputter_module, "ly:outputter-module",
+          1, 0, 0, (SCM outputter),
+          "Return output module of @var{outputter}.")
+{
+  LY_ASSERT_SMOB (Paper_outputter, outputter, 1);
+
+  Paper_outputter *po = unsmob_outputter (outputter);
+  return po->module ();
+}

diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc
index 17ca922592112bc8cda7ac546a7ba4af9ef024e4..d2bd425493286ae41f3ae7f71ebbcb89f538e2e1 100644 (file)
--- a/lily/paper-outputter.cc
+++ b/lily/paper-outputter.cc
@@ -99,6 +99,12 @@ Paper_outputter::scheme_to_string (SCM scm)
   return scm_eval (scm, output_module_);
 }
 
   return scm_eval (scm, output_module_);
 }
 

+SCM
+Paper_outputter::module () const
+{
+  return output_module_;
+}
+

 void
 Paper_outputter::output_scheme (SCM scm)
 {
 void
 Paper_outputter::output_scheme (SCM scm)
 {

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 11ab75fbd1c1e3d9fcae6bfe8134e2ba4bc0ff44..a179295cf5087f168f9999645d6c46b594e9a867 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -48,6 +48,9 @@
        "%" "_" name)))
      "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
 
        "%" "_" name)))
      "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
 

+(define (ps-define-pango-pf pango-pf font-name scaling)
+  "")
+

 (define (ps-define-font font font-name scaling)
   (string-append
    "/" (ps-font-command font)
 (define (ps-define-font font font-name scaling)
   (string-append
    "/" (ps-font-command font)


@@ -177,7 +180,7 @@
 (define (setup-variables paper)
   (string-append
    "\n"
 (define (setup-variables paper)
   (string-append
    "\n"

-   (define-fonts paper ps-define-font)
+   (define-fonts paper ps-define-font ps-define-pango-pf)

    (output-variables paper)))
 
 (define (cff-font? font)
    (output-variables paper)))
 
 (define (cff-font? font)

diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index ebd4eb6b42fa33b2f0cfc9dfcd069e1e5c384517..fb2125c428aa4511435c56d7042789c128f9e401 100644 (file)
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -59,18 +59,24 @@
   (ec 'svg))
 
 (define (svg-define-font font font-name scaling)
   (ec 'svg))
 
 (define (svg-define-font font font-name scaling)

-  (string-append
-   "@font-face {
+  (let* ((file-name (if (list? font) (pango-pf-file-name font)
+                       (ly:font-file-name font)))
+        (lower-name (string-downcase font-name)))
+    ;; only embed emmentaler for now
+    (if (equal? (substring lower-name 0 (min (string-length lower-name) 10)) "emmentaler")
+       (string-append
+        "@font-face {

 font-family: '"
 font-family: '"

-   font-name
-"';
+        font-name
+        "';

 font-weight: normal;
 font-style: normal;
 src: url('"
    (string-downcase font-name)
    ".woff');
 }
 font-weight: normal;
 font-style: normal;
 src: url('"
    (string-downcase font-name)
    ".woff');
 }

-"))
+")
+       "")))

 
 (define (woff-header paper)
   "TODO:
 
 (define (woff-header paper)
   "TODO:


@@ -82,7 +88,7 @@ src: url('"
    (eo 'style '(text . "style/css"))
    "<![CDATA[
 "
    (eo 'style '(text . "style/css"))
    "<![CDATA[
 "

-   (define-fonts paper svg-define-font)
+   (define-fonts paper svg-define-font svg-define-font)

    "]]>
 "
    (ec 'style)
    "]]>
 "
    (ec 'style)


@@ -99,6 +105,8 @@ src: url('"
         (page-width (* output-scale device-width))
         (page-height (* output-scale device-height)))
 
         (page-width (* output-scale device-width))
         (page-height (* output-scale device-height)))
 

+    (if (ly:get-option 'svg-woff)
+       (module-define! (ly:outputter-module outputter) 'paper paper))

     (dump (svg-begin page-width page-height
                     0 0 device-width device-height))
     (if (ly:get-option 'svg-woff)
     (dump (svg-begin page-width page-height
                     0 0 device-width device-height))
     (if (ly:get-option 'svg-woff)


@@ -126,6 +134,8 @@ src: url('"
         (svg-width (* output-scale device-width))
         (svg-height (* output-scale device-height)))
 
         (svg-width (* output-scale device-width))
         (svg-height (* output-scale device-height)))
 

+    (if (ly:get-option 'svg-woff)
+       (module-define! (ly:outputter-module outputter) 'paper paper))

     (dump (svg-begin svg-width svg-height
                     left-x (- top-y) device-width device-height))
     (if (ly:get-option svg-woff)
     (dump (svg-begin svg-width svg-height
                     left-x (- top-y) device-width device-height))
     (if (ly:get-option svg-woff)

diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 5684e1e1accc05158d5a03343805836ec667732a..61175c58969a1fe973379616506d1958f756e0f0 100644 (file)
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -891,11 +891,43 @@ between the two text elements."
 (define-public (laissez-vibrer::print grob)
  (ly:tie::print grob))
 
 (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 (filter-out pred? lst)
+  (filter (lambda (x) (not (pred? x))) lst))
+
+(define-public (font-name-split font-name)
+  "Return (FONT-NAME . DESIGN-SIZE) from FONT-NAME string or #f."
+  (let ((match (regexp-exec (make-regexp "(.*)-([0-9]*)") font-name)))
+    (if (regexp-match? match)
+       (cons (match:substring match 1) (match:substring match 2))
+       (cons font-name-designsize #f))))
+
+;; Example of a pango-physical-font
+;; ("Emmentaler-11" "/home/janneke/vc/lilypond/out/share/lilypond/current/fonts/otf/emmentaler-11.otf" 0)
+(define-public (pango-pf-font-name pango-pf)
+  "Return the font-name of the pango physical font PANGO-PF."
+  (list-ref pango-pf 0))
+(define-public (pango-pf-file-name pango-pf)
+  "Return the file-name of the pango physical font PANGO-PF."
+  (list-ref pango-pf 1))
+(define-public (pango-pf-fontindex pango-pf)
+  "Return the fontindex of the pango physical font PANGO-PF."
+  (list-ref pango-pf 2))
+
+(define (pango-font-name pango-font)
+  (pango-pf-font-name (car (ly:pango-font-physical-fonts pango-font))))
+
+(define-public (define-fonts paper define-font define-pango-pf)
+  "Return a string of all fonts used in PAPER, invoking the functions
+DEFINE-FONT DEFINE-PANGO-PF for producing the actual font definition."
+
+  (let* ((font-list (ly:paper-fonts paper))
+        (pango-fonts (filter ly:pango-font? font-list))
+        (other-fonts (filter-out ly:pango-font? font-list))
+        (other-font-names (map ly:font-name other-fonts))
+        (pango-only-fonts
+         (filter-out (lambda (x)
+                       (member (pango-font-name x) other-font-names))
+                     pango-fonts)))

 
   (define (font-load-command font)
     (let* ((font-name (ly:font-name font))
 
   (define (font-load-command font)
     (let* ((font-name (ly:font-name font))


@@ -907,7 +939,14 @@ DEFINE-FONT for procuding the actual font definition."
          (display (list font font-name)))
       (define-font font font-name scaling)))
 
          (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))))
+  (define (pango-font-load-command pango-font)
+    (let* ((pango-pf (car (ly:pango-font-physical-fonts pango-font)))
+          (font-name (pango-pf-font-name pango-pf))
+          (scaling (ly:output-def-lookup paper 'output-scale)))
+      (if (equal? font-name "unknown")
+         (display (list pango-font font-name)))
+      (define-pango-pf pango-pf font-name scaling)))
+
+  (string-append
+   (apply string-append (map font-load-command other-fonts))
+   (apply string-append (map pango-font-load-command pango-only-fonts)))))

diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 33826dd7e7dee95392f76e6cd1bea738c654a42a..4c421006986e1433e641d239a0ee406e01d2e6e7 100644 (file)
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -19,6 +19,12 @@
 (define-module (scm output-svg))
 (define this-module (current-module))
 
 (define-module (scm output-svg))
 (define this-module (current-module))
 

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; globals
+
+;;; set by framework-gnome.scm
+(define paper #f)
+  

 (use-modules
   (guile)
   (ice-9 regex)
 (use-modules
   (guile)
   (ice-9 regex)


@@ -389,10 +395,40 @@
   (set! next-horiz-adv 0.0)
   path)
 
   (set! next-horiz-adv 0.0)
   path)
 

-(define (woff-glyph-string font size cid glyphs)
-  (if (list? glyphs)
-      (named-glyph font (last (car glyphs)))
-      (named-glyph font glyphs)))
+(define (woff-glyph-string font-name size cid? w-x-y-named-glyphs)
+  (let* ((name-style (font-name-style font-name))
+        (family-designsize (regexp-exec (make-regexp "(.*)-([0-9]*)")
+                                        font-name))
+        (family (if (regexp-match? family-designsize)
+                    (match:substring family-designsize 1)
+                    font-name))
+        (design-size (if (regexp-match? family-designsize)
+                         (match:substring family-designsize 2)
+                         #f))
+        (scaled-size (/ size lily-unit-length))
+        (font (ly:paper-get-font paper `(((font-family . ,family)
+                                          ,(if design-size
+                                               `(design-size . design-size)))))))
+    (define (glyph-spec w x y g)
+      (let* ((charcode (ly:font-glyph-name-to-charcode font g))
+            (char-lookup (format #f "&#~S;" charcode))
+            (glyph-by-name (eoc 'altglyph `(glyphname . ,g)))
+            (apparently-broken
+             (comment "XFIXME: how to select glyph by name, altglyph is broken?")))
+       ;; what is W?
+       (ly:format
+        "<text~a font-family=\"~a\" font-size=\"~a\">~a</text>"
+        (if (or (> (abs x) 0.00001)
+                (> (abs y) 0.00001))
+            (ly:format " transform=\"translate(~4f,~4f)\"" x y)
+            " ")
+        name-style scaled-size
+        (string-regexp-substitute
+         "\n" ""
+         (string-append glyph-by-name apparently-broken char-lookup)))))
+
+    (string-join (map (lambda (x) (apply glyph-spec x))
+                     (reverse w-x-y-named-glyphs)) "\n")))

 
 (define glyph-string
   (if (not (ly:get-option 'svg-woff)) embedded-glyph-string woff-glyph-string))
 
 (define glyph-string
   (if (not (ly:get-option 'svg-woff)) embedded-glyph-string woff-glyph-string))