summaryrefslogtreecommitdiff
path: root/2d/stage.scm
diff options
context:
space:
mode:
Diffstat (limited to '2d/stage.scm')
-rw-r--r--2d/stage.scm107
1 files changed, 24 insertions, 83 deletions
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)))