From: Jan Nieuwenhuizen Date: Wed, 10 Nov 2004 18:43:34 +0000 (+0000) Subject: * scm/framework-gnome.scm (item-event): Add support from TLA. Support X-Git-Tag: release/2.5.14~587 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=dfd7ebaea6c6bcd97f5a72c98a752f08c747305c;p=lilypond.git * scm/framework-gnome.scm (item-event): Add support from TLA. Support animated/opaque grob dragging tweaks. * buildscripts/guile-gnome.sh: Update. --- diff --git a/ChangeLog b/ChangeLog index 20874977f5..101e0e3d1e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-11-10 Jan Nieuwenhuizen + + * scm/framework-gnome.scm (item-event): Add support from TLA. Support + animated/opaque grob dragging tweaks. + + * buildscripts/guile-gnome.sh: Update. + 2004-11-10 Mats Bengtsson * scm/define-grobs.scm (all-grob-descriptions): Added diff --git a/buildscripts/guile-gnome.sh b/buildscripts/guile-gnome.sh index 194dad2c27..8633c95270 100644 --- a/buildscripts/guile-gnome.sh +++ b/buildscripts/guile-gnome.sh @@ -21,7 +21,7 @@ SLIB_PATH=`locate slib/require.scm | head -1 | sed -s 's/require.scm//g'` # What extra modules to pull (eg: EXTRA="libgnomecanvas libwnck") EXTRA=${EXTRA-libgnomecanvas} -GGVERSION=2.7.91 +GGVERSION=2.7.94 GWRAPVERSION=1.9.3 download=$HOME/usr/src/releases @@ -98,7 +98,7 @@ GUILE_LOAD_PATH=$OPT/g-wrap/share/guile/site:$GUILE_LOAD_PATH:$SLIB_PATH ## 4. get g-wrap 2.0 ## note that bleeding edge (2004-9-13) g-wrap breaks guile-gnome. -if ! pkg-config --exact-version=1.9.1 g-wrap-2.0-guile; then +if ! pkg-config --atleast-version=$GWRAPVERSION g-wrap-2.0-guile; then if [ -n "$BLOEDIGE_RAND" ]; then tla register-archive a.rottmann@gmx.at--2004-main \ http://people.debian.org/~rotty/arch/a.rottmann@gmx.at/2004-main || true diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index 976eacb026..c889bd8d6b 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -18,6 +18,65 @@ (gnome gtk gdk-event) (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? '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-motion:x-root)) +; (define (gdk-event-motion:x-root event) +; (let ((vector (gdk-event->vector event))) +; (case (gdk-event:type event) +; ((motion-notify) +; (vector-ref vector 9)) +; (else +; (gruntime-error "Event not of the proper type: ~A" event)))))) + +; (if (not (defined? 'gdk-event-motion:y-root)) +; (define (gdk-event-motion:y-root event) +; (let ((vector (gdk-event->vector event))) +; (case (gdk-event:type event) +; ((motion-notify) +; (vector-ref vector 10)) +; (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)) @@ -39,8 +98,12 @@ (define-class () (name #:init-value "untitled" #:init-keyword #:name #:accessor name) + + ;; FIXME (dragging #:init-value #f #:accessor dragging) (drag-origin #:init-value #f #:accessor drag-origin) + (drag-location #:init-value #f #:accessor drag-location) + (page-stencils ;;#:init-value '#() #:init-keyword #:page-stencils #:accessor page-stencils) (window #:init-value (make #:type 'toplevel) #:accessor window) @@ -229,11 +292,12 @@ (extra-offset (ly:grob-property grob 'extra-offset)) (origin (if (null? extra-offset) '(0 . 0) (cons (car extra-offset) - (- 0 (cdr extra-offset)))))) - (if grob - (hashq-set! (grob-tweaks go) grob (cons (+ (car origin) (car offset)) - (+ (cdr origin) (cdr offset))))) - (move item (car offset) (cdr offset)))) + (- 0 (cdr extra-offset)))))) + (if grob (hashq-set! (grob-tweaks go) grob + (cons (+ (car origin) (car offset)) + (- 0 (+ (cdr origin) (cdr offset)))))) + ;;;(move item (car offset) (cdr offset)))) + )) (define-method (save-tweaks (go )) (let ;;((file (current-error-port))) @@ -256,14 +320,24 @@ ((enter-notify) (gobject-set-property item 'fill-color "red")) ((leave-notify) (gobject-set-property item 'fill-color "black")) ((motion-notify) (if (ly:grob? (dragging go)) - ;; FIXME: wrap gdk-event-motion:* - ;;(stderr "MOVE TO: \n"))) - #t)) + (let* ((x (gdk-event-motion:x event)) + (y (gdk-event-motion:y event)) + ;;(s (pixels-per-unit go)) + (s output-scale) + (r (drag-location go))) + ;;(stderr "MOVED AT: ~S ~S\n" x y) + (move item (/ (- x (car r)) s) (/ (- y (cdr r)) s)) + (set! (drag-location go) (cons x y))))) ((button-release) (if (ly:grob? (dragging go)) - (let ((x (gdk-event-button:x event)) - (y (gdk-event-button:y event)) - (s (pixels-per-unit go)) - (o (drag-origin go))) + (let* ((x (gdk-event-button:x event)) + (y (gdk-event-button:y event)) + ;;(s (pixels-per-unit go)) + (s output-scale) + (o (drag-origin go)) + (r (drag-location go))) + (move item (/ (- x (car r)) s) (/ (- y (cdr r)) s)) + (set! (drag-location go) #f) + (set! (drag-origin go) #f) (stderr "RELEASE at: ~S ~S\n" x y) (set! (dragging go) #f) (tweak go item (cons (/ (- x (car o)) s) @@ -272,18 +346,21 @@ (let ((button (gdk-event-button:button event))) (cond ((= button 1) - ;; FIXME: wrap gdk-event-button:state (== modifiers) - ;;(if (null? (gdk-event-button:state event)) + (if (null? (gdk-event-button:modifiers event)) (let ((x (gdk-event-button:x event)) (y (gdk-event-button:y event))) (stderr "CLICK at: ~S ~S\n" x y) (set! (dragging go) (hashq-ref (item-grobs go) item #f)) - (set! (drag-origin go) (cons x y)))) - ((= button 3) - ;; some modifier, do jump to source - (and-let* ((grob (hashq-ref (item-grobs go) item #f)) - (location (get-location grob))) - (location-callback location))) + (set! (drag-origin go) (cons x y)) + (set! (drag-location go) (cons x y))) + (begin + (stderr "CLICK WITH MODIFIERS: ~S\n" + (gdk-event-button:modifiers event)) + + ;; some modifier, do jump to source + (and-let* ((grob (hashq-ref (item-grobs go) item #f)) + (location (get-location grob))) + (location-callback location))))) ((= button 2) (and-let* ((grob (hashq-ref (item-grobs go) item #f)))