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