(string->utf8-string, char->utf8-string):

New function.
(text): Use them.

diff --git a/ChangeLog b/ChangeLog
index 101e0e3d1ebbf9a5a3bfa8ee113e7949c3dbbcbb..37ef5bc981eb78272290e93cac34ee3d46bb63f5 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2004-11-10  Jan Nieuwenhuizen  <janneke@gnu.org>
 
+       * scm/output-gnome.scm (string->utf8-string, char->utf8-string):
+       New function.
+       (text): Use them.
+
        * scm/framework-gnome.scm (item-event): Add support from TLA.  Support
        animated/opaque grob dragging tweaks.
 

diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm
index 1f6c7d2c51dcf531bd3e9533e8eb57def730b6e0..71dd1eef5b460560fe2380182fecfb3e401f962c 100644 (file)
--- a/scm/output-gnome.scm
+++ b/scm/output-gnome.scm
@@ -113,19 +113,17 @@ lilypond -fgnome input/simple-song.ly
 
 (define (utf8 i)
   (cond
-   ((< i #x80) (make-string 1 (integer->char i)))
-   ((< i #x800) (list->string
-                (map integer->char
-                     (list (+ #xc0 (quotient i #x40))
-                           (+ #x80 (modulo i #x40))))))
+   ((< 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)))
-      (list->string
-       (map integer->char
-           (list (+ #xe0 x)
-                 (+ #x80 (quotient y #x40))
-                 (+ #x80 (modulo y #x40)))))))
+      (map integer->char
+          (list (+ #xe0 x)
+                (+ #x80 (quotient y #x40))
+                (+ #x80 (modulo y #x40))))))
    (else FIXME)))
   
 (define (custom-utf8 i)
@@ -133,6 +131,13 @@ lilypond -fgnome input/simple-song.ly
       (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))))
+
 (define (draw-rectangle x1 y1 x2 y2 color width-units)
   (make <gnome-canvas-rect>
     #:parent (canvas-root) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2
@@ -239,7 +244,9 @@ lilypond -fgnome input/simple-song.ly
     ;;#:scale-set #t
     
     #:fill-color "black"
-    #:text string))
+    #:text (if (string? string)
+              (string->utf8-string string)
+              (char->utf8-string (car string)))))
 
 (define (filledbox a b c d)
   (round-filled-box a b c d 0.001))