From 64d364a7bd4d552e898972149f5d0bd2c55222bd Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen 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 + * 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 -;;;; 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 "\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