summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/game.scm79
-rw-r--r--2d/keyboard.scm71
-rw-r--r--2d/mouse.scm63
-rw-r--r--2d/window.scm12
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))