kernel: Use scene multiplexer for scene management.

1 files changed, 71 insertions, 116 deletions

diff --git a/starling/kernel.scm b/starling/kernel.scm
index 9fa9ac8..7957a51 100644
--- a/starling/kernel.scm
+++ b/starling/kernel.scm
@@ -56,12 +56,7 @@
             current-kernel
             boot-kernel
             elapsed-time
-            fps
-            current-scene
-            previous-scene
-            push-scene
-            pop-scene
-            replace-scene)
+            fps)
   #:re-export (abort-game))
 
 (define-class <window-config> ()
@@ -72,7 +67,7 @@
   (fullscreen? #:accessor fullscreen? #:init-form #f
                #:init-keyword #:fullscreen?))
 
-(define-class <kernel> (<node>)
+(define-class <kernel> (<scene-mux>)
   (name #:accessor name #:init-form "starling-kernel"
         #:init-keyword #:name)
   (window-config #:accessor window-config #:init-form (make <window-config>)
@@ -86,9 +81,7 @@
   (default-viewport #:accessor default-viewport)
   (avg-frame-time #:accessor avg-frame-time #:init-form 0.0)
   (controllers #:accessor controllers #:init-thunk make-hash-table)
-  (repl #:accessor repl)
-  ;; The scene stack.
-  (scenes #:accessor scenes #:init-form '()))
+  (repl #:accessor repl))
 
 (define current-kernel (make-parameter #f))
 
@@ -129,78 +122,77 @@
       ((_ height)
        (- height y))))
   (define (process-event event)
-    (let ((current-scene (current-scene)))
-      (cond
-       ((quit-event? event)
-        (on-quit current-scene))
-       ((keyboard-down-event? event)
-        (on-key-press current-scene
+    (cond
+     ((quit-event? event)
+      (on-quit kernel))
+     ((keyboard-down-event? event)
+      (on-key-press kernel
+                    (keyboard-event-key event)
+                    (keyboard-event-scancode event)
+                    (keyboard-event-modifiers event)
+                    (keyboard-event-repeat? event)))
+     ((keyboard-up-event? event)
+      (on-key-release kernel
                       (keyboard-event-key event)
                       (keyboard-event-scancode event)
-                      (keyboard-event-modifiers event)
-                      (keyboard-event-repeat? event)))
-       ((keyboard-up-event? event)
-        (on-key-release current-scene
-                        (keyboard-event-key event)
-                        (keyboard-event-scancode event)
-                        (keyboard-event-modifiers event)))
-       ((text-input-event? event)
-        (on-text-input current-scene
-                       (text-input-event-text event)))
-       ((mouse-button-down-event? event)
-        (on-mouse-press current-scene
+                      (keyboard-event-modifiers event)))
+     ((text-input-event? event)
+      (on-text-input kernel
+                     (text-input-event-text event)))
+     ((mouse-button-down-event? event)
+      (on-mouse-press kernel
+                      (mouse-button-event-button event)
+                      (mouse-button-event-clicks event)
+                      (mouse-button-event-x event)
+                      (invert-y (mouse-button-event-y event))))
+     ((mouse-button-up-event? event)
+      (on-mouse-release kernel
                         (mouse-button-event-button event)
-                        (mouse-button-event-clicks event)
                         (mouse-button-event-x event)
                         (invert-y (mouse-button-event-y event))))
-       ((mouse-button-up-event? event)
-        (on-mouse-release current-scene
-                          (mouse-button-event-button event)
-                          (mouse-button-event-x event)
-                          (invert-y (mouse-button-event-y event))))
-       ((mouse-motion-event? event)
-        (on-mouse-move current-scene
-                       (mouse-motion-event-x event)
-                       (invert-y (mouse-motion-event-y event))
-                       (mouse-motion-event-x-rel event)
-                       (- (mouse-motion-event-y-rel event))
-                       (mouse-motion-event-buttons event)))
-       ((and (controller-device-event? event)
-             (eq? (controller-device-event-action event) 'added))
-        (let ((controller
-               (add-controller kernel
-                               (controller-device-event-which event))))
-          (on-controller-add current-scene controller)))
-       ((and (controller-device-event? event)
-             (eq? (controller-device-event-action event) 'removed))
-        (let ((controller
-               (lookup-controller kernel
-                                  (controller-device-event-which event))))
-          (on-controller-remove current-scene controller)
-          (remove-controller kernel (controller-device-event-which event))
-          (close-game-controller controller)))
-       ((controller-button-down-event? event)
-        (let ((controller
-               (lookup-controller kernel
-                                  (controller-button-event-which event))))
-          (on-controller-press current-scene
+     ((mouse-motion-event? event)
+      (on-mouse-move kernel
+                     (mouse-motion-event-x event)
+                     (invert-y (mouse-motion-event-y event))
+                     (mouse-motion-event-x-rel event)
+                     (- (mouse-motion-event-y-rel event))
+                     (mouse-motion-event-buttons event)))
+     ((and (controller-device-event? event)
+           (eq? (controller-device-event-action event) 'added))
+      (let ((controller
+             (add-controller kernel
+                             (controller-device-event-which event))))
+        (on-controller-add kernel controller)))
+     ((and (controller-device-event? event)
+           (eq? (controller-device-event-action event) 'removed))
+      (let ((controller
+             (lookup-controller kernel
+                                (controller-device-event-which event))))
+        (on-controller-remove kernel controller)
+        (remove-controller kernel (controller-device-event-which event))
+        (close-game-controller controller)))
+     ((controller-button-down-event? event)
+      (let ((controller
+             (lookup-controller kernel
+                                (controller-button-event-which event))))
+        (on-controller-press kernel
+                             controller
+                             (controller-button-event-button event))))
+     ((controller-button-up-event? event)
+      (let ((controller
+             (lookup-controller kernel
+                                (controller-button-event-which event))))
+        (on-controller-release kernel
                                controller
                                (controller-button-event-button event))))
-       ((controller-button-up-event? event)
-        (let ((controller
-               (lookup-controller kernel
-                                  (controller-button-event-which event))))
-          (on-controller-release current-scene
-                                 controller
-                                 (controller-button-event-button event))))
-       ((controller-axis-event? event)
-        (let ((controller
-               (lookup-controller kernel
-                                  (controller-axis-event-which event))))
-          (on-controller-move current-scene
-                              controller
-                              (controller-axis-event-axis event)
-                              (/ (controller-axis-event-value event) 32768.0)))))))
+     ((controller-axis-event? event)
+      (let ((controller
+             (lookup-controller kernel
+                                (controller-axis-event-which event))))
+        (on-controller-move kernel
+                            controller
+                            (controller-axis-event-axis event)
+                            (/ (controller-axis-event-value event) 32768.0))))))
   (define (poll-events)
     (let ((event (poll-event)))
       (when event
@@ -239,6 +231,9 @@
         (set-window-title! (window kernel) title))
       (apply throw key args)))
 
+(define-method (on-scenes-empty (kernel <kernel>))
+  (abort-game))
+
 (define (elapsed-time)
   (sdl-ticks))
 
@@ -277,8 +272,8 @@
       (const #t)
       (lambda ()
         (parameterize ((current-kernel kernel))
-          (push-scene (thunk))
           (activate kernel)
+          (push-scene kernel (thunk))
           (run-game* #:update (lambda (dt) (update* kernel dt))
                      #:render (lambda (alpha) (render* kernel alpha))
                      #:error (lambda (stack key args)
@@ -289,46 +284,6 @@
         (deactivate kernel)
         (close-window! (window kernel))))))
 
-(define (current-scene)
-  "Return the currently active scene"
-  (match (scenes (current-kernel))
-    (() #f)
-    ((scene . rest) scene)))
-
-(define (previous-scene)
-  (match (scenes (current-kernel))
-    ((or () (_)) #f)
-    ((_ scene . rest) scene)))
-
-(define-method (push-scene (scene <scene>))
-  "Make SCENE the currently active scene and remember the previously
-active scene."
-  (let ((old (current-scene)))
-    (set! (scenes (current-kernel)) (cons scene (scenes (current-kernel))))
-    (when old (detach old))
-    (attach-to (current-kernel) scene)))
-
-(define-method (replace-scene (scene <scene>))
-  "Make SCENE the currently active scene and forget about whatever was
-previously active."
-  (let ((old (current-scene)))
-    (unless old
-      (error "no scene to replace!"))
-    (set! (scenes (current-kernel)) (cons scene (cdr (scenes (current-kernel)))))
-    (detach old)
-    (attach-to (current-kernel) scene)))
-
-(define-method (pop-scene)
-  "Replace the current scene with the previously active scene."
-  (let ((old (current-scene)))
-    (set! (scenes (current-kernel)) (cdr (scenes (current-kernel))))
-    (detach old)
-    (let ((new (current-scene)))
-      (if new
-          (attach-to (current-kernel) new)
-          ;; No scenes remain, it's time to shut down!
-          (abort-game)))))
-
 (define-meta-command ((debug-game starling) repl)
   "debug-game
 Enter a debugger for the current game loop error."