From 64d364a7bd4d552e898972149f5d0bd2c55222bd Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 16 Nov 2004 15:01:29 +0000
Subject: [PATCH] * 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.
---
ChangeLog | 4 ++
lily/font-metric.cc | 5 +-
scm/output-gnome.scm | 6 +--
scm/output-svg.scm | 114 ++++++++++++++++++++++---------------------
4 files changed, 68 insertions(+), 61 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index eca99416c1..f791c80b3e 100644
--- 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
diff --git a/lily/font-metric.cc b/lily/font-metric.cc
index aae1dc2103..38a1b38969 100644
--- a/lily/font-metric.cc
+++ b/lily/font-metric.cc
@@ -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);
}
diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm
index 344a6e35bf..db03a1189c 100644
--- a/scm/output-gnome.scm
+++ b/scm/output-gnome.scm
@@ -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))))
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index ef50cfc160..2b68ecaf3f 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -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))
@@ -94,35 +102,52 @@
(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))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -171,8 +196,7 @@
(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"))
@@ -212,31 +236,11 @@
`(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)
--
2.39.5