summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/game-loop.scm2
-rw-r--r--2d/scene.scm28
-rw-r--r--2d/stage.scm107
3 files changed, 52 insertions, 85 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm
index 631aef8..39fde9e 100644
--- a/2d/game-loop.scm
+++ b/2d/game-loop.scm
@@ -228,7 +228,7 @@ time in milliseconds that has passed since the last game update."
(game-fullscreen? game))
(set! running? #t)
(resume-game)
- (push-stage (make-stage (game-first-scene game)))
+ (push-scene (game-first-scene game))
(spawn-server)
(game-loop (SDL:get-ticks) 0)
(close-window))
diff --git a/2d/scene.scm b/2d/scene.scm
index 9560379..e67cdce 100644
--- a/2d/scene.scm
+++ b/2d/scene.scm
@@ -29,7 +29,12 @@
scene-enter
scene-exit
scene-draw
- scene-update))
+ scene-update
+ init-scene
+ enter-scene
+ exit-scene
+ draw-scene
+ update-scene))
(define-record-type <scene>
(%make-scene init enter exit draw update)
@@ -50,3 +55,24 @@
(update no-op))
"Create a new scene object. All callbacks default to a no-op."
(%make-scene init enter exit draw update))
+
+(define (init-scene scene)
+ "Return the value returned by the state constructor thunk for
+SCENE."
+ ((scene-init scene)))
+
+(define (enter-scene scene state)
+ "Call enter callback for SCENE with STATE."
+ ((scene-enter scene) state))
+
+(define (exit-scene scene state)
+ "Call the exit callback for SCENE with STATE."
+ ((scene-exit scene) state))
+
+(define (draw-scene scene state)
+ "Call the draw callback for SCENE with STATE."
+ ((scene-draw scene) state))
+
+(define (update-scene scene state)
+ "Call the update callback for SCENE with STATE."
+ ((scene-update scene) state))
diff --git a/2d/stage.scm b/2d/stage.scm
index 306787b..27b29ba 100644
--- a/2d/stage.scm
+++ b/2d/stage.scm
@@ -24,7 +24,6 @@
(define-module (2d stage)
#:use-module (srfi srfi-9)
#:use-module (2d agenda)
- #:use-module (2d observer)
#:use-module (2d scene)
#:export (make-stage
stage?
@@ -32,7 +31,6 @@
stage-observer
stage-env
stage-scene
- init-stage
enter-stage
exit-stage
draw-stage
@@ -43,110 +41,53 @@
stage-on
stage-off
current-stage
- push-stage
- pop-stage
- replace-stage))
+ push-scene
+ pop-scene
+ replace-scene))
(define-record-type <stage>
- (%make-stage agenda observer env scene)
+ (%make-stage agenda scene state)
stage?
(agenda stage-agenda)
- (observer stage-observer)
- (env stage-env)
- (scene stage-scene))
+ (scene stage-scene)
+ (state stage-state))
(define (make-stage scene)
"Create a new stage object for SCENE."
- (%make-stage (make-agenda) (make-observer) (make-hash-table) scene))
+ (%make-stage (make-agenda) scene (init-scene scene)))
;;;
;;; Scene callbacks
;;;
-(define (init-stage stage)
- "Call the scene init callback for STAGE."
- (with-agenda (stage-agenda stage)
- ((scene-init (stage-scene stage)))))
-
(define (enter-stage stage)
"Call the scene enter callback for STAGE."
(with-agenda (stage-agenda stage)
- ((scene-enter (stage-scene stage)))))
+ (enter-scene (stage-scene stage)
+ (stage-state stage))))
(define (exit-stage stage)
"Call the scene exit callback for STAGE."
(with-agenda (stage-agenda stage)
- ((scene-exit (stage-scene stage)))))
+ (exit-scene (stage-scene stage)
+ (stage-state stage))))
(define (update-stage stage)
"Call the scene update callback for STAGE."
(with-agenda (stage-agenda stage)
(update-agenda)
- ((scene-update (stage-scene stage)))))
+ (update-scene (stage-scene stage)
+ (stage-state stage))))
(define (draw-stage stage)
"Call the scene draw callback for STAGE."
(with-agenda (stage-agenda stage)
- ((scene-draw (stage-scene stage)))))
+ (draw-scene (stage-scene stage)
+ (stage-state stage))))
(define (stage-trigger stage event . args)
- (apply observer-trigger (stage-observer stage) event args))
-
-;;;
-;;; Stage environment
-;;;
-
-(define uuid-counter 1)
-
-(define (next-uuid)
- "Return the next available uuid and increment the uuid counter."
- (let ((uuid uuid-counter))
- (set! uuid-counter (1+ uuid-counter))
- uuid))
-
-(define (make-stage-variable init-thunk)
- "Create a new stage variable that is initialized by INIT-THUNK."
- (let ((uuid (next-uuid)))
- (case-lambda
- (()
- (stage-ref-or-init uuid init-thunk))
- ((new-value)
- (stage-set! uuid new-value)))))
-
-(define (%stage-ref-or-init stage key init-thunk)
- "Return the value stored in STAGE associated with KEY. If there is
-no association for KEY then create it and set the value returned by
-INIT-THUNK."
- (let* ((env (stage-env stage))
- (handle (hash-get-handle env key)))
- (if handle
- (cdr handle)
- (cdr (hash-create-handle! env key (init-thunk))))))
-
-(define (%stage-set! stage key value)
- "Associate KEY with VALUE in the STAGE environment. An error is
-thrown if there is no value associated with KEY."
- (let ((handle (hash-get-handle (stage-env stage) key)))
- (if handle
- (set-cdr! handle value)
- (error 'stage-unbound-variable key))))
-
-(define (stage-ref-or-init key init)
- (%stage-ref-or-init (current-stage) key init))
-
-(define (stage-set! key value)
- (%stage-set! (current-stage) key value))
-
-(define-syntax-rule (define-stage-variable name value)
- "Define a stage variable named NAME with value VALUE. VALUE is
-lazily evaluated the first time it is referenced in a stage object."
- (define name (make-stage-variable (lambda () value))))
-
-(define (stage-on event callback)
- (observer-on (stage-observer (current-stage)) event callback))
-
-(define (stage-off event callback)
- (observer-off (stage-observer (current-stage)) event callback))
+ (with-agenda (stage-agenda stage)
+ #f))
;;;
;;; Stage management
@@ -158,16 +99,16 @@ lazily evaluated the first time it is referenced in a stage object."
"Return the top of the stage stack or #f if the stack is empty."
(if (null? stack) #f (car stack)))
-(define (push-stage stage)
+(define (push-scene scene)
"Make STAGE active and push it to the top of the stack."
- (let ((prev-stage (current-stage)))
+ (let ((prev-stage (current-stage))
+ (stage (make-stage scene)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cons stage stack))
- (init-stage stage)
(enter-stage stage)))
-(define (pop-stage)
+(define (pop-scene)
"Replace the current stage with the next one on the stack, if
present."
(let ((prev-stage (current-stage)))
@@ -177,11 +118,11 @@ present."
(when (current-stage)
(enter-stage (car stack)))))
-(define (replace-stage stage)
+(define (replace-scene scene)
"Replace the current stage with STAGE."
- (let ((prev-stage (current-stage)))
+ (let ((prev-stage (current-stage))
+ (stage (make-stage scene)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cons stage (cdr stack)))
- (init-stage stage)
(enter-stage stage)))