scheme48/scheme/xlib/event.scm

;; Thread-safe event reading *****************************************

(define debug-msg
  (lambda messages
    (for-each (lambda (msg)
		(display msg (current-error-port)))
	      messages)
    (newline)))

(define (print-event event)
  (let ((type (any-event-type event)))
    (cond 
     ((eq? (event-type expose) type)
      (debug-msg "WAIT:expose event"))
     ((eq? (event-type no-expose) type)
      (debug-msg "WAIT:no-expose event"))
     ((eq? (event-type motion-notify) type)
      (debug-msg "WAIT:motion event" (cons (motion-event-x event) (motion-event-y event))))
      ((eq? (event-type button-press) type)
       (debug-msg "WAIT:mouse event"))
      ((eq? (event-type button-release) type)
       (debug-msg "WAIT:mouse event"))
      ((eq? (event-type key-press) type)
       (debug-msg "WAIT:keyboard press event" (lookup-string event)))
      ((eq? (event-type key-release) type)
       (debug-msg "WAIT:keyboard release event" (lookup-string event)))
      (else
       (debug-msg "WAIT:some unknown event: " (any-event-type event))))))

;; wait-event blocks the current thread until an event is available,
;; and then it returns this new event.

(import-lambda-definition-2 scx-get-x-event-list (display) "scx_Get_X_Events")

(define *xlib-event-uid* (new-external-event-uid (lookup-imported-binding "xlib-event")))

(define wait-event
  (let ((event-list '()))
    (lambda (display)
      (let loop()
	(if (null? event-list)
	    (let ((condvar (make-condvar)))
	      (register-condvar-for-external-event! *xlib-event-uid* condvar)
	      (wait-for-external-event condvar)
	      (set! event-list (scx-get-x-event-list display))
	      (loop))))
      (let ((event (car event-list)))
	(set! event-list (cdr event-list))
	event))))

;; How to find out if there are events available *********************

(define-enumerated-type queued-mode :queued-mode
  queued-mode? queued-modes queued-mode-name queued-mode-index
  (already after-reading after-flush))

(define-exported-binding "scx-queued-mode" :queued-mode)

(import-xlib-function events-queued (display mode)
  "scx_Events_Queued")

;; events-pending is identical to events-queued with after-flush
;; mode.

(import-xlib-function events-pending (display)
  "scx_Events_Pending")

;; Other event reading ***********************************************

(import-xlib-function next-event (display)
  "scx_Next_Event")

(import-xlib-function peek-event (display)
  "scx_Peek_Event")

;; returns a list of (time . (x . y)) elements
(import-xlib-function get-motion-events (display window from to)
  "scx_Get_Motion_Events")

;; Sending events ****************************************************

(import-xlib-function send-event (display window propagate mask event)
  "scx_Send_Event")