From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Wed, 10 Nov 2004 19:22:58 +0000 (+0000)
Subject: (string->utf8-string, char->utf8-string):
X-Git-Tag: release/2.5.14~586
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=dcbf0d0691fb530f78c8cdfc9414e007caf81fe0;p=lilypond.git

(string->utf8-string, char->utf8-string):
New function.
(text): Use them.
---

diff --git a/ChangeLog b/ChangeLog
index 101e0e3d1e..37ef5bc981 100644
--- 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 1f6c7d2c51..71dd1eef5b 100644
--- 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))