diff options
| -rw-r--r-- | 2d/game-loop.scm | 1 | ||||
| -rw-r--r-- | 2d/game.scm | 84 | ||||
| -rw-r--r-- | 2d/private/game.scm | 87 |
3 files changed, 145 insertions, 27 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm index 8dcc65c..0df3a04 100644 --- a/2d/game-loop.scm +++ b/2d/game-loop.scm @@ -29,6 +29,7 @@ #:use-module (figl gl) #:use-module (2d agenda) #:use-module (2d coroutine) + #:use-module (2d private game) #:use-module (2d repl server) #:use-module (2d repl repl) #:use-module (2d mvars) diff --git a/2d/game.scm b/2d/game.scm index cb043ec..4a1d88f 100644 --- a/2d/game.scm +++ b/2d/game.scm @@ -22,22 +22,59 @@ ;;; Code: (define-module (2d game) - #:use-module (srfi srfi-9) + #:use-module (2d private game) #:use-module (2d game-loop) - #:use-module (2d window) + #:use-module (2d helpers) + #:use-module (2d observer) #:use-module (2d vector2)) ;;; -;;; Games +;;; Scenes ;;; -(define-record-type <game> - (%make-game title resolution fullscreen first-scene) - game? - (title game-title) - (resolution game-resolution) - (fullscreen game-fullscreen?) - (first-scene game-first-scene)) +;; When no event callbacks are specified for a scene, these +;; (hopefully) convenient defaults will be used. +(define default-scene-events + `((quit . ,(lambda (state) (quit-game-loop!))) + (key-down . ,(lambda (state key mode unicode) + (when (any-equal? key 'escape 'q) + (quit-game-loop!)))))) + +(define* (make-scene #:optional #:key + (title "A Guile-2D Scene") + (events default-scene-events) + (update (lambda (s) #f)) + (draw (lambda (s) #f)) + (state #f)) + "Return a new scene. TITLE is a human readable name for the +scene. EVENTS is an alist of event handlers. UPDATE is a procedure +that updates the scene. DRAW is a procedure that renders the +scene. STATE is an object that encapsulates the scene state." + (%make-scene title (alist->observer events) update draw state)) + +(define-syntax-rule (define-scene name kwargs ...) + "Syntactic sugar over define and make-scene. Return a procedure that +creates a new scene." + (define (name) (make-scene kwargs ...))) + +(re-export <scene> + scene? + scene-title + scene-observer + scene-update-proc + scene-draw-proc + scene-state + scene-trigger + scene-update + scene-draw) + +(export make-scene + define-scene + default-scene-events) + +;;; +;;; Games +;;; (define* (make-game #:optional #:key (title "A Guile-2D Game") @@ -49,23 +86,16 @@ value." (%make-game title resolution fullscreen first-scene)) (define-syntax-rule (define-game name kwargs ...) - "Syntactic sugar for define and make-game." + "Syntactic sugar over define and make-game." (define name (make-game kwargs ...))) -(define (run-game game) - "Open a window and start playing GAME." - (open-window (game-title game) - (game-resolution game) - (game-fullscreen? game)) - (run-game-loop) - (close-window)) +(re-export <game> + game? + game-title + game-resolution + game-fullscreen? + game-first-scene + run-game) -(export <game> - make-game - define-game - game? - game-title - game-resolution - game-fullscreen? - game-first-scene - run-game) +(export make-game + define-game) diff --git a/2d/private/game.scm b/2d/private/game.scm new file mode 100644 index 0000000..63f0bd1 --- /dev/null +++ b/2d/private/game.scm @@ -0,0 +1,87 @@ +;;; 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: +;; +;; Game data structure. +;; +;;; Code: + +(define-module (2d private game) + #:use-module (srfi srfi-9) + #:use-module (2d observer)) + +;;; +;;; Scenes +;;; + +(define-record-type <scene> + (%make-scene title observer update-proc draw-proc state) + scene? + (title scene-title) + (observer scene-observer) + (update-proc scene-update-proc) + (draw-proc scene-draw-proc) + (state scene-state)) + +(define (scene-trigger scene event-type . args) + "Trigger an event on the scene observer." + (apply observer-trigger + (scene-observer scene) + event-type + (scene-state scene) + args)) + +(define (scene-draw scene) + "Draw scene." + ((scene-draw-proc scene) (scene-state scene))) + +(define (scene-update scene) + "Update scene." + ((scene-update-proc scene) (scene-state scene))) + +(export <scene> + %make-scene + scene? + scene-title + scene-observer + scene-update-proc + scene-draw-proc + scene-state + scene-trigger + scene-update + scene-draw) + +;;; +;;; Games +;;; + +(define-record-type <game> + (%make-game title resolution fullscreen first-scene) + game? + (title game-title) + (resolution game-resolution) + (fullscreen game-fullscreen?) + (first-scene game-first-scene)) + +(export <game> + %make-game + game? + game-title + game-resolution + game-fullscreen? + game-first-scene) |