From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 14 Dec 2004 19:32:54 +0000 (+0000)
Subject: * scm/lily-library.scm (char->unicode-index): Remove.
X-Git-Tag: release/2.5.14~417
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=b477819ccceb2fe03407476902162b6bfad925a7;p=lilypond.git

* scm/lily-library.scm (char->unicode-index): Remove.

* scm/output-gnome.scm (text): Bugfix for plain string input.
Updates.

* scm/output-svg.scm (svg-font): Add weight to font selection.
---

diff --git a/ChangeLog b/ChangeLog
index 4c219befb7..096c1b18bd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-12-14  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+	* scm/lily-library.scm (char->unicode-index): Remove.
+
+	* scm/output-gnome.scm (text): Bugfix for plain string input.
+	Updates.
+
+	* scm/output-svg.scm (svg-font): Add weight to font selection.
+
 2004-12-14  Mats Bengtsson  <mabe@drongo.s3.kth.se>
 
 	* Documentation/topdocs/INSTALL.texi (Top): Point to
diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm
index d11ebbbe7b..57c1813d3d 100644
--- a/scm/framework-gnome.scm
+++ b/scm/framework-gnome.scm
@@ -18,48 +18,6 @@
  (gnome gtk gdk-event)
  (gnome gw canvas))
 
-
-;;; This is in 2.7.96 -- JUNKME.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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? 'gdk-event-motion:x))
-    (define (gdk-event-motion:x event)
-      (let ((vector (gdk-event->vector event)))
-	(case (gdk-event:type event)
-	  ((motion-notify)
-	   (vector-ref vector 4))
-	  (else
-	   (gruntime-error "Event not of the proper type: ~A" event))))))
-
-(if (not (defined? 'gdk-event-motion:y))
-    (define (gdk-event-motion:y event)
-      (let ((vector (gdk-event->vector event)))
-	(case (gdk-event:type event)
-	  ((motion-notify)
-	   (vector-ref vector 5))
-	  (else
-	   (gruntime-error "Event not of the proper type: ~A" event))))))
-
-(if (not (defined? 'gdk-event-button:modifiers))
-    (define (gdk-event-button:modifiers event)
-      (let ((vector (gdk-event->vector event)))
-	(case (gdk-event:type event)
-	  ((button-press button-release)
-	   ;; We have to do some hackery here, because there are bitmasks
-	   ;; used by XKB that we don't know about.
-	   (gflags->symbol-list
-	    (make <gdk-modifier-type>
-	      #:value (logand #x1fff (vector-ref vector 6)))))
-	  (else
-	   (gruntime-error "Event not of the proper type: ~A" event))))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (define-public (output-framework outputter book scopes fields basename)
   (gnome-main book basename))
 
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index fa5e93d5c4..480e1672ad 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -342,13 +342,3 @@ possibly turned off."
 	  ;;(stderr "font-file-name: ~S\n" (ly:font-file-name font))
 	  (ly:font-file-name font)))))
 
-(define-public (char->unicode-index font char)
-  (ly:font-index-to-charcode font (char->integer char)))
-
-(define-public (otf-name-mangling font family)
-  ;; Hmm, family is bigcheese20/26?
-  (if (string=? (substring family 0 (min (string-length family) 9))
-		"bigcheese")
-      "LilyPond"
-      family))
-
diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm
index 387f68337a..51226d2bb1 100644
--- a/scm/output-gnome.scm
+++ b/scm/output-gnome.scm
@@ -16,24 +16,23 @@
 ;;;    - allow GnomeCanvas or `toplevel' GtkWindow to be created
 ;;;      outside of LilyPond
 ;;;    - lilylib.
-;;;  * Release schedule and packaging of dependencies.  This hack
-;;;    depends on several CVS and TLA development sources.  In the works.
+;;;  * Release schedule and packaging of dependencies.
+;;;    - g-wrap-1.9.3 is already in incoming.
+;;;    - guile-gnome-platform-2.8.0 will probably be packaged early 2005.
 
 ;;; You need:
 ;;;
-;;;   * Rotty's g-wrap >= 1.9.3 (or TLA)
-;;;   * guile-gnome-platform >= 2.7.95 (or TLA)
+;;;   * Rotty's g-wrap >= 1.9.3
+;;;   * guile-gnome-platform >= 2.7.97
 ;;;   * pango >= 1.6.0
 ;;;
 ;;; See also: guile-gtk-general@gnu.org
 
 ;;; Try it
 ;;;
-;;;   [* Get cvs and tla]
-;;;
 ;;;   * Install gnome/gtk and libffi development stuff
 ;;;
-;;;   * Install pango, g-wrap and guile-gnome from CVS or arch: 
+;;;   * Install [pango, g-wrap and] guile-gnome from source,
 ;;;     see buildscripts/guile-gnome.sh
 ;;;  
 ;;;   * Build LilyPond with gui support: configure --enable-gui
@@ -87,42 +86,6 @@ lilypond -fgnome input/simple-song.ly
  (gnome gtk)
  (gnome gw canvas))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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)))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; globals
 
@@ -163,16 +126,16 @@ lilypond -fgnome input/simple-song.ly
    (else (begin (stderr "programming-error: utf-8 too big:~x\n" i)
 		(list (integer->char 32))))))
   
-(define (integer->utf8-string font integer)
+(define (integer->utf8-string integer)
   (list->string (utf8 integer)))
 
-(define (char->utf8-string font char)
-  (list->string (utf8 (char->unicode-index font char))))
+(define (char->utf8-string char)
+  (list->string (utf8 (char->integer char))))
   
-(define (string->utf8-string font string)
+(define (string->utf8-string string)
   (apply
    string-append
-   (map (lambda (x) (char->utf8-string font x)) (string->list string))))
+   (map (lambda (x) (char->utf8-string x)) (string->list string))))
 
 (define (music-font? font)
   (let ((encoding (ly:font-encoding font))
@@ -181,6 +144,49 @@ lilypond -fgnome input/simple-song.ly
 	(string=? (substring family 0 (min (string-length family) 9))
 		  "bigcheese"))))
 
+(define-public (otf-name-mangling font family)
+  ;; Hmm, family is bigcheese20/26?
+  (if (string=? (substring family 0 (min (string-length family) 9))
+		"bigcheese")
+      (string-append "LilyPond " (substring family 9))
+      family))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; stencil outputters
 ;;;
@@ -357,7 +363,8 @@ lilypond -fgnome input/simple-song.ly
 (define (text font s)
 
   (define (pango-font-name font)
-    (stderr "FONT-NAME:~S:~S\n" (ly:font-name font) (ly:font-design-size font))
+    (debugf "FONT-NAME:~S:~S\n" (ly:font-name font) (ly:font-design-size font))
+    (debugf "FONT-FAMILY:~S:~S\n" (font-family font) (otf-name-mangling font (font-family font)))
     (otf-name-mangling font (font-family font)))
 
   (define (pango-font-size font)
@@ -395,5 +402,5 @@ lilypond -fgnome input/simple-song.ly
     #:size-points (pango-font-size font)
     #:size-set #t
     #:text (if (integer? s)
-	       (integer->utf8-string font s)
-	       (string->utf8-string font s))))
+	       (integer->utf8-string s)
+	       (string->utf8-string s))))
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index ab923e94a2..5e9483b2dc 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -106,14 +106,30 @@
 
 (define (svg-font font)
   (let* ((encoding (ly:font-encoding font))
-	 (anchor (if (memq encoding '(fetaMusic fetaBraces)) 'start 'start)))
-   (format #f "font-family:~a;font-size:~a;text-anchor:~S;"
-	   (otf-name-mangling font (font-family font))
+	 (anchor (if (memq encoding '(fetaMusic fetaBraces)) 'start 'start))
+	 (family (font-family font)))
+   (format #f "font-family:~a;font-weight:~a;font-size:~a;text-anchor:~S;"
+	   (otf-name-mangling font family)
+	   (otf-weight-mangling font family)
 	   (font-size font) anchor)))
 
 (define (fontify font expr)
    (tagify "text" expr (cons 'style (svg-font font))))
 
+(define-public (otf-name-mangling font family)
+  ;; Hmm, family is bigcheese20/26?
+  (if (string=? (substring family 0 (min (string-length family) 9))
+		"bigcheese")
+      "LilyPond"
+      family))
+
+(define-public (otf-weight-mangling font family)
+  ;; Hmm, family is bigcheese20/26?
+  (if (string=? (substring family 0 (min (string-length family) 9))
+		"bigcheese")
+      (substring family 9)
+      "Regular"))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; stencil outputters
 ;;;