(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* '())
(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))))