Factor out splash screen and credits sequence into their own scenes.

5 files changed, 178 insertions, 113 deletions

diff --git a/test-subject/assets.scm b/test-subject/assets.scm
index 68d3101..e3604a5 100644
--- a/test-subject/assets.scm
+++ b/test-subject/assets.scm
@@ -25,7 +25,10 @@
             key-press-sound
             device-sound
             gameplay-music
-            credits-music))
+            credits-music
+            play-click-sound
+            play-key-press-sound
+            play-device-sound))
 
 (define (scope-datadir file-name)
   (let ((prefix (or (getenv "TEST_SUBJECT_DATADIR") (getcwd))))
@@ -54,3 +57,12 @@
 (define-asset device-sound (load-audio (scope-datadir "assets/sounds/switch38.wav")))
 (define-asset gameplay-music (load-audio (scope-datadir "assets/sounds/ambientmain_0.ogg") #:mode 'stream))
 (define-asset credits-music (load-audio (scope-datadir "assets/sounds/end-theme.mp3") #:mode 'stream))
+
+(define (play-click-sound)
+  (audio-play (asset-ref click-sound)))
+
+(define (play-key-press-sound)
+  (audio-play (asset-ref key-press-sound)))
+
+(define (play-device-sound)
+  (audio-play (asset-ref device-sound)))
diff --git a/test-subject/common.scm b/test-subject/common.scm
new file mode 100644
index 0000000..9e756b3
--- /dev/null
+++ b/test-subject/common.scm
@@ -0,0 +1,24 @@
+(define-module (test-subject common)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics viewport)
+  #:use-module (chickadee math vector)
+  #:use-module (oop goops)
+  #:use-module (starling node-2d)
+  #:use-module (starling scene)
+  #:export (%window-width
+            %window-height
+            %game-width
+            %game-height
+            set-cameras!))
+
+(define %window-width 1280)
+(define %window-height 720)
+(define %game-width 640)
+(define %game-height 360)
+
+(define-method (set-cameras! (scene <scene-2d>))
+  (set! (cameras scene)
+        (list (make <camera-2d>
+                #:resolution (vec2 %game-width %game-height)
+                #:viewport (make-viewport 0 0 %window-width %window-height
+                                          #:clear-color black)))))
diff --git a/test-subject/credits.scm b/test-subject/credits.scm
new file mode 100644
index 0000000..98c9257
--- /dev/null
+++ b/test-subject/credits.scm
@@ -0,0 +1,64 @@
+(define-module (test-subject credits)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (oop goops)
+  #:use-module (starling kernel)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:use-module (starling scene)
+  #:use-module (test-subject assets)
+  #:use-module (test-subject common)
+  #:export (<credits>))
+
+(define-class <credits> (<scene-2d>)
+  (true-ending? #:getter true-ending? #:init-keyword #:true-ending?
+                #:init-value #f)
+  (click-channel #:getter click-channel #:init-thunk make-channel))
+
+(define-method (on-boot (credits <credits>))
+  (set-cameras! credits)
+  (attach-to credits
+             (make <sprite>
+               #:name 'background
+               #:texture lightness)
+             (make <label>
+               #:name 'label
+               #:font monogram-font
+               #:color black
+               #:align 'center
+               #:vertical-align 'center
+               #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0)))))
+
+(define-method (on-enter (credits <credits>))
+  (define* (credit line #:optional (sleep? #t))
+    (set! (text (& credits label)) line)
+    (when sleep? (sleep 120)))
+  (run-script credits
+    (set! (background-music credits) credits-music)
+    (set! (background-music-loop? credits) #f)
+    (sleep 60)
+    (credit "The Test Subject")
+    (credit "developed by David Thompson (GPLv3) https://dthompson.us")
+    (credit "made for the Spring Lisp Game Jam 2021 https://itch.io/jam/spring-lisp-game-jam-2021")
+    (credit "monogram font by datagoblin (CC0) https://datagoblin.itch.io/monogram")
+    (credit "old fax font by George Blackwell (CC-BY 4.0) https://georgeblackwell.itch.io/old-fax")
+    (credit "UI sounds by Kenney (CC0) https://opengameart.org/content/51-ui-sound-effects-buttons-switches-and-clicks")
+    (credit "background music by brandon75689 (CC0) https://opengameart.org/content/tragic-ambient-main-menu")
+    (credit "credits music by tcarisland (CC-BY 4.0) https://opengameart.org/content/the-end")
+    (if (true-ending? credits)
+        (credit "congratulations on reaching the true ending!")
+        (credit "the true ending still awaits you..."))
+    (credit "click to play again" #f)
+    (channel-clear! (click-channel credits))
+    (channel-get (click-channel credits))
+    (play-click-sound)
+    (tween 120 white black
+           (lambda (color)
+             (set! (tint (& credits background)) color))
+           #:interpolate color-lerp)
+    (pop-scene (current-kernel))))
+
+(define-method (on-mouse-release (credits <credits>) button x y)
+  (when (eq? button 'left)
+    (channel-put! (click-channel credits) #t)))
diff --git a/test-subject/game.scm b/test-subject/game.scm
index 0540215..b7dc1af 100644
--- a/test-subject/game.scm
+++ b/test-subject/game.scm
@@ -17,15 +17,13 @@
   #:use-module (starling ring-buffer)
   #:use-module (starling scene)
   #:use-module (test-subject assets)
+  #:use-module (test-subject common)
+  #:use-module (test-subject credits)
   #:use-module (test-subject device)
   #:use-module (test-subject text-box)
   #:duplicates (merge-generics replace warn-override-core warn last)
-  #:export (launch-game))
+  #:export (<game>))
 
-(define window-width 1280)
-(define window-height 720)
-(define game-width 640)
-(define game-height 360)
 (define player-display-name "")
 
 (define-theme gui-theme
@@ -56,16 +54,8 @@
       "The Wiremind"
       "??????"))
 
-(define (play-click-sound)
-  (audio-play (asset-ref click-sound)))
-
-(define (play-key-press-sound)
-  (audio-play (asset-ref key-press-sound)))
-
-(define (play-device-sound)
-  (audio-play (asset-ref device-sound)))
-
 (define-method (reset-game (game <game>))
+  (detach-all game)
   (set! (background-music game) #f)
   (set! (subject-name-known? game) #f)
   (set! (has-fridge-key? game) #f)
@@ -105,6 +95,7 @@
     (match choices
       (()
        (set! (state game) 'dialog)
+       (channel-clear! (click-channel game))
        (channel-get (click-channel game))
        (play-click-sound)
        (detach c)
@@ -118,7 +109,7 @@
                  (make <vertical-container>
                    #:name 'choices
                    #:rank 9
-                   #:position (vec2 (/ game-width 4.0)
+                   #:position (vec2 (/ %game-width 4.0)
                                     76.0)
                    #:children
                    (map (match-lambda
@@ -127,7 +118,7 @@
                              #:margin 2.0
                              #:children
                              (list (make <button>
-                                     #:width (/ game-width 2.0)
+                                     #:width (/ %game-width 2.0)
                                      #:height 24.0
                                      #:text str
                                      #:listeners
@@ -150,31 +141,6 @@
 (define-method (increment-friendship (game <game>))
   (set! (friendship game) (+ (friendship game) 1)))
 
-(define-method (splash (game <game>))
-  (set! (state game) 'splash)
-  (attach-to game
-             (make <sprite>
-               #:name 'intro-lightness
-               #:texture lightness)
-             (make <label>
-               #:name 'intro-splash
-               #:font monogram-font
-               #:color black
-               #:align 'center
-               #:vertical-align 'center
-               #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
-  (set! (text (& game intro-splash)) "Nonexistent Game Studio sheepishly presents")
-  (sleep 120)
-  (set! (text (& game intro-splash)) "The Test Subject - A Spring Lisp Game Jam 2021 submission")
-  (sleep 120)
-  (tween 120 white black
-         (lambda (color)
-           (set! (tint (& game intro-lightness)) color))
-         #:interpolate color-lerp)
-  (detach (& game intro-lightness)
-          (& game intro-splash))
-  (intro game))
-
 (define-method (intro (game <game>))
   (set! (state game) 'intro)
   (attach-to game
@@ -247,9 +213,9 @@
                          (make <vertical-container>
                               #:name 'pin-pad
                               #:rank 9
-                              #:position (vec2 (- (/ game-width 2.0)
+                              #:position (vec2 (- (/ %game-width 2.0)
                                                   (/ (* 5.0 32.0) 2.0))
-                                               (- (/ game-height 2.0)
+                                               (- (/ %game-height 2.0)
                                                   (/ (* 3.0 32.0) 2.0)))
                               #:children
                               (list (make <margin-container>
@@ -665,13 +631,13 @@ diz--"))
                            #:font old-fax-font
                            #:text (car pages)
                            #:color black
-                           #:position (vec2 (+ (/ game-width 4.0) 2.0)
-                                            (- game-height
+                           #:position (vec2 (+ (/ %game-width 4.0) 2.0)
+                                            (- %game-height
                                                (font-line-height
                                                 (asset-ref old-fax-font)))))
                          (make <horizontal-container>
                            #:name 'buttons
-                           #:position (vec2 (- (/ game-width 2.0)
+                           #:position (vec2 (- (/ %game-width 2.0)
                                                (/ (+ 70.0 32.0 32.0)
                                                   2.0))
                                             0.0)
@@ -966,6 +932,11 @@ if you would just open the door.")
   (set! (background-music-loop? game) #t)
   (fade-in))
 
+(define-method (roll-credits (game <game>))
+  (set! (first-playthrough? game) #f)
+  (push-scene (current-kernel)
+              (make <credits> #:true-ending? (>= (friendship game) 3))))
+
 (define-method (good-ending (game <game>))
   (set! (state game) 'good-ending)
   (attach-to game
@@ -982,8 +953,7 @@ if you would just open the door.")
   (dialog game player-display-name "> The footsteps resume.  They grow quieter... eventually it is silent.")
   (dialog game player-display-name "> You breathe deeply, pick up your notebook, and head for the exit.")
   (sleep 60)
-  (detach-all game)
-  (credits game))
+  (roll-credits game))
 
 (define-method (bad-ending-1 (game <game>))
   (set! (state game) 'bad-ending-1)
@@ -1002,8 +972,7 @@ if you would just open the door.")
   (dialog game (subject-name game) "You did the right thing, in the end.  For that I am grateful.")
   (dialog game (subject-name game) "You won't feel a thing.  The rest won't be so lucky.")
   (sleep 10)
-  (detach-all game)
-  (credits game))
+  (roll-credits game))
 
 (define-method (bad-ending-2 (game <game>))
   (set! (state game) 'bad-ending-1)
@@ -1031,64 +1000,17 @@ time?")
           "I guess it's game over for you.")
   (dialog game player-display-name
           "> You collapse onto the floor, struggling to breathe...")
-  (detach-all game)
-  (credits game))
-
-(define-method (credits (game <game>))
-  (define (credit line)
-    (set! (text (& game credits)) line)
-    (sleep 120))
-  (set! (state game) 'credits)
-  (set! (background-music game) credits-music)
-  (set! (background-music-loop? game) #f)
-  (attach-to game
-             (make <sprite>
-               #:name 'background
-               #:texture lightness)
-             (make <label>
-               #:name 'credits
-               #:font monogram-font
-               #:color black
-               #:align 'center
-               #:vertical-align 'center
-               #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
-  (sleep 60)
-  (credit "The Test Subject")
-  (credit "developed by David Thompson (GPLv3) https://dthompson.us")
-  (credit "made for the Spring Lisp Game Jam 2021 https://itch.io/jam/spring-lisp-game-jam-2021")
-  (credit "monogram font by datagoblin (CC0) https://datagoblin.itch.io/monogram")
-  (credit "old fax font by George Blackwell (CC-BY 4.0) https://georgeblackwell.itch.io/old-fax")
-  (credit "UI sounds by Kenney (CC0) https://opengameart.org/content/51-ui-sound-effects-buttons-switches-and-clicks")
-  (credit "background music by brandon75689 (CC0) https://opengameart.org/content/tragic-ambient-main-menu")
-  (credit "credits music by tcarisland (CC-BY 4.0) https://opengameart.org/content/the-end")
-  (if (>= (friendship game) 3)
-      (credit "congratulations on reaching the true ending!")
-      (credit "the true ending still awaits you..."))
-  (credit "click to play again")
-  (set! (first-playthrough? game) #f)
-  (channel-get (click-channel game))
-  (play-click-sound)
-  (tween 120 white black
-         (lambda (color)
-           (set! (tint (& game background)) color))
-         #:interpolate color-lerp)
-  (detach-all game)
-  (reset-game game)
-  (intro game))
+  (roll-credits game))
 
 (define-method (on-boot (game <game>))
-  (set! (cameras game)
-        (list (make <camera-2d>
-                #:resolution (vec2 game-width game-height)
-                #:viewport (make-viewport 0 0 window-width window-height
-                                          #:clear-color black))))
+  (set-cameras! game)
   ;; Dialog nodes.
   (parameterize ((current-theme gui-theme))
     (set! (dialog-container game)
           (make <vertical-container>
             #:name 'dialog-container
             #:rank 999
-            #:position (vec2 (/ (* game-width .25) 2.0) 0.0)
+            #:position (vec2 (/ (* %game-width .25) 2.0) 0.0)
             #:children
             (list (make <margin-container>
                     #:name 'name-margin
@@ -1099,10 +1021,12 @@ time?")
                             #:font monogram-font)))
                   (make <text-box>
                     #:name 'text-box
-                    #:width (round (* game-width .75))
-                    #:height 60.0)))))
+                    #:width (round (* %game-width .75))
+                    #:height 60.0))))))
+
+(define-method (on-enter (game <game>))
   (run-script game
-    (splash game)))
+    (intro game)))
 
 (define-method (on-mouse-move (game <game>) x y x-rel y-rel buttons)
   (case (state game)
@@ -1113,7 +1037,7 @@ time?")
 
 (define-method (on-mouse-release (game <game>) button x y)
   (case (state game)
-    ((dialog credits)
+    ((dialog)
      (when (eq? button 'left)
        (channel-put! (click-channel game) #t)))
     ((terminal)
@@ -1135,11 +1059,3 @@ time?")
   (case (state game)
     ((terminal)
      (channel-put! (terminal-channel game) text))))
-
-(define (launch-game)
-  (boot-kernel (make <kernel>
-                 #:window-config (make <window-config>
-                                   #:title "The Test Subject - Spring Lisp Game Jam 2021"
-                                   #:width window-width
-                                   #:height window-height))
-               (lambda () (make <game>))))
diff --git a/test-subject/splash.scm b/test-subject/splash.scm
new file mode 100644
index 0000000..f014807
--- /dev/null
+++ b/test-subject/splash.scm
@@ -0,0 +1,49 @@
+(define-module (test-subject splash)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (oop goops)
+  #:use-module (starling kernel)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:use-module (starling scene)
+  #:use-module (test-subject assets)
+  #:use-module (test-subject common)
+  #:use-module (test-subject game)
+  #:export (launch-game))
+
+(define-class <splash> (<scene-2d>))
+
+(define-method (on-boot (splash <splash>))
+  (set-cameras! splash)
+  (attach-to splash
+             (make <sprite>
+               #:name 'background
+               #:texture lightness)
+             (make <label>
+               #:name 'label
+               #:font monogram-font
+               #:color black
+               #:align 'center
+               #:vertical-align 'center
+               #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0)))))
+
+(define-method (on-enter (splash <splash>))
+  (run-script splash
+    (set! (text (& splash label)) "Nonexistent Game Studio sheepishly presents")
+    (sleep 120)
+    (set! (text (& splash label)) "The Test Subject - A Spring Lisp Game Jam 2021 submission")
+    (sleep 120)
+    (tween 120 white black
+           (lambda (color)
+             (set! (tint (& splash background)) color))
+           #:interpolate color-lerp)
+    (replace-scene (current-kernel) (make <game>))))
+
+(define (launch-game)
+  (boot-kernel (make <kernel>
+                 #:window-config (make <window-config>
+                                   #:title "The Test Subject - Spring Lisp Game Jam 2021"
+                                   #:width %window-width
+                                   #:height %window-height))
+               (lambda () (make <splash>))))