Add scene multiplexer class.

1 files changed, 96 insertions, 1 deletions

diff --git a/starling/scene.scm b/starling/scene.scm
index deedde1..5b0d840 100644
--- a/starling/scene.scm
+++ b/starling/scene.scm
@@ -24,6 +24,7 @@
 
 (define-module (starling scene)
   #:use-module (chickadee)
+  #:use-module (ice-9 match)
   #:use-module (oop goops)
   #:use-module (sdl2 mixer)
   #:use-module (starling node)
@@ -42,7 +43,15 @@
             on-controller-remove
             on-controller-press
             on-controller-release
-            on-controller-move))
+            on-controller-move
+
+            <scene-mux>
+            current-scene
+            previous-scene
+            push-scene
+            replace-scene
+            pop-scene
+            on-scenes-empty))
 
 (define-class <scene> (<node>)
   (background-music #:accessor background-music #:init-form #f
@@ -101,3 +110,89 @@
 
 (define-method (on-controller-move (scene <scene>) controller axis value)
   #t)
+
+
+;;;
+;;; Scene Multiplexer
+;;;
+
+(define-class <scene-mux> (<node>)
+  (scenes #:accessor scenes #:init-form '()))
+
+(define-method (current-scene (mux <scene-mux>))
+  (match (scenes mux)
+    ((s . _) s)
+    (() #f)))
+
+(define-method (previous-scene (mux <scene-mux>))
+  (match (scenes mux)
+    ((_ s . _) s)
+    (_ #f)))
+
+(define-method (push-scene (mux <scene-mux>) (scene <scene>))
+  (let ((old (current-scene mux)))
+    (set! (scenes mux) (cons scene (scenes mux)))
+    (when old (detach old))
+    (attach-to mux scene)))
+
+(define-method (replace-scene (mux <scene-mux>) (scene <scene>))
+  (match (scenes mux)
+    ((old . rest)
+     (set! (scenes mux) (cons scene rest))
+     (detach old)
+     (attach-to mux scene))
+    (()
+     (error "no scene to replace!" mux))))
+
+(define-method (pop-scene (mux <scene-mux>))
+  (match (scenes mux)
+    ((old)
+     (set! (scenes mux) '())
+     (detach old)
+     (on-scenes-empty mux))
+    ((and (old new . _)
+          (_ . rest))
+     (set! (scenes mux) rest)
+     (detach old)
+     (attach-to mux new))
+    (()
+     (error "no scene to pop!" mux))))
+
+(define-method (on-scenes-empty (mux <scene-mux>))
+  #t)
+
+(define-method (on-quit (mux <scene-mux>))
+  (on-quit (current-scene mux)))
+
+(define-method (on-key-press (mux <scene-mux>) key scancode modifiers repeat?)
+  (on-key-press (current-scene mux) key scancode modifiers repeat?))
+
+(define-method (on-key-release (mux <scene-mux>) key scancode modifiers)
+  (on-key-release (current-scene mux) key scancode modifiers))
+
+(define-method (on-text-input (mux <scene-mux>) text)
+  (on-text-input (current-scene mux) text))
+
+(define-method (on-mouse-press (mux <scene-mux>) button clicks x y)
+  (on-mouse-press (current-scene mux) button clicks x y))
+
+(define-method (on-mouse-release (mux <scene-mux>) button x y)
+  (on-mouse-release (current-scene mux) button x y))
+
+(define-method (on-mouse-move (mux <scene-mux>) x y x-rel y-rel buttons)
+  (on-mouse-move (current-scene mux) x y x-rel y-rel buttons))
+
+(define-method (on-controller-add (mux <scene-mux>) controller)
+  (on-controller-add (current-scene mux) controller))
+
+(define-method (on-controller-remove (mux <scene-mux>) controller)
+  (on-controller-remove (current-scene mux) controller))
+
+(define-method (on-controller-press (mux <scene-mux>) controller button)
+  (on-controller-press (current-scene mux) controller button))
+
+(define-method (on-controller-release (mux <scene-mux>) controller button)
+  (on-controller-release (current-scene mux) controller button))
+
+(define-method (on-controller-move (mux <scene-mux>) controller axis value)
+  (on-controller-move (current-scene mux) controller axis value))