Remove stage local variables.

Use an the scene initialization thunk to return the needed game state
instead.

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)))