* 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 4c219befb72f57dfb745cc86548a6e0917978a06..096c1b18bd42669b6328a7219442d567b43e02e4 100644 (file)
--- 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 d11ebbbe7b85a4c10f40b4c8fc8e28e1ddaa9a28..57c1813d3dbcbf74f71ea62890dbf53bee7cb5d9 100644 (file)
--- 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 fa5e93d5c422581a3a7044118005f62d34b8945c..480e1672ad8c0bd1e34622c288513ced7bcb03ed 100644 (file)
--- 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 387f68337a777dd6ef269d2c511a71d3df479237..51226d2bb14e9c8766ebde4ce3a63c1cd6d229b3 100644 (file)
--- 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 ab923e94a226a9ea2bd5afe3efdd9cf888fec638..5e9483b2dc01f22a786e94d5fc2c3a75ba755b47 100644 (file)
--- 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
 ;;;