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

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

commit before removal of non gl-display files

File size: 3.8 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-keycode e)))
27    ((KEY-RELEASED)    (print "key released " (gl-display:event-keycode 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(define (key-pressed? event)
68  (eqv? 'KEY-PRESSED (gl-display:event-type event)))
69(define (key-released? event)
70  (eqv? 'KEY-RELEASED (gl-display:event-type event)))
71(define (button-pressed? event)
72  (eqv? 'BUTTON-PRESSED (gl-display:event-type event)))
73(define (button-released? event)
74  (eqv? 'BUTTON-RELEASED (gl-display:event-type event)))
75(define (mouse-moved? event)
76  (eqv? 'MOUSE-MOVED (gl-display:event-type event)))
77
78
79(define (escape-key-released? event)
80  (and (key-released? event)
81       (eqv? #\esc (gl-display:event-keycode event))))
82
83(define (up-key-released? event)
84  (and (key-released? event)
85       (eqv? 'UP-KEY (gl-display:event-keycode event))))
86(define (up-key-pressed? event)
87  (and (key-pressed? event)
88       (eqv? 'UP-KEY (gl-display:event-keycode event))))
89(define (down-key-released? event)
90  (and (key-released? event)
91       (eqv? 'DOWN-KEY (gl-display:event-keycode event))))
92(define (down-key-pressed? event)
93  (and (key-pressed? event)
94       (eqv? 'DOWN-KEY (gl-display:event-keycode event))))
95(define (left-key-released? event)
96  (and (key-released? event)
97       (eqv? 'LEFT-KEY (gl-display:event-keycode event))))
98(define (left-key-pressed? event)
99  (and (key-pressed? event)
100       (eqv? 'LEFT-KEY (gl-display:event-keycode event))))
101(define (right-key-released? event)
102  (and (key-released? event)
103       (eqv? 'RIGHT-KEY (gl-display:event-keycode event))))
104(define (right-key-pressed? event)
105  (and (key-pressed? event)
106       (eqv? 'RIGHT-KEY (gl-display:event-keycode event))))
107
108(define (space-key-released? event)
109  (and (key-released? event)
110       (eqv? #\space (gl-display:event-keycode event))))
111(define (space-key-pressed? event)
112  (and (key-pressed? event)
113       (eqv? #\space (gl-display:event-keycode event))))
114
115(define (lmb-released? event)
116  (and (button-released? event)
117       (eqv? 'LMB (gl-display:event-keycode event))))
118(define (lmb-pressed? event)
119  (and (button-pressed? event)
120       (eqv? 'LMB (gl-display:event-keycode event))))
Note: See TracBrowser for help on using the repository browser.