Wait on events by using the VM's select.
This commit is contained in:
parent
9a316771fc
commit
ac61d5fcef
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue