X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=blobdiff_plain;f=gacela%2Fevent.scm;h=04223971108da1a33c1cb4980f41d85aed63b652;hp=9efd8e1c552e6654dd5fdf9c197d2032bf905e3d;hb=39f20a9681fa52e854678fe5acb5b10e3244c1cd;hpb=cacab3e249f7706c33498a105be22e8447d14e64

diff --git a/gacela/event.scm b/gacela/event.scm
index 9efd8e1..0422397 100644
--- a/gacela/event.scm
+++ b/gacela/event.scm
@@ -18,7 +18,12 @@
 (define-module (gacela event)
   #:use-module ((sdl2 events) #:prefix sdl2:)
   #:export (process-events
-	    quit?))
+	    quit-event?
+	    key-events
+	    any-key-down?
+	    any-key-up?
+	    key-down?
+	    key-up?))
 
 
 (define *current-events* '())
@@ -33,5 +38,38 @@
 (define (process-events)
   (set! *current-events* (poll-events)))
 
-(define (quit?)
+(define (quit-event?)
   (not (null? (filter (lambda (e) (sdl2:quit-event? e)) *current-events*))))
+
+(define (key-events)
+  (filter (lambda (e) (sdl2:keyboard-event? e)) *current-events*))
+
+(define (any-key-down?)
+  (let loop ((events *current-events*))
+    (if (null? events)
+	#f
+	(or (sdl2:keyboard-down-event? (car events))
+	    (loop (cdr events))))))
+
+(define (any-key-up?)
+  (let loop ((events *current-events*))
+    (if (null? events)
+	#f
+	(or (sdl2:keyboard-up-event? (car events))
+	    (loop (cdr events))))))
+
+(define (key-down? key)
+  (let ((ke (filter
+	     (lambda (e)
+	       (and (sdl2:keyboard-down-event? e)
+		    (equal? (sdl2:keyboard-event-key e) key)))
+	     *current-events*)))
+    (not (null? ke))))
+
+(define (key-up? key)
+  (let ((ke (filter
+	     (lambda (e)
+	       (and (sdl2:keyboard-up-event? e)
+		    (equal? (sdl2:keyboard-event-key e) key)))
+	     *current-events*)))
+    (not (null? ke))))