Move event handlers and signals into their own modules.

* 2d/game.scm (register-event-handler): New procedure.
(mouse-*, key-*, window-*): Remove signals.

* 2d/window.scm (window-size): New signal.

* 2d/mouse.scm: New module.

* 2d/keyboard.scm: New module.

4 files changed, 155 insertions, 70 deletions

diff --git a/2d/game.scm b/2d/game.scm
index e6c0161..f1b5f79 100644
--- a/2d/game.scm
+++ b/2d/game.scm
@@ -40,14 +40,7 @@
             resume-game
             game-running?
             game-paused?
-            window-size
-            key-last-pressed
-            key-down?
-            key-directions
-            key-arrows
-            key-wasd
-            mouse-position
-            mouse-down?
+            register-event-handler
             current-fps))
 
 ;;;
@@ -171,71 +164,17 @@ time in milliseconds that has passed since the last game update."
       (while (SDL:poll-event e)
         (handle-event e)))))
 
-;; Keyboard and mouse signals.
-(define window-size (make-signal #:init (vector2 0 0)))
-(define key-last-pressed (make-signal))
-(define mouse-position (make-signal #:init (vector2 0 0)))
-(define key-signals (make-hash-table))
-(define mouse-signals (make-hash-table))
+(define event-handlers '())
 
-(define (signal-hash-ref hash key)
-  (let ((signal (hashq-ref hash key)))
-    (if (signal? signal)
-        signal
-        (let ((signal (make-signal)))
-          (hashq-set! hash key signal)
-          signal))))
-
-(define (signal-hash-set! hash key value)
-  (signal-set! (signal-hash-ref hash key) value))
-
-(define (key-down? key)
-  "Return a signal for KEY."
-  (signal-hash-ref key-signals key))
-
-(define (mouse-down? button)
-  "Return a signal for BUTTON."
-  (signal-hash-ref mouse-signals button))
-
-(define (key-directions up down left right)
-  (signal-lift4 (lambda (up? down? left? right?)
-                  (let ((up (if up? -1 0))
-                        (down (if down? 1 0))
-                        (left (if left? -1 0))
-                        (right (if right? 1 0)))
-                    (vector2 (+ left right) (+ up down))))
-                (key-down? up)
-                (key-down? down)
-                (key-down? left)
-                (key-down? right)))
-
-(define key-arrows (key-directions 'up 'down 'left 'right))
-(define key-wasd (key-directions 'w 's 'a 'd))
+(define (register-event-handler event callback)
+  "Register CALLBACK to respond to events of type EVENT."
+  (set! event-handlers (acons event callback event-handlers)))
 
 (define (handle-event e)
-  "Call the relevant callbacks for the event E."
-  (case (SDL:event:type e)
-    ((active)
-     #f)
-    ((video-resize)
-     (signal-set! window-size (vector2 (SDL:event:resize:w e)
-                                       (SDL:event:resize:h e))))
-    ((quit)
-     (quit-game))
-    ((key-down)
-     (let ((key (SDL:event:key:keysym:sym e)))
-       (signal-hash-set! key-signals key #t)
-       (signal-set! key-last-pressed key)))
-    ((key-up)
-     (signal-hash-set! key-signals (SDL:event:key:keysym:sym e) #f))
-    ((mouse-motion)
-     (signal-set! mouse-position
-                  (vector2 (SDL:event:motion:x e)
-                           (SDL:event:motion:y e))))
-    ((mouse-button-down)
-     (signal-hash-set! mouse-signals (SDL:event:button:button e) #t))
-    ((mouse-button-up)
-     (signal-hash-set! mouse-signals (SDL:event:button:button e) #f))))
+  "Call the relevant callback procedure for the event E."
+  (let ((handler (assq-ref event-handlers (SDL:event:type e))))
+    (when handler
+      (handler e))))
 
 ;;;
 ;;; Frames Per Second
diff --git a/2d/keyboard.scm b/2d/keyboard.scm
new file mode 100644
index 0000000..7eacefc
--- /dev/null
+++ b/2d/keyboard.scm
@@ -0,0 +1,71 @@
+;;; guile-2d
+;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Guile-2d is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-2d is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Keyboard signals.
+;;
+;;; Code:
+
+(define-module (2d keyboard)
+  #:use-module ((sdl sdl) #:prefix SDL:)
+  #:use-module (2d game)
+  #:use-module (2d signals)
+  #:use-module (2d vector2)
+  #:export (key-last-down
+            key-last-up
+            key-down?
+            key-directions
+            key-arrows
+            key-wasd))
+
+(define key-last-down (make-signal))
+(define key-last-up (make-signal))
+
+(define (key-down? key)
+  "Create a signal for the state of KEY. Value is #t when key is
+pressed and #f otherwise."
+  (make-signal
+   #:filter (lambda (value old from)
+              (eq? value key))
+   #:transformer (lambda (value old from)
+                   (if (eq? from key-last-down) #t #f))
+   #:connectors (list key-last-down key-last-up)))
+
+(define (key-directions up down left right)
+  (signal-lift4 (lambda (up? down? left? right?)
+                  (vector2 (+ (if left? -1 0)
+                              (if right? 1 0))
+                           (+ (if up? -1 0)
+                              (if down? 1 0))))
+                (key-down? up)
+                (key-down? down)
+                (key-down? left)
+                (key-down? right)))
+
+(define key-arrows (key-directions 'up 'down 'left 'right))
+(define key-wasd (key-directions 'w 's 'a 'd))
+
+(register-event-handler
+ 'key-down
+ (lambda (e)
+   (signal-set! key-last-down (SDL:event:key:keysym:sym e))))
+
+(register-event-handler
+ 'key-up
+ (lambda (e)
+   (signal-set! key-last-up (SDL:event:key:keysym:sym e))))
diff --git a/2d/mouse.scm b/2d/mouse.scm
new file mode 100644
index 0000000..1c118b2
--- /dev/null
+++ b/2d/mouse.scm
@@ -0,0 +1,63 @@
+;;; guile-2d
+;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Guile-2d is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-2d is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Keyboard signals.
+;;
+;;; Code:
+
+(define-module (2d mouse)
+  #:use-module ((sdl sdl) #:prefix SDL:)
+  #:use-module (2d game)
+  #:use-module (2d signals)
+  #:use-module (2d vector2)
+  #:export (mouse-position
+            mouse-last-down
+            mouse-last-up
+            mouse-down?))
+
+(define mouse-last-down (make-signal))
+(define mouse-last-up (make-signal))
+(define mouse-position (make-signal #:init (vector2 0 0)))
+
+(define (mouse-down? button)
+  "Create a signal for the state of BUTTON. Value is #t when mouse
+button is pressed and #f otherwise."
+  (make-signal
+   #:filter (lambda (value old from)
+              (eq? value button))
+   #:transformer (lambda (value old from)
+                   (if (eq? from mouse-last-down) #t #f))
+   #:connectors (list mouse-last-down mouse-last-up)))
+
+(register-event-handler
+ 'mouse-motion
+ (lambda (e)
+   (signal-set! mouse-position
+                (vector2 (SDL:event:motion:x e)
+                         (SDL:event:motion:y e)))))
+
+(register-event-handler
+ 'mouse-down
+ (lambda (e)
+   (signal-set! mouse-last-down (SDL:event:button:button e))))
+
+(register-event-handler
+ 'mouse-up
+ (lambda (e)
+   (signal-set! mouse-last-up (SDL:event:button:button e))))
diff --git a/2d/window.scm b/2d/window.scm
index f5f16b8..241f71e 100644
--- a/2d/window.scm
+++ b/2d/window.scm
@@ -26,6 +26,8 @@
   #:use-module (figl gl)
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module ((sdl mixer) #:prefix SDL:)
+  #:use-module (2d game)
+  #:use-module (2d signals)
   #:use-module (2d vector2)
   #:export (<window>
             make-window
@@ -33,6 +35,7 @@
             window-title
             window-resolution
             window-fullscreen?
+            window-size
             open-window
             close-window
             with-window))
@@ -50,6 +53,15 @@
                       (fullscreen? #f))
   (%make-window title resolution fullscreen?))
 
+(define window-size (make-signal #:init (vector2 0 0)))
+
+(register-event-handler
+ 'video-resize
+ (lambda (e)
+   (signal-set! window-size
+                (vector2 (SDL:event:resize:w e)
+                         (SDL:event:resize:h e)))))
+
 (define* (open-window window)
   "Open the game window using the settings in WINDOW."
   (let ((flags (if (window-fullscreen? window) '(opengl fullscreen) 'opengl))