Wait on events by using the VM's select.

This commit is contained in:
mainzelm 2001-12-04 14:18:57 +00:00
parent 9a316771fc
commit ac61d5fcef
3 changed files with 28 additions and 22 deletions

View File

@ -349,10 +349,21 @@ s48_value scx_Get_Motion_Events(s48_value Xdisplay, s48_value Xwindow,
return v;
}
s48_value scx_add_pending_channel (channel){
int socket_fd;
S48_CHECK_CHANNEL(channel);
socket_fd = S48_UNSAFE_EXTRACT_FIXNUM(S48_UNSAFE_CHANNEL_OS_INDEX(channel));
if (! s48_add_pending_fd(socket_fd, 1)) // 1 for: yes, is input
s48_raise_out_of_memory_error();
return S48_UNSPECIFIC;
}
void scx_init_event(void) {
S48_EXPORT_FUNCTION(scx_Next_Event);
S48_EXPORT_FUNCTION(scx_Peek_Event);
S48_EXPORT_FUNCTION(scx_Events_Pending);
S48_EXPORT_FUNCTION(scx_Get_Motion_Events);
S48_EXPORT_FUNCTION(scx_add_pending_channel);
}

View File

@ -147,24 +147,18 @@
;; wait-event blocks the current thread until an event is available,
;; and then it returns this new event.
;; This does not work yet! We are working on it.
;(define (wait-event dpy) ; needs ports, locks
; (let ((port (display-message-inport dpy)))
; (display "obtaining port lock..." (current-error-port))
; (obtain-lock (port-lock port))
; (display " ...got it\n" (current-error-port))
;
; (display "waiting for events..." (current-error-port))
; (wait-for-channel (port->channel port))
; (display " ...receiving events.\n" (current-error-port))
;
; (release-lock (port-lock port))
; (next-event dpy)))
(define (wait-event dpy) ; needs ports, locks
(let ((port (display-message-inport dpy)))
(disable-interrupts!)
(if (not (char-ready? port))
(begin
(obtain-lock (port-lock port))
(add-pending-channel (port->channel port))
(wait-for-channel (port->channel port)) ;; enables interrupts
(release-lock (port-lock port)))
(enable-interrupts!))
(next-event dpy)))
;; The old, ugly version that works...
(define (wait-event dpy)
(if (event-ready? dpy)
(next-event dpy)
(begin
(sleep 20) ; sleep for 20 ms
(wait-event dpy))))
;;; Only here until scsh provides us with select
(import-lambda-definition add-pending-channel (channel)
"scx_add_pending_channel")

View File

@ -72,12 +72,13 @@
(files graphics))
(define-structure xlib-event xlib-event-interface
(open scheme
(open scsh-level-0 ;; for port->channel
scheme
external-calls
threads ;; for sleep
ports locks ;; for locking the port
channel-i/o ;; for wait-for-channel
scsh-level-0 ;; for port->channel
interrupts
xlib-types)
(files event))