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

try to throttle cocoa event dequeue for key & mouse events

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-17 21:53:43 -06:00
parent 57c963c045
commit 0f2ff1ff5d
2 changed files with 78 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/mred/private/wx/cocoa/const.rkt
View File

@ -18,6 +18,62 @@
(define NSAnyEventMask #xffffffff)
(define NSLeftMouseDown 1)
(define NSLeftMouseUp 2)
(define NSRightMouseDown 3)
(define NSRightMouseUp 4)
(define NSMouseMoved 5)
(define NSLeftMouseDragged 6)
(define NSRightMouseDragged 7)
(define NSMouseEntered 8)
(define NSMouseExited 9)
(define NSKeyDown 10)
(define NSKeyUp 11)
(define NSFlagsChanged 12)
(define NSAppKitDefined 13)
(define NSSystemDefined 14)
(define NSApplicationDefined 15)
(define NSPeriodic 16)
(define NSCursorUpdate 17)
(define NSScrollWheel 22)
(define NSTabletPoint 23)
(define NSTabletProximity 24)
(define NSOtherMouseDown 25)
(define NSOtherMouseUp 26)
(define NSOtherMouseDragged 27)
(define NSEventTypeGesture 29)
(define NSEventTypeMagnify 30)
(define NSEventTypeSwipe 31)
(define NSEventTypeRotate 18)
(define NSEventTypeBeginGesture 19)
(define NSEventTypeEndGesture 20)
(define MouseAndKeyEventMask
(bitwise-ior
(1 . << . NSLeftMouseDown)
(1 . << . NSLeftMouseUp)
(1 . << . NSRightMouseDown)
(1 . << . NSRightMouseUp)
(1 . << . NSMouseMoved)
(1 . << . NSLeftMouseDragged)
(1 . << . NSRightMouseDragged)
(1 . << . NSMouseEntered)
(1 . << . NSMouseExited)
(1 . << . NSKeyDown)
(1 . << . NSKeyUp)
(1 . << . NSScrollWheel)
(1 . << . NSTabletPoint)
(1 . << . NSTabletProximity)
(1 . << . NSOtherMouseDown)
(1 . << . NSOtherMouseUp)
(1 . << . NSOtherMouseDragged)
(1 . << . NSEventTypeGesture)
(1 . << . NSEventTypeMagnify)
(1 . << . NSEventTypeSwipe)
(1 . << . NSEventTypeRotate)
(1 . << . NSEventTypeBeginGesture)
(1 . << . NSEventTypeEndGesture)))
(define NSAlphaShiftKeyMask (1 . << . 16))
(define NSShiftKeyMask (1 . << . 17))
(define NSControlKeyMask (1 . << . 18))

26
collects/mred/private/wx/cocoa/queue.rkt
View File

@ -70,7 +70,6 @@
;; ready to wake up
(import-class NSEvent)
(define NSApplicationDefined 15)
(define wake-evt
(tell NSEvent
otherEventWithType: #:type _int NSApplicationDefined
@ -181,6 +180,8 @@
(define events-suspended? #f)
(define was-menu-bar #f)
(define avoid-mouse-key-until #f)
(define (check-menu-bar-click evt)
(if (and evt
(= 14 (tell #:type _NSUInteger evt type))
@ -217,10 +218,17 @@
(when (and events-suspended? wait?)
(set! was-menu-bar #f)
(set! events-suspended? #f))
(when (and avoid-mouse-key-until
((current-inexact-milliseconds) . > . avoid-mouse-key-until))
(set! avoid-mouse-key-until #f))
(begin0
(let ([evt (if events-suspended?
#f
(tell app nextEventMatchingMask: #:type _NSUInteger NSAnyEventMask
(tell app nextEventMatchingMask: #:type _NSUInteger (if (and (not wait?)
avoid-mouse-key-until)
(- NSAnyEventMask
MouseAndKeyEventMask)
NSAnyEventMask)
untilDate: (if wait? distantFuture #f)
inMode: NSDefaultRunLoopMode
dequeue: #:type _BOOL dequeue?))])
@ -229,7 +237,15 @@
(or (not dequeue?)
(let ([e (eventspace-hook (tell evt window))])
(if e
(begin
(let ([mouse-or-key?
(bitwise-bit-set? MouseAndKeyEventMask
(tell #:type _NSInteger evt type))])
;; If it's a mouse or key event, delay further
;; dequeue of mouse and key events until this
;; one can be handled.
(when mouse-or-key?
(set! avoid-mouse-key-until
(+ (current-inexact-milliseconds) 200.0)))
(retain evt)
(queue-event e (lambda ()
(call-as-nonatomic-retry-point
@ -237,7 +253,9 @@
;; in atomic mode
(with-autorelease
(tellv app sendEvent: evt)
(release evt)))))))
(release evt))))
(when mouse-or-key?
(set! avoid-mouse-key-until #f)))))
(tellv app sendEvent: evt)))
#t)))
(tellv pool release))))