From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 18 Dec 2004 16:13:45 +0000 (+0000)
Subject: * lily/main.cc (setup_paths): Add svg to search path.
X-Git-Tag: release/2.5.14~390
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1d3b414e482a1948b23295c91d38e090a92e43b2;p=lilypond.git

* lily/main.cc (setup_paths): Add svg to search path.

* scm/output-svg.scm:
* scm/framework-svg.scm: Add pageSet.  Update.
(dump-fonts): New function.
(output-framework): Use it.
---

diff --git a/ChangeLog b/ChangeLog
index 2d52dbfcaf..7b7bc00882 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,11 @@
 2004-12-18  Jan Nieuwenhuizen  <janneke@gnu.org>
 
+	* lily/main.cc (setup_paths): Add svg to search path.
+
 	* scm/output-svg.scm:
 	* scm/framework-svg.scm: Add pageSet.  Update.
+	(dump-fonts): New function.
+	(output-framework): Use it.
 
 	* mf/GNUmakefile: 
 	* buildscripts/gen-bigcheese-scripts.py: Also generate SVG font.
diff --git a/lily/main.cc b/lily/main.cc
index ba2ba61a6e..fd1ed22fa9 100644
--- a/lily/main.cc
+++ b/lily/main.cc
@@ -226,7 +226,7 @@ setup_paths ()
 
   /* Adding mf/out make lilypond unchanged source directory, when setting
      LILYPONDPREFIX to lilypond-x.y.z */
-  char *suffixes[] = {"ly", "otf", "mf/out", "scm", "tfm", "ps", 0};
+  char *suffixes[] = {"ly", "otf", "mf/out", "scm", "tfm", "ps", "svg", 0};
 
   for (unsigned i = 0; prefix_directory[i]; i++)
     for (char **s = suffixes; *s; s++)
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index fb779b2645..a7a61125b8 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -83,13 +83,13 @@
 		  (let* ((cffname (string-append x ".cff"))
 			 (aname (string-append x ".pfa"))
 			 (bname (string-append x ".pfb"))
-			 (cffpath (ly:find-file cffname))
-			 (apath (ly:kpathsea-find-file aname))
-			 (bpath (ly:kpathsea-find-file bname)))
+			 (cff-file-name (ly:find-file cffname))
+			 (a-file-name (ly:kpathsea-find-file aname))
+			 (b-file-name (ly:kpathsea-find-file bname)))
 		    (cond
-		     (cffpath (ps-embed-cff (ly:gulp-file cffpath) x 0))
-		     (apath (ly:gulp-file apath))
-		     (bpath (ly:pfb->pfa bpath))
+		     (cff-file-name (ps-embed-cff (ly:gulp-file cff-file-name) x 0))
+		     (a-file-name (ly:gulp-file a-file-name))
+		     (b-file-name (ly:pfb->pfa b-file-name))
 		     (else
 		      (ly:warn "cannot find T42/PFA/PFB font ~S" x)
 		      ""))))
diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index 83af347a70..af2ffd8a1a 100644
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -7,7 +7,7 @@
 (define-module (scm framework-svg))
 
 (use-modules (guile) (lily) (scm output-svg))
-(use-modules (srfi srfi-2) (ice-9 regex))
+(use-modules (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (ice-9 regex))
 
 ;; FIXME: 0.62 to get paper size right
 (define output-scale (* 0.62 scale-to-unit))
@@ -26,12 +26,16 @@
     
    (ly:outputter-dump-string
     outputter
-    (string-append
      (eo 'svg
 	 '(xmlns . "http://www.w3.org/2000/svg")
 	 '(version . "1.2")
 	 `(width . ,(format #f "~smm" page-width))
-	 `(height . ,(format #f "~smm" page-height)))
+	 `(height . ,(format #f "~smm" page-height))))
+   
+   (ly:outputter-dump-string outputter (dump-fonts outputter paper))
+   (ly:outputter-dump-string
+    outputter
+    (string-append
      ;; FIXME: only use pages if there are more than one, pageSet is
      ;; not supported by all SVG applications yet.
      (if page-set? (eo 'pageSet) "")
@@ -60,3 +64,20 @@
   (ly:outputter-dump-stencil outputter page)
   (ly:outputter-dump-string outputter (string-append (ec 'g)))
   (if page-set? (ly:outputter-dump-string outputter (ec 'page))))
+
+(define (embed-font string)
+  (let ((start (string-contains string "<defs>"))
+	(end (string-contains string "</defs>")))
+    (substring string (+ start 7) (- end 1))))
+
+(define (dump-fonts outputter paper)
+  (let* ((fonts (ly:paper-fonts paper))
+	 (font-names (uniq-list (sort (map ly:font-file-name fonts) string<?)))
+	 (svgs (map
+		(lambda (x)
+		  (let ((file-name (ly:find-file (string-append x ".svg"))))
+		    (if file-name (embed-font (ly:gulp-file file-name))
+			(begin (ly:warn "cannot find SVG font ~S" x) ""))))
+		(filter string? font-names))))
+    (entity 'defs (string-join svgs "\n"))))
+