suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more consistent mouse events

Browse Source 
original commit: 54bee6314efb966d5f3d863021f52fff5f1a9b69
This commit is contained in:
Matthew Flatt 2010-07-22 20:21:20 -05:00
parent 771d383be6
commit a9d6a3cb64
6 changed files with 71 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -129,12 +129,23 @@
(define/override (set-size x y w h)
(do-set-size x y w h))
(define tr 0)
(define/private (do-set-size x y w h)
(super set-size x y w h)
(when tr
(tellv content-cocoa removeTrackingRect: #:type _NSInteger tr)
(set! tr #f))
(let ([sz (make-NSSize (- w (if vscroll? scroll-width 0))
(- h (if hscroll? scroll-width 0)))]
[pos (make-NSPoint 0 (if hscroll? scroll-width 0))])
(tellv content-cocoa setFrame: #:type _NSRect (make-NSRect pos sz)))
(tellv content-cocoa setFrame: #:type _NSRect (make-NSRect pos sz))
(set! tr (tell #:type _NSInteger
content-cocoa
addTrackingRect: #:type _NSRect (make-NSRect (make-NSPoint 0 0) sz)
owner: content-cocoa
userData: #f
assumeInside: #:type _BOOL #f)))
(when v-scroller
(tellv (scroller-cocoa v-scroller) setFrame: #:type _NSRect
(make-NSRect

2
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -110,6 +110,8 @@
(define cocoa (get-cocoa))
(tellv cocoa setDelegate: cocoa)
(tellv cocoa setAcceptsMouseMovedEvents: #:type _BOOL #t)
(define/override (get-cocoa-content)
(tell cocoa contentView))
(define/override (get-cocoa-window) cocoa)

2
collects/mred/private/wx/common/event.rkt
View File

@ -64,7 +64,7 @@
(eq? et 'enter))
(def/public (leaving?)
(eq? et 'leaving))
(eq? et 'leave))
(def/public (moving?)
(and (eq? et 'motion)

4
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -153,7 +153,9 @@
GDK_BUTTON_PRESS_MASK
GDK_BUTTON_RELEASE_MASK
GDK_POINTER_MOTION_MASK
GDK_FOCUS_CHANGE_MASK))
GDK_FOCUS_CHANGE_MASK
GDK_ENTER_NOTIFY_MASK
GDK_LEAVE_NOTIFY_MASK))
(set-gtk-object-flags! client-gtk (bitwise-ior (get-gtk-object-flags client-gtk)
GTK_CAN_FOCUS))

17
collects/mred/private/wx/gtk/types.rkt
View File

@ -16,7 +16,9 @@
_GdkEventKey _GdkEventKey-pointer
(struct-out GdkEventKey)
_GdkEventMotion _GdkEventMotion-pointer
(struct-out GdkEventMotion))
(struct-out GdkEventMotion)
_GdkEventCrossing _GdkEventCrossing-pointer
(struct-out GdkEventCrossing))
(define _GdkWindow (_cpointer/null 'GdkWindow))
@ -71,3 +73,16 @@
[device _GdkDevice]
[x_root _double]
[y_root _double]))
(define-cstruct _GdkEventCrossing ([type _GdkEventType]
[window _GdkWindow]
[send_event _byte]
[time _uint32]
[x _double]
[y _double]
[x_root _double]
[y_root _double]
[mode _int]
[detail _int]
[focus _gboolean]
[state _uint]))

47
collects/mred/private/wx/gtk/window.rkt
View File

@ -105,39 +105,59 @@
(define-signal-handler connect-button-press "button-press-event"
(_fun _GtkWidget _GdkEventButton-pointer -> _gboolean)
(lambda (gtk event)
(do-button-event gtk event #f)))
(do-button-event gtk event #f #f)))
(define-signal-handler connect-button-release "button-release-event"
(_fun _GtkWidget _GdkEventButton-pointer -> _gboolean)
(lambda (gtk event)
(do-button-event gtk event #f)))
(do-button-event gtk event #f #f)))
(define-signal-handler connect-pointer-motion "motion-notify-event"
(_fun _GtkWidget _GdkEventMotion-pointer -> _gboolean)
(lambda (gtk event)
(do-button-event gtk event #t)))
(do-button-event gtk event #t #f)))
(define-signal-handler connect-enter "enter-notify-event"
(_fun _GtkWidget _GdkEventCrossing-pointer -> _gboolean)
(lambda (gtk event)
(do-button-event gtk event #f #t)))
(define-signal-handler connect-leave "leave-notify-event"
(_fun _GtkWidget _GdkEventCrossing-pointer -> _gboolean)
(lambda (gtk event)
(do-button-event gtk event #f #t)))
(define (connect-key-and-mouse gtk)
(connect-key-press gtk)
(connect-button-press gtk)
(connect-button-release gtk)
(connect-pointer-motion gtk))
(connect-pointer-motion gtk)
(connect-enter gtk)
(connect-leave gtk))
(define (do-button-event gtk event motion?)
(define (do-button-event gtk event motion? crossing?)
(let ([type (if motion?
GDK_MOTION_NOTIFY
(GdkEventButton-type event))])
(if crossing?
(GdkEventCrossing-type event)
(GdkEventButton-type event)))])
(unless (or (= type GDK_2BUTTON_PRESS)
(= type GDK_3BUTTON_PRESS))
(let* ([wx (gtk->wx gtk)]
[modifiers (if motion?
(GdkEventMotion-state event)
(GdkEventButton-state event))]
(if crossing?
(GdkEventCrossing-state event)
(GdkEventButton-state event)))]
[bit? (lambda (m v) (positive? (bitwise-and m v)))]
[m (new mouse-event%
[event-type (cond
[(= type GDK_MOTION_NOTIFY)
'motion]
[(= type GDK_ENTER_NOTIFY)
'enter]
[(= type GDK_LEAVE_NOTIFY)
'leave]
[(= type GDK_BUTTON_PRESS)
(case (GdkEventButton-button event)
[(1) 'left-down]
@ -151,13 +171,20 @@
[left-down (bit? modifiers GDK_BUTTON1_MASK)]
[middle-down (bit? modifiers GDK_BUTTON2_MASK)]
[right-down (bit? modifiers GDK_BUTTON2_MASK)]
[x (->long ((if motion? GdkEventMotion-x GdkEventButton-x) event))]
[y (->long ((if motion? GdkEventMotion-y GdkEventButton-y) event))]
[x (->long ((if motion?
GdkEventMotion-x
(if crossing? GdkEventCrossing-x GdkEventButton-x))
event))]
[y (->long ((if motion? GdkEventMotion-y
(if crossing? GdkEventCrossing-y GdkEventButton-y))
event))]
[shift-down (bit? modifiers GDK_SHIFT_MASK)]
[control-down (bit? modifiers GDK_CONTROL_MASK)]
[meta-down (bit? modifiers GDK_META_MASK)]
[alt-down (bit? modifiers GDK_MOD1_MASK)]
[time-stamp ((if motion? GdkEventMotion-time GdkEventButton-time) event)]
[time-stamp ((if motion? GdkEventMotion-time
(if crossing? GdkEventCrossing-time GdkEventButton-time))
event)]
[caps-down (bit? modifiers GDK_LOCK_MASK)])])
(if (send wx handles-events?)
(begin