source: project/gl-display-glx/gl-display-event-queue.scm @ 3309

Last change on this file since 3309 was 3309, checked in by thu, 14 years ago

initial commit

File size: 2.0 KB
Line 
1;;; gl-display-event-queue.scm
2;;
3;; 12.02.2007
4;; 
5;; Provide an event-queue with related functions
6;; to query it, add event-handlers...
7;;
8
9(require-for-syntax 'srfi-13)
10;(declare (uses srfi-1))
11;(require-extension priority-channel)
12
13; representation of the event queue
14
15(define *event-queue* '())
16(define (events:size)
17  (length *event-queue*))
18
19; operations on a priority queue
20
21(define (event-queue-empty?)
22  (null? *event-queue*))
23
24(define (event-before? ev1 ev2)
25  (< (gl-display:event-time ev1) (gl-display:event-time ev2)))
26
27; Send an event to a target. Target can be the name
28; of a registered handler or not. In this case, a query
29; with the same name in argument has to be done to
30; receive the event.
31(define (events:send target event)
32  (if (pair? event)
33    (events:send-time-stamped target event)
34    (events:send-time-stamped target (list event (gl-display:time)))))
35(define (events:send-time-stamped target event)
36  (define (before? events)
37    (or (null? events)
38        (event-before? event (cdr (car events)))))
39  (define (insert! events)
40    (if (before? (cdr events))
41      (set-cdr! events (cons (cons target event) (cdr events)))
42      (insert! (cdr events))))
43  (if (before? *event-queue*)
44    (set! *event-queue* (cons (cons target event) *event-queue*))
45    (insert! *event-queue*)))
46
47;
48
49(define *handlers* '())
50
51; Register a handler with the name name. When a event
52; is send specifying this name has target, the handler
53; is called.
54(define (events:handle name handler)
55  (set! *handlers* (cons (cons name handler) *handlers*)))
56
57; Call the handler with the correct name passing it the event.
58(define (run-handler name event)
59  (for-each
60    (lambda (named-handler)
61      (if (eqv? name (car named-handler))
62        ((cdr named-handler) event)))
63    *handlers*))
64
65; events:schedule calls the handlers, passing
66; them the events they registered for.
67(define (events:schedule)
68  (when (not (null? *event-queue*))
69    (run-handler (car (car *event-queue*)) (cdr (car *event-queue*)))
70    (set! *event-queue* (cdr *event-queue*))
71    (events:schedule)))
72
Note: See TracBrowser for help on using the repository browser.