X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fevents.scm;h=dfe9e60c8afde01c0d91b272b6b4632b9ef109d4;hb=9d5134f4fb73e3d534b5c3daed943c26b15c2e3f;hp=d1962da0dc000c75643d9c09a487103fad0590b2;hpb=67e90e6957fd664b8f5f25dfd43aee079b56a03e;p=gacela.git

diff --git a/src/events.scm b/src/events.scm
index d1962da..dfe9e60 100644
--- a/src/events.scm
+++ b/src/events.scm
@@ -39,139 +39,128 @@
 
 (define (process-events)
   (let ((events (poll-events)))
-    (quit! (not (null? (get-event events `(,SDL_QUIT)))))
-    (clear-key-state)
+    (process-screen-events (get-event events `(,SDL_QUIT)))
     (process-keyboard-events (get-event events `(,SDL_KEYDOWN ,SDL_KEYUP)))))
 
-(define quit? #f)
-(define quit! #f)
 
-(let ((quit #f))
-  (set! quit?
-	(lambda ()
-	  quit))
+;;; Screen Events
 
-  (set! quit!
-	(lambda (value)
-	  (set! quit value))))
+(define quit-signal #f)
+
+(define (process-screen-events events)
+  (set! quit-signal #f)
+  (cond ((not (null? events))
+	 (let ((event (car events)))
+	   (cond ((= (assoc-ref event 'type) SDL_QUIT) (set! quit-signal #t))))
+	 (process-screen-events (cdr events)))))
+
+(define (quit?)
+  quit-signal)
+
+
+;;; Keyboard Events
+
+(define keymap (make-hash-table))
+(define pressed (make-hash-table))
+(define released (make-hash-table))
 
 (define (process-keyboard-events events)
+  (clear-key-state)
   (cond ((not (null? events))
 	 (let ((event (car events)))
 	   (cond ((= (assoc-ref event 'type) SDL_KEYDOWN) (key-press (assoc-ref event 'key.keysym.sym)))
 		 ((= (assoc-ref event 'type) SDL_KEYUP) (key-release (assoc-ref event 'key.keysym.sym)))))
 	 (process-keyboard-events (cdr events)))))
 
-(define key? #f)
-(define key-pressed? #f)
-(define key-released? #f)
-(define key-press #f)
-(define key-release #f)
-(define clear-keymap #f)
-(define clear-key-state #f)
-
-(let ((keymap (make-hash-table))
-      (pressed (make-hash-table))
-      (released (make-hash-table)))
-  (set! key?
-	(lambda (key)
-	  (hash-ref keymap (get-keycode key))))
-
-  (set! key-pressed?
-	(lambda (key)
-	  (hash-ref pressed (get-keycode key))))
-
-  (set! key-released?
-	(lambda (key)
-	  (hash-ref released (get-keycode key))))
-
-  (set! key-press
-	(lambda (key-code)
-	  (hash-set! keymap key-code #t)
-	  (hash-set! pressed key-code #t)
-	  (hash-set! released key-code #f)))
-
-  (set! key-release
-	(lambda (key-code)
-	  (hash-set! keymap key-code #f)
-	  (hash-set! pressed key-code #f)
-	  (hash-set! released key-code #t)))
-
-  (set! clear-keymap
-	(lambda ()
-	  (hash-clear! keymap)))
-
-  (set! clear-key-state
-	(lambda ()
-	  (hash-clear! pressed)
-	  (hash-clear! released))))
-
-(define get-keycode #f)
-(define get-keyname #f)
-
-(let* ((keys
-	'((8 . backspace)
-	  (9 . tab)
-	  (12 . clear)
-	  (13 . return)
-	  (19 . pause)
-	  (27 . escape)
-	  (32 . space)
-	  (33 . exclaim)
-	  (34 . quotedbl)
-	  (35 . hash)
-	  (36 . dollar)
-	  (38 . ampersand)
-	  (39 . quote)
-	  (40 . leftparen)
-	  (41 . rightparen)
-	  (42 . asterisk)
-	  (43 . plus)
-	  (44 . comma)
-	  (45 . minus)
-	  (46 . period)
-	  (47 . slash)
-	  (48 . 0)
-	  (49 . 1)
-	  (50 . 2)
-	  (51 . 3)
-	  (52 . 4)
-	  (53 . 5)
-	  (54 . 6)
-	  (55 . 7)
-	  (56 . 8)
-	  (57 . 9)
-	  (58 . colon)
-	  (59 . semicolon)
-	  (60 . less)
-	  (61 . equals)
-	  (62 . greater)
-	  (63 . question)
-	  (64 . at)
-	  (269 . kp-minus)
-	  (270 . kp-plus)
-	  (273 . up)
-	  (274 . down)
-	  (275 . right)
-	  (276 . left)
-	  (282 . f1)
-	  (283 . f2)
-	  (284 . f3)
-	  (285 . f4)
-	  (286 . f5)
-	  (287 . f6)
-	  (288 . f7)
-	  (289 . f8)
-	  (290 . f9)
-	  (291 . f10)
-	  (292 . f11)
-	  (293 . f12)))
-       (keynames (map (lambda (k) (cons (cdr k) (car k))) keys)))
-
-  (set! get-keycode
-	(lambda (keyname)
-	  (assoc-ref keynames keyname)))
-
-  (set! get-keyname
-	(lambda (keycode)
-	  (assoc-ref keys keycode))))
+(define (key? key)
+  (hash-ref keymap (get-keycode key)))
+
+(define (key-pressed? key)
+  (hash-ref pressed (get-keycode key)))
+
+(define (key-released? key)
+  (hash-ref released (get-keycode key)))
+
+(define (key-press key-code)
+  (hash-set! keymap key-code #t)
+  (hash-set! pressed key-code #t)
+  (hash-set! released key-code #f))
+
+(define (key-release key-code)
+  (hash-set! keymap key-code #f)
+  (hash-set! pressed key-code #f)
+  (hash-set! released key-code #t))
+
+(define (clear-keymap)
+  (hash-clear! keymap))
+
+(define (clear-key-state)
+  (hash-clear! pressed)
+  (hash-clear! released))
+
+
+(define keys
+  '((8 . backspace)
+    (9 . tab)
+    (12 . clear)
+    (13 . return)
+    (19 . pause)
+    (27 . escape)
+    (32 . space)
+    (33 . exclaim)
+    (34 . quotedbl)
+    (35 . hash)
+    (36 . dollar)
+    (38 . ampersand)
+    (39 . quote)
+    (40 . leftparen)
+    (41 . rightparen)
+    (42 . asterisk)
+    (43 . plus)
+    (44 . comma)
+    (45 . minus)
+    (46 . period)
+    (47 . slash)
+    (48 . 0)
+    (49 . 1)
+    (50 . 2)
+    (51 . 3)
+    (52 . 4)
+    (53 . 5)
+    (54 . 6)
+    (55 . 7)
+    (56 . 8)
+    (57 . 9)
+    (58 . colon)
+    (59 . semicolon)
+    (60 . less)
+    (61 . equals)
+    (62 . greater)
+    (63 . question)
+    (64 . at)
+    (269 . kp-minus)
+    (270 . kp-plus)
+    (273 . up)
+    (274 . down)
+    (275 . right)
+    (276 . left)
+    (282 . f1)
+    (283 . f2)
+    (284 . f3)
+    (285 . f4)
+    (286 . f5)
+    (287 . f6)
+    (288 . f7)
+    (289 . f8)
+    (290 . f9)
+    (291 . f10)
+    (292 . f11)
+    (293 . f12)))
+
+(define keynames (map (lambda (k) (cons (cdr k) (car k))) keys))
+
+(define (get-keycode keyname)
+  (assoc-ref keynames keyname))
+
+(define (get-keyname keycode)
+  (assoc-ref keys keycode))