Store all events when lag is produced

[gacela.git] / gacela / event.scm

diff --git a/gacela/event.scm b/gacela/event.scm
index 9efd8e1c552e6654dd5fdf9c197d2032bf905e3d..720e4fd21c0e1d2a4f283cc9315123fa34494edb 100644 (file)
--- 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))))