diff options
Diffstat (limited to '2d')
| -rw-r--r-- | 2d/game.scm | 79 | ||||
| -rw-r--r-- | 2d/keyboard.scm | 71 | ||||
| -rw-r--r-- | 2d/mouse.scm | 63 | ||||
| -rw-r--r-- | 2d/window.scm | 12 |
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)) |