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

fix gtk win32 poll

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-06 07:33:14 -06:00
parent 6772afbd2e
commit 93613f906d
2 changed files with 51 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mred/private/wx/gtk/queue.rkt
View File

@ -6,7 +6,8 @@
"../../lock.rkt"
"../common/queue.rkt"
"../common/freeze.rkt"
"const.rkt")
"const.rkt"
"w32.rkt")
(provide gtk-start-event-pump
@ -63,6 +64,8 @@
(define-mz scheme_get_fdset (_fun _pointer _int -> _pointer))
(define-mz scheme_fdset (_fun _pointer _int -> _void))
(define-mz scheme_set_wakeup_time (_fun _pointer _double -> _void))
(define-mz scheme_add_fd_eventmask (_fun _pointer _int -> _void)
#:fail #f)
(define (install-wakeup fds)
(pre-event-sync #t)
@ -79,16 +82,21 @@
(set! poll-fds (malloc _GPollFD n))
(set! poll-fd-count n)
(install-wakeup fds))
(for ([i (in-range n)])
(let* ([gfd (ptr-ref poll-fds _GPollFD i)]
[fd (GPollFD-fd gfd)]
[events (GPollFD-events gfd)])
(when (not (zero? (bitwise-and events POLLIN)))
(scheme_fdset (scheme_get_fdset fds 0) fd))
(when (not (zero? (bitwise-and events POLLOUT)))
(scheme_fdset (scheme_get_fdset fds 1) fd))
(when (not (zero? (bitwise-and events (bitwise-ior POLLERR POLLHUP))))
(scheme_fdset (scheme_get_fdset fds 2) fd)))))))
(if (eq? 'windows (system-type))
;; We don't know how to deal with GLib FDs under
;; Windows, but we should wake up on any Windows event
(scheme_add_fd_eventmask fds QS_ALLINPUT)
;; Normal FD handling under Unix variants:
(for ([i (in-range n)])
(let* ([gfd (ptr-ref poll-fds _GPollFD i)]
[fd (GPollFD-fd gfd)]
[events (GPollFD-events gfd)])
(when (not (zero? (bitwise-and events POLLIN)))
(scheme_fdset (scheme_get_fdset fds 0) fd))
(when (not (zero? (bitwise-and events POLLOUT)))
(scheme_fdset (scheme_get_fdset fds 1) fd))
(when (not (zero? (bitwise-and events (bitwise-ior POLLERR POLLHUP))))
(scheme_fdset (scheme_get_fdset fds 2) fd))))))))
(set-check-queue! gtk_events_pending)
(set-queue-wakeup! install-wakeup)

32
collects/mred/private/wx/gtk/w32.rkt Normal file
View File

@ -0,0 +1,32 @@
#lang racket/base
(provide QS_ALLINPUT)
(define QS_KEY #x0001)
(define QS_MOUSEMOVE #x0002)
(define QS_MOUSEBUTTON #x0004)
(define QS_POSTMESSAGE #x0008)
(define QS_TIMER #x0010)
(define QS_PAINT #x0020)
(define QS_SENDMESSAGE #x0040)
(define QS_HOTKEY #x0080)
(define QS_ALLPOSTMESSAGE #x0100)
(define QS_RAWINPUT #x0400)
(define QS_MOUSE (bitwise-ior QS_MOUSEMOVE
QS_MOUSEBUTTON))
(define QS_INPUT (bitwise-ior QS_MOUSE
QS_KEY
QS_RAWINPUT))
(define QS_ALLEVENTS (bitwise-ior QS_INPUT
QS_POSTMESSAGE
QS_TIMER
QS_PAINT
QS_HOTKEY))
(define QS_ALLINPUT (bitwise-ior QS_INPUT
QS_POSTMESSAGE
QS_TIMER
QS_PAINT
QS_HOTKEY
QS_SENDMESSAGE))