summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2013-11-03 17:59:18 -0500
committerDavid Thompson <dthompson2@worcester.edu>2013-11-03 17:59:18 -0500
commit5ea47905046917ae79dde3155cd78268479c48fc (patch)
treeb7dcf216706fd7444897e64e8d8d6c65d25cef84
parent9ea9f27d90ed55f730f2ef95d26f54542f1ac6bd (diff)
Add event observer to scene.
Some convenient default events are provided to make quitting the game easy for new developers.
-rw-r--r--2d/game-loop.scm144
-rw-r--r--2d/scene.scm21
-rw-r--r--2d/stage.scm2
3 files changed, 92 insertions, 75 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm
index 39fde9e..79e09b7 100644
--- a/2d/game-loop.scm
+++ b/2d/game-loop.scm
@@ -33,6 +33,7 @@
#:use-module (2d mvars)
#:use-module (2d repl server)
#:use-module (2d repl repl)
+ #:use-module (2d scene)
#:use-module (2d stage)
#:use-module (2d window)
#:export (current-fps
@@ -44,6 +45,74 @@
game-paused?))
;;;
+;;; Game Loop
+;;;
+
+(define running? #f)
+(define paused? #f)
+
+(define (tick dt accumulator)
+ "Advance the game by one frame."
+ (if paused?
+ (begin
+ (run-repl)
+ (SDL:delay tick-interval)
+ accumulator)
+ (catch #t
+ (lambda ()
+ (let* ((stage (current-stage))
+ (remainder (update stage accumulator)))
+ (run-repl)
+ (render stage dt)
+ remainder))
+ (lambda (key . args)
+ (pause-game)
+ accumulator)
+ (lambda (key . args)
+ (display-backtrace (make-stack #t)
+ (current-output-port))))))
+
+(define (game-loop last-time accumulator)
+ "Update game state, and render. LAST-TIME is the time in
+milliseconds of the last iteration of the loop. ACCUMULATOR is the
+time in milliseconds that has passed since the last game update."
+ (when running?
+ (let* ((current-time (SDL:get-ticks))
+ (dt (- current-time last-time))
+ (accumulator (+ accumulator dt)))
+ (game-loop current-time (tick dt accumulator)))))
+
+(define (run-game game)
+ "Open a window and start the game loop for GAME."
+ (open-window (game-title game)
+ (game-resolution game)
+ (game-fullscreen? game))
+ (set! running? #t)
+ (resume-game)
+ (push-scene (game-first-scene game))
+ (spawn-server)
+ (game-loop (SDL:get-ticks) 0)
+ (close-window))
+
+(define (game-running?)
+ (running?))
+
+(define (game-paused?)
+ (paused?))
+
+(define (pause-game)
+ "Pauses the game loop. Useful when developing."
+ (set! paused? #t))
+
+(define (resume-game)
+ "Resumes the game loop."
+ (set! paused? #f))
+
+(define (quit-game)
+ "Finish the current frame and terminate the game loop."
+ (set! running? #f))
+
+;;;
;;; Constants
;;;
@@ -54,6 +123,12 @@
;;; Event Handling
;;;
+;; By default, pressing the escape key will pop the current scene, and
+;; closing the window will quit the game.
+(default-events `((key-down . ,(lambda (key mod unicode)
+ (pop-scene)))
+ (quit . ,quit-game)))
+
(define handle-events
(let ((e (SDL:make-event)))
(lambda (stage)
@@ -72,7 +147,6 @@
(SDL:event:resize:w e)
(SDL:event:resize:h e)))
((quit)
- (quit-game)
(stage-trigger stage 'quit))
((key-down)
(stage-trigger stage
@@ -182,71 +256,3 @@ INPUT, OUTPUT, and ERROR ports."
(unless (mvar-empty? repl-input-mvar)
(and-let* ((vals (try-take-mvar repl-input-mvar)))
(apply run-repl-thunk vals))))
-
-;;;
-;;; Game Loop
-;;;
-
-(define running? #f)
-(define paused? #f)
-
-(define (tick dt accumulator)
- "Advance the game by one frame."
- (if paused?
- (begin
- (run-repl)
- (SDL:delay tick-interval)
- accumulator)
- (catch #t
- (lambda ()
- (let* ((stage (current-stage))
- (remainder (update stage accumulator)))
- (run-repl)
- (render stage dt)
- remainder))
- (lambda (key . args)
- (pause-game)
- accumulator)
- (lambda (key . args)
- (display-backtrace (make-stack #t)
- (current-output-port))))))
-
-(define (game-loop last-time accumulator)
- "Update game state, and render. LAST-TIME is the time in
-milliseconds of the last iteration of the loop. ACCUMULATOR is the
-time in milliseconds that has passed since the last game update."
- (when running?
- (let* ((current-time (SDL:get-ticks))
- (dt (- current-time last-time))
- (accumulator (+ accumulator dt)))
- (game-loop current-time (tick dt accumulator)))))
-
-(define (run-game game)
- "Open a window and start the game loop for GAME."
- (open-window (game-title game)
- (game-resolution game)
- (game-fullscreen? game))
- (set! running? #t)
- (resume-game)
- (push-scene (game-first-scene game))
- (spawn-server)
- (game-loop (SDL:get-ticks) 0)
- (close-window))
-
-(define (game-running?)
- (running?))
-
-(define (game-paused?)
- (paused?))
-
-(define (pause-game)
- "Pauses the game loop. Useful when developing."
- (set! paused? #t))
-
-(define (resume-game)
- "Resumes the game loop."
- (set! paused? #f))
-
-(define (quit-game)
- "Finish the current frame and terminate the game loop."
- (set! running? #f))
diff --git a/2d/scene.scm b/2d/scene.scm
index 076897a..7415f80 100644
--- a/2d/scene.scm
+++ b/2d/scene.scm
@@ -23,6 +23,7 @@
(define-module (2d scene)
#:use-module (srfi srfi-9)
+ #:use-module (2d observer)
#:export (<scene>
make-scene
scene?
@@ -32,23 +33,28 @@
scene-exit
scene-draw
scene-update
+ scene-observer
init-scene
enter-scene
exit-scene
draw-scene
- update-scene))
+ update-scene
+ scene-trigger
+ default-events))
(define-record-type <scene>
- (%make-scene name init enter exit draw update)
+ (%make-scene name init enter exit draw update observer)
scene?
(name scene-name)
(init scene-init)
(enter scene-enter)
(exit scene-exit)
(draw scene-draw)
- (update scene-update))
+ (update scene-update)
+ (observer scene-observer))
(define no-op (lambda args #f))
+(define default-events (make-parameter '()))
(define* (make-scene name
#:optional #:key
@@ -56,9 +62,11 @@
(enter no-op)
(exit no-op)
(draw no-op)
- (update no-op))
+ (update no-op)
+ (events (default-events)))
"Create a new scene object. All callbacks default to a no-op."
- (%make-scene name init enter exit draw update))
+ (%make-scene name init enter exit draw update
+ (alist->observer events)))
(define (init-scene scene)
"Return the value returned by the state constructor thunk for
@@ -80,3 +88,6 @@ SCENE."
(define (update-scene scene state)
"Call the update callback for SCENE with STATE."
((scene-update scene) state))
+
+(define (scene-trigger scene event . args)
+ (apply observer-trigger (scene-observer scene) event args))
diff --git a/2d/stage.scm b/2d/stage.scm
index 27b29ba..fee18a3 100644
--- a/2d/stage.scm
+++ b/2d/stage.scm
@@ -87,7 +87,7 @@
(define (stage-trigger stage event . args)
(with-agenda (stage-agenda stage)
- #f))
+ (apply scene-trigger (stage-scene stage) event args)))
;;;
;;; Stage management