]> git.donarmstrong.com Git - lilypond.git/commitdiff
* scm/output-svg.scm: Font fixes. Sodipodi now groks svg
authorJan Nieuwenhuizen <janneke@gnu.org>
Tue, 16 Nov 2004 15:01:29 +0000 (15:01 +0000)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 16 Nov 2004 15:01:29 +0000 (15:01 +0000)
including font, if LilyPond-feta font is only feta font in path.

* scm/output-gnome.scm (text): Revert to file name of font if font
has no name.  Fixes ec font selection.
(char): Bugfix: do not utf8 twice.  Fixes clefs.

ChangeLog
lily/font-metric.cc
scm/output-gnome.scm
scm/output-svg.scm

index eca99416c1b8638e361d76666d2a5085ad8c7253..f791c80b3ec73b98e8f395ffaa814a5dea7c3765 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,8 +5,12 @@
 
 2004-11-16  Jan Nieuwenhuizen  <janneke@gnu.org>
 
+       * scm/output-svg.scm: Font fixes.  Sodipodi now groks svg
+       including font, if LilyPond-feta font is only feta font in path.
+
        * scm/output-gnome.scm (text): Revert to file name of font if font
        has no name.  Fixes ec font selection.
+       (char): Bugfix: do not utf8 twice.  Fixes clefs.
 
        * scm/framework-svg.scm:
        * scm/output-svg.scm: New file.  TODO: figure out how to
index aae1dc2103e75656693c9add6bd8c5bcbccc1f73..38a1b38969547e58380e8b371b072fecc2f6aacd 100644 (file)
@@ -256,9 +256,8 @@ Font_metric::get_ascii_char_stencil (int code) const
 Stencil
 Font_metric::get_indexed_char_stencil (int code) const
 {
-  SCM at = scm_list_3 (ly_symbol2scm ("char"),
-                      self_scm (),
-                      scm_int2num (index_to_ascii (code)));
+  int idx = index_to_ascii (code);
+  SCM at = scm_list_3 (ly_symbol2scm ("char"), self_scm (), scm_int2num (idx));
   Box b = get_indexed_char (code);
   return Stencil (b, at);
 }
index 344a6e35bf0c84e63afa071e45a66b5e742068c3..db03a1189ca17c417df7a99aab7a6f03008e5e48 100644 (file)
@@ -167,7 +167,7 @@ lilypond -fgnome input/simple-song.ly
    (else FIXME)))
   
 (define (custom-utf8 i)
-  (if (< i 80)
+  (if (< i #x80)
       (utf8 i)
       (utf8 (+ #xee00 i))))
 
@@ -272,7 +272,7 @@ lilypond -fgnome input/simple-song.ly
     bezier))
 
 (define (char font i)
-  (text font (utf8 i)))
+  (text font (integer->char i)))
 
 ;; FIXME: naming
 (define (filledbox breapth width depth height)
@@ -418,5 +418,5 @@ lilypond -fgnome input/simple-song.ly
     #:fill-color "black"
     #:text (if (string? string)
               (string->utf8-string string)
-              (char->utf8-string (car string)))))
+              (char->utf8-string string))))
 
index ef50cfc1608a06837646bc9857b5015bbe9956aa..2b68ecaf3f62c23df7bd702d1462f7d572fba999 100644 (file)
@@ -4,10 +4,18 @@
 ;;;; 
 ;;;; (c)  2002--2004 Jan Nieuwenhuizen <janneke@gnu.org>
 
-;;;; http://www.w3.org/TR/SVG11/paths.html
+;;;; http://www.w3.org/TR/SVG11
 
+;;; FIXME
 
-;;; TODO: character selects by index from [custom] fonts
+;;; * sodipodi gets confuseed by dashes in font names.
+;;;
+;;;   removing feta-nummer*.pfa (LilyPond-feta-nummer),
+;;;   feta-braces*.pfa (LilyPond-feta-braces), feta-din*.pfa
+;;;   (LilyPond-feta-din) from font path shows feta fonts in sodipodi.
+;;;
+;;; * inkscape fails to map Feta fonts to private use area (PUA) E000
+;;;   (sodipodi is fine).
 
 (debug-enable 'backtrace)
 (define-module (scm output-svg))
    (tagify "text" expr (cons 'style (svg-font font))))
 ;;        (cons 'unicode-range "U+EE00-EEFF"))))
 
-;;;;;;;;;;;;;;;;;;; share this utf8 stuff from output-gnome
-;;;;;;;;;;;;;;;;;;;
-(define (utf8 i)
-  (cond
-   ((< i #x80) (list (integer->char i)))
-   ((< i #x800) (map integer->char
-                    (list (+ #xc0 (quotient i #x40))
-                          (+ #x80 (modulo i #x40)))))
-   ((< i #x10000)
-    (let ((x (quotient i #x1000))
-         (y (modulo i #x1000)))
-      (map integer->char
-          (list (+ #xe0 x)
-                (+ #x80 (quotient y #x40))
-                (+ #x80 (modulo y #x40))))))
-   (else FIXME)))
-  
-(define (custom-utf8 i)
-  (if (< i 80)
-      (utf8 i)
-      (utf8 (+ #xee00 i))))
-
-(define (string->utf8-string string)
-  (list->string
-   (apply append (map utf8 (map char->integer (string->list string))))))
-
-(define (char->utf8-string char)
-  (list->string (utf8 (char->integer char))))
-;;  (list->string (custom-utf8 (char->integer char))))
+(define (font-family font)
+  (let ((name (ly:font-name font)))
+    (if name
+       (regexp-substitute/global #f "^GNU-(.*)-[.0-9]*$" name 'pre 1 'post)
+       (begin
+         (stderr "font-name: ~S\n" (ly:font-name font))
+         ;; TODO s/filename/file-name/
+         (stderr "font-filename: ~S\n" (ly:font-filename font))
+         (stderr "font-size: ~S\n" (font-size font))
+         "ecrm12"))))
+
+(define (font-size font)
+  (let* ((designsize (ly:font-design-size font))
+        (magnification (* (ly:font-magnification font)))
+        (ops 2)
+        (scaling (* ops magnification designsize)))
+    (debugf "scaling:~S\n" scaling)
+    (debugf "magnification:~S\n" magnification)
+    (debugf "design:~S\n" designsize)
+    scaling))
+
+(define (integer->entity i)
+  (format #f "&#x~x;" i))
+
+(define (char->entity font c)
+  (define font-name-base-alist
+    `(("LilyPond-feta" . ,(- #xe000 #x20))
+      ("LilyPond-feta-braces-a" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-b" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-c" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-d" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-d" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-e" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-f" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-g" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-h" . ,(- #xe000 #x40))
+      ("LilyPond-feta-braces-i" . ,(- #xe000 #x40))
+      ("LilyPond-parmesan" . ,(- #xe000 #x20))))
+
+  (integer->entity (+ (assoc-get (font-family font) font-name-base-alist 0)
+                     (char->integer c))))
+
+(define (string->entities font string)
+  (apply string-append
+        (map (lambda (x) (char->entity font x)) (string->list string))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 
 (define (char font i)
   (dispatch
-   `(fontify ,font ,(tagify "tspan" (char->utf8-string
-                                    (integer->char i))))))
+   `(fontify ,font ,(tagify "tspan" (char->entity font (integer->char i))))))
 
 (define (comment s)
   (string-append "<!-- " s " !-->\n"))
          `(ry . ,(number->string (/ blot-diameter 2)))))
 
 (define (svg-font font)
-   (define (font-family)
-     (let ((name (ly:font-name font)))
-       (if name
-          (regexp-substitute/global #f "^GNU-(.*)-[.0-9]*$" name 'pre 1 'post)
-          (begin
-            (stderr "font-name: ~S\n" (ly:font-name font))
-            ;; TODO s/filename/file-name/
-            (stderr "font-filename: ~S\n" (ly:font-filename font))
-            (stderr "font-size: ~S\n" (font-size))
-            "ecrm12"))))
-   
-   (define (font-size)
-    (let* ((designsize (ly:font-design-size font))
-          (magnification (* (ly:font-magnification font)))
-          (scaling (* magnification designsize)))
-      (debugf "scaling:~S\n" scaling)
-      (debugf "magnification:~S\n" magnification)
-      (debugf "design:~S\n" designsize)
-      scaling))
-
    (format #f "font-family:~a;font-size:~a;fill:black;text-anchor:start;"
-          (font-family) (font-size)))
+          (font-family font) (font-size font)))
 
 (define (text font string)
-  (dispatch `(fontify ,font ,(tagify "tspan" (string->utf8-string string)))))
+  (dispatch `(fontify ,font ,(tagify "tspan" (string->entities font string)))))
 
 ;; WTF is this in every backend?
 (define (horizontal-line x1 x2 th)