+ (map integer->char
+ (list (+ #xe0 x)
+ (+ #x80 (quotient y #x40))
+ (+ #x80 (modulo y #x40))))))
+ (else (begin (stderr "programming-error: utf-8 too big:~x\n" i)
+ (list (integer->char 32))))))
+
+(define (integer->utf-8-string integer)
+ (list->string (utf-8 integer)))
+
+(define (char->utf-8-string char)
+ (list->string (utf-8 (char->integer char))))
+
+(define (string->utf-8-string string)
+ (apply
+ string-append
+ (map (lambda (x) (char->utf-8-string x)) (string->list string))))
+
+(define (music-font? font)
+ (let ((family (car (font-name-style font))))
+ (string=? (substring family 0 (min (string-length family) 10))
+ "Emmentaler")))
+
+;;; FONT may be font smob, or pango font string
+(define (pango-font-name font)
+ (if (string? font)
+ (list font "Regular")
+ (apply format (append '(#f "~a, ~a") (font-name-style font)))))
+
+;;; FONT may be font smob, or pango font string
+(define (canvas-font-size font)
+ ;; FIXME: 1.85?
+ (* 1.85
+ (if (string? font)
+ 12
+ (* output-scale (modified-font-metric-font-scaling font)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Wrappers from guile-gnome TLA
+;;; guile-gnome-devel@gnu.org--2004
+;;; http://arch.gna.org/guile-gnome/archive-2004
+;;;
+;;; janneke@gnu.org--2004-gnome
+;;; http://lilypond.org/~janneke/{arch}/2004-gnome
+;;;
+(if (not (defined? '<gnome-canvas-path-def>))
+ (begin
+ (define-class <gnome-canvas-path-def> (<gobject>)
+ (closure #:init-value (gnome-canvas-path-def-new)
+ #:init-keyword #:path-def
+ #:getter get-def #:setter set-def))
+
+ (define-method (moveto (this <gnome-canvas-path-def>) x y)
+ (gnome-canvas-path-def-moveto (get-def this) x y))
+ (define-method (curveto (this <gnome-canvas-path-def>) x1 y1 x2 y2 x3 y3)
+ (gnome-canvas-path-def-curveto (get-def this) x1 y1 x2 y2 x3 y3))
+ (define-method (lineto (this <gnome-canvas-path-def>) x y)
+ (gnome-canvas-path-def-lineto (get-def this) x y))
+ (define-method (closepath (this <gnome-canvas-path-def>))
+ (gnome-canvas-path-def-closepath (get-def this)))
+ (define-method (reset (this <gnome-canvas-path-def>))
+ (gnome-canvas-path-def-reset (get-def this)))
+
+ (define -set-path-def set-path-def)
+ (define -get-path-def get-path-def)
+
+ (define-method (set-path-def (this <gnome-canvas-shape>)
+ (def <gnome-canvas-path-def>))
+ (-set-path-def this (get-def def)))
+
+ (define-method (get-path-def (this <gnome-canvas-shape>))
+ (make <gnome-canvas-path-def> #:path-def (-get-path-def this)))))