source: project/gl-display-glx/gl-display-events-util.scm @ 3309

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

initial commit

File size: 3.7 KB
Line 
1;;; gl-display-events-util.scm
2;;
3;; 07.01.2007 - 20.01.2007
4;; 
5;; Provide events related utility functions.
6;; Need gl-display.
7;;
8
9(require-for-syntax 'srfi-13)
10(require-extension srfi-18)
11
12;
13
14; wait-event is like a blocking receive-event,
15; i.e. it does not return before it receive
16; an event.
17(define (wait-event window)
18  (let ((e (gl-display:receive-event window)))
19    (if (eqv? (car e) 'NO-EVENT)
20      (begin (thread-sleep! 0.01)
21             (wait-event window))
22      e)))
23
24(define (write-event e)
25  (case (car e)
26    ((KEY-PRESSED)     (print "key pressed " (gl-display:event-key e)))
27    ((KEY-RELEASED)    (print "key released " (gl-display:event-key e)))
28    ((BUTTON-PRESSED)  (print "button pressed"))
29    ((BUTTON-RELEASED) (print "button released"))
30    ((MOUSE-MOVED)     (print "mouse moved"))
31    ;((NO-EVENT)        (print "no event"))
32    ;(else             (print "unused event"))
33    )
34    (flush-output))
35
36(define (quit-on-escape e)
37  (let ((type (car e)))
38;   (write-event e)
39    (if (and (eqv? type 'KEY-PRESSED) (eqv? (caddr e) 'ESCAPE-KEY))
40      (exit))))
41
42; filter-events pumps continuously for events.
43; each event is handled with the function act given in argument.
44(define (filter-events window act)
45  (define (poll) (act (gl-display:receive-event window))
46                 (thread-sleep! 0.01)
47                 (poll))
48  (poll))
49
50; TODO
51; filter-events-until pumps continuously for events
52; until the predicate returns #t.
53; each event is handled with the function act given in argument
54; before being passed to the predicate.
55
56; process-events pumps for events until there's
57; no more event.
58; each event is handled with the function act given in argument.
59(define (process-events window act)
60  (define (process)
61    (let ((e (gl-display:receive-event window)))
62      (when (not (eqv? 'NO-EVENT (car e)))
63        (act e)
64        (process))))
65  (process))
66
67
68
69(define (key-pressed? event)
70  (eqv? 'KEY-PRESSED (gl-display:event-type event)))
71(define (key-released? event)
72  (eqv? 'KEY-RELEASED (gl-display:event-type event)))
73(define (button-pressed? event)
74  (eqv? 'BUTTON-PRESSED (gl-display:event-type event)))
75(define (button-released? event)
76  (eqv? 'BUTTON-RELEASED (gl-display:event-type event)))
77(define (mouse-moved? event)
78  (eqv? 'MOUSE-MOVED (gl-display:event-type event)))
79
80
81(define (escape-key-released? event)
82  (and (key-released? event)
83       (eqv? #\esc (gl-display:event-key event))))
84
85(define (up-key-released? event)
86  (and (key-released? event)
87       (eqv? 'UP-KEY (gl-display:event-key event))))
88(define (up-key-pressed? event)
89  (and (key-pressed? event)
90       (eqv? 'UP-KEY (gl-display:event-key event))))
91(define (down-key-released? event)
92  (and (key-released? event)
93       (eqv? 'DOWN-KEY (gl-display:event-key event))))
94(define (down-key-pressed? event)
95  (and (key-pressed? event)
96       (eqv? 'DOWN-KEY (gl-display:event-key event))))
97(define (left-key-released? event)
98  (and (key-released? event)
99       (eqv? 'LEFT-KEY (gl-display:event-key event))))
100(define (left-key-pressed? event)
101  (and (key-pressed? event)
102       (eqv? 'LEFT-KEY (gl-display:event-key event))))
103(define (right-key-released? event)
104  (and (key-released? event)
105       (eqv? 'RIGHT-KEY (gl-display:event-key event))))
106(define (right-key-pressed? event)
107  (and (key-pressed? event)
108       (eqv? 'RIGHT-KEY (gl-display:event-key event))))
109
110(define (space-key-released? event)
111  (and (key-released? event)
112       (eqv? #\space (gl-display:event-key event))))
113(define (space-key-pressed? event)
114  (and (key-pressed? event)
115       (eqv? #\space (gl-display:event-key event))))
116
117(define (lmb-released? event)
118  (and (button-released? event)
119       (eqv? 'LMB (gl-display:event-key event))))
120(define (lmb-pressed? event)
121  (and (button-pressed? event)
122       (eqv? 'LMB (gl-display:event-key event))))
Note: See TracBrowser for help on using the repository browser.