From b477819ccceb2fe03407476902162b6bfad925a7 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 14 Dec 2004 19:32:54 +0000 Subject: [PATCH] * 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. --- ChangeLog | 9 ++++ scm/framework-gnome.scm | 42 ---------------- scm/lily-library.scm | 10 ---- scm/output-gnome.scm | 109 +++++++++++++++++++++------------------- scm/output-svg.scm | 22 ++++++-- 5 files changed, 86 insertions(+), 106 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4c219befb7..096c1b18bd 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2004-12-14 Jan Nieuwenhuizen + + * 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 * 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 - #: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? ')) - (begin - (define-class () - (closure #:init-value (gnome-canvas-path-def-new) - #:init-keyword #:path-def - #:getter get-def #:setter set-def)) - - (define-method (moveto (this ) x y) - (gnome-canvas-path-def-moveto (get-def this) x y)) - (define-method (curveto (this ) x1 y1 x2 y2 x3 y3) - (gnome-canvas-path-def-curveto (get-def this) x1 y1 x2 y2 x3 y3)) - (define-method (lineto (this ) x y) - (gnome-canvas-path-def-lineto (get-def this) x y)) - (define-method (closepath (this )) - (gnome-canvas-path-def-closepath (get-def this))) - (define-method (reset (this )) - (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 ) - (def )) - (-set-path-def this (get-def def))) - - (define-method (get-path-def (this )) - (make #: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? ')) + (begin + (define-class () + (closure #:init-value (gnome-canvas-path-def-new) + #:init-keyword #:path-def + #:getter get-def #:setter set-def)) + + (define-method (moveto (this ) x y) + (gnome-canvas-path-def-moveto (get-def this) x y)) + (define-method (curveto (this ) x1 y1 x2 y2 x3 y3) + (gnome-canvas-path-def-curveto (get-def this) x1 y1 x2 y2 x3 y3)) + (define-method (lineto (this ) x y) + (gnome-canvas-path-def-lineto (get-def this) x y)) + (define-method (closepath (this )) + (gnome-canvas-path-def-closepath (get-def this))) + (define-method (reset (this )) + (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 ) + (def )) + (-set-path-def this (get-def def))) + + (define-method (get-path-def (this )) + (make #: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 ;;; -- 2.39.5