X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela%2Fevent.scm;h=720e4fd21c0e1d2a4f283cc9315123fa34494edb;hb=b463d97fdd8afd06f987f5f13ab73b9502e2421b;hp=9efd8e1c552e6654dd5fdf9c197d2032bf905e3d;hpb=12725e0c889f28354fc75cfb34683f9323dd04dd;p=gacela.git

diff --git a/gacela/event.scm b/gacela/event.scm
index 9efd8e1..720e4fd 100644
--- a/gacela/event.scm
+++ b/gacela/event.scm
@@ -18,7 +18,13 @@
 (define-module (gacela event)
   #:use-module ((sdl2 events) #:prefix sdl2:)
   #:export (process-events
-	    quit?))
+            clear-events
+	    quit-event?
+	    key-events
+	    any-key-down?
+	    any-key-up?
+	    key-down?
+	    key-up?))
 
 
 (define *current-events* '())
@@ -30,8 +36,44 @@
 	  (else
 	   '()))))
 
+(define (clear-events)
+  (set! *current-events* '()))
+
 (define (process-events)
-  (set! *current-events* (poll-events)))
+  (set! *current-events* (append *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))))