diff options
| -rw-r--r-- | 2d/game-loop.scm | 2 | ||||
| -rw-r--r-- | 2d/scene.scm | 28 | ||||
| -rw-r--r-- | 2d/stage.scm | 107 |
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))) |