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

cocoa: better sync between Cocoa and Racket event queues

Browse Source 
to reduce inversion where a low-priority callback runs
 when a GUI event is available

original commit: 630dee7227fe437532edfeeda6e5c35f1bf8f7c0
This commit is contained in:
Matthew Flatt 2011-01-26 12:10:07 -07:00
parent 97b928821b
commit 5c15ac736a
2 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -369,6 +369,11 @@
(atomically (atomically
(pre-event-sync #t))) (pre-event-sync #t)))
(set-platform-queue-sync!
(lambda ()
;; in atomic mode
(dispatch-all-ready)))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; Install an alternate "sleep" function (in the PLT Scheme core) ;; Install an alternate "sleep" function (in the PLT Scheme core)
;; that wakes up if any Cocoa event is ready. ;; that wakes up if any Cocoa event is ready.

11
collects/mred/private/wx/common/queue.rkt
View File

@ -20,6 +20,7 @@
pre-event-sync pre-event-sync
boundary-tasks-ready-evt boundary-tasks-ready-evt
sometimes-delay-msec sometimes-delay-msec
set-platform-queue-sync!
eventspace? eventspace?
current-eventspace current-eventspace
@ -203,6 +204,10 @@
(send f destroy)) (send f destroy))
(hash-remove! active-eventspaces (eventspace-handler-thread e)))) (hash-remove! active-eventspaces (eventspace-handler-thread e))))
(define platform-queue-sync void)
(define (set-platform-queue-sync! proc)
(set! platform-queue-sync proc))
(define (make-eventspace* th) (define (make-eventspace* th)
(let ([done-sema (make-semaphore 1)] (let ([done-sema (make-semaphore 1)]
[done-set? #t] [done-set? #t]
@ -294,6 +299,12 @@
(timer-first-ready timer peek?) (timer-first-ready timer peek?)
(first refresh peek?) (first refresh peek?)
(first med peek?) (first med peek?)
(and (not peek?)
;; before going with low-priority events,
;; make sure we're sync'ed up with the
;; GUI platform's event queue:
(platform-queue-sync)
(first med peek?))
(first lo peek?) (first lo peek?)
(timer-first-wait timer peek?) (timer-first-wait timer peek?)
;; nothing else ready... ;; nothing else ready...