From e287a11c4387382277c31735504fc762c33b4cee Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Wed, 12 Oct 2022 06:48:14 -0400
Subject: Switch to Catbird engine.

---
 bonnie-bee/game.scm | 791 +++++++++++++++++++++++++++++-----------------------
 1 file changed, 447 insertions(+), 344 deletions(-)

(limited to 'bonnie-bee/game.scm')

diff --git a/bonnie-bee/game.scm b/bonnie-bee/game.scm
index 18b177b..40d5cb6 100644
--- a/bonnie-bee/game.scm
+++ b/bonnie-bee/game.scm
@@ -20,12 +20,20 @@
   #:use-module (chickadee math vector)
   #:use-module (chickadee scripting)
   #:use-module (oop goops)
-  #:use-module (starling asset)
-  #:use-module (starling kernel)
-  #:use-module (starling node)
-  #:use-module (starling node-2d)
-  #:use-module (starling scene)
-  #:export (<game>))
+  #:use-module (catbird)
+  #:use-module (catbird asset)
+  #:use-module (catbird kernel)
+  #:use-module (catbird observer)
+  #:use-module (catbird mode)
+  #:use-module (catbird node)
+  #:use-module (catbird node-2d)
+  #:use-module (catbird scene)
+  #:export (make-game-scene))
+
+
+;;;
+;;; Shadow label
+;;;
 
 (define %text-color (rgb #xfee761))
 
@@ -37,7 +45,7 @@
              (make <label>
                #:name 'shadow
                #:position (vec2 0.0 1.0)
-               #:font (font label)
+               #:font (slot-ref label 'font)
                #:text (text label)
                #:color (color label)))
   (set! (color label) black))
@@ -46,79 +54,83 @@
   (next-method)
   (case slot-name
     ((text)
-     (set! (text (& label shadow)) new)))  )
+     (set! (text (& label shadow)) new))))
 
-(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height))
+
+;;;
+;;; Heads-up display
+;;;
 
-(define-class <game> (<scene-2d>)
-  (state #:accessor state #:init-value 'play)
-  (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds))
-  (scroll-speed #:getter scroll-speed #:init-value 0.0)
+(define-class <hud> (<node-2d>)
   (last-lives #:accessor last-lives #:init-value 0)
   (last-pollen #:accessor last-pollen #:init-value 0)
-  (last-score #:accessor last-score #:init-value 0)
-  (music-source #:getter music-source #:init-form (make-source #:loop? #t)))
-
-(define-method (change-scroll-speed (game <game>) speed)
-  (slot-set! game 'scroll-speed speed))
-
-(define-method (spawn (game <game>) (actor <actor>))
-  (set! (quadtree actor) (quadtree game))
-  (quadtree-insert! (quadtree game) (world-hitbox actor) actor)
-  (attach-to game actor))
-
-(define-method (player (game <game>))
-  (& game player))
-
-(define-method (bullets (game <game>))
-  (& game bullets))
-
-(define-method (particles (game <game>))
-  (& game particles))
+  (last-score #:accessor last-score #:init-value 0))
 
-(define-method (on-boot (game <game>))
-  (set! *random-state* (random-state-from-platform))
-  (set-cameras! game)
-  (attach-to game
-             (make <background>
-               #:name 'background
-               #:texture background-image)
-             (make <particles>
-               #:name 'particles
-               #:particles (make-particles 2048
-                                           #:texture (asset-ref particle-image)
-                                           #:end-color (make-color 1.0 1.0 1.0 0.0)))
-             (make <bullets>
-               #:name 'bullets
-               #:rank 4
-               #:quadtree (quadtree game))
+(define-method (on-boot (hud <hud>))
+  (attach-to hud
              (make <shadow-label>
-               #:name 'hud-lives
-               #:rank 5
+               #:name 'lives
                #:position (vec2 2.0 2.0)
                #:font monogram-font
                #:text "lives 0"
                #:color %text-color)
              (make <shadow-label>
-               #:name 'hud-pollen
-               #:rank 5
+               #:name 'pollen
                #:position (vec2 (/ %game-width 2.0) 2.0)
                #:font monogram-font
                #:text "pollen 0"
                #:align 'center
                #:color %text-color)
              (make <shadow-label>
-               #:name 'hud-score
-               #:rank 5
+               #:name 'score
                #:position (vec2 (- %game-width 2.0) 2.0)
                #:font monogram-font
                #:text "score 0"
                #:align 'right
                #:color %text-color)))
 
-(define-method (play-music (game <game>) music-asset)
-  (set-source-audio! (music-source game) (asset-ref music-asset))
-  (source-play (music-source game)))
+(define-method (update (hud <hud>) dt)
+  (let ((p (& (parent hud) player)))
+    (when (not (= (last-lives hud) (lives p)))
+      (set! (text (& hud lives))
+            (string-append "lives " (number->string (lives p)))))
+    (when (not (= (last-pollen hud) (pollen p)))
+      (let ((n (pollen p)))
+        (set! (text (& hud pollen))
+              (string-append "pollen "
+                             (if (= n %max-pollen) "MAX" (number->string n))))))
+    (when (not (= (last-score hud) (score p)))
+      (set! (text (& hud score))
+            (string-append "score " (number->string (score p)))))
+    (set! (last-lives hud) (lives p))
+    (set! (last-pollen hud) (pollen p))
+    (set! (last-score hud) (score p))))
+
+
+;;;
+;;; Game scene
+;;;
+
+(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height))
+(define %default-player-position (vec2 (/ %game-width 2.0) 20.0))
+
+(define-class <game-scene> (<scene>)
+  (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds))
+  (scroll-speed #:getter scroll-speed #:init-value 0.0)
+  (music-source #:getter music-source #:init-form (make-source #:loop? #t))
+  (intro-script #:accessor intro-script #:init-value #f))
+
+(define-method (change-scroll-speed (scene <game-scene>) speed)
+  (slot-set! scene 'scroll-speed speed))
+
+(define-method (spawn (scene <game-scene>) (actor <actor>))
+  (set! (quadtree actor) (quadtree scene))
+  (quadtree-insert! (quadtree scene) (world-hitbox actor) actor)
+  (attach-to scene actor))
+
+(define-method (play-music (scene <game-scene>) music-asset)
+  (set-source-audio! (music-source scene) (artifact music-asset))
+  (source-play (music-source scene)))
 
 (define* (make-turret p #:key (interval 0.5) (speed 1.0))
   (let ((turret (make <turret>
@@ -130,11 +142,11 @@
     (run-script turret
       (sleep (steps 1))
       (forever
-       (let ((theta (+ (angle-to turret (player (parent turret)))
+       (let ((theta (+ (angle-to turret (& (parent turret) player))
                        (* (- (* (random:uniform) 2.0) 1.0) 0.2)))
              (speed 1.5))
-         (audio-play (asset-ref enemy-shoot-sound))
-         (add-bullet (bullets (parent turret))
+         (audio-play (artifact enemy-shoot-sound))
+         (add-bullet (& (parent turret) bullets)
                      medium-enemy-bullet
                      (position turret)
                      (vec2 (* (cos theta) speed)
@@ -168,11 +180,14 @@
     #:health 20
     #:points 1000))
 
-(define-method (change-state (game <game>) new-state)
-  (set! (state game) new-state))
+(define-method (skip-intro (scene <game-scene>))
+  (teleport (& scene player)
+            (vec2-x %default-player-position)
+            (vec2-y %default-player-position))
+  (cancel-script (intro-script scene)))
 
-(define-method (run-level (game <game>))
-  (define (tutorial message key)
+(define-method (run-level (scene <game-scene>))
+  (define (tutorial message continue?)
     (let ((l (make <shadow-label>
                #:name 'tutorial
                #:rank 5
@@ -181,160 +196,196 @@
                #:text message
                #:align 'center
                #:color %text-color)))
-      (attach-to game l)
-      (if key
-          (wait-until (key-pressed? key))
+      (attach-to scene l)
+      (if continue?
+          (begin
+            (wait-until (continue?))
+            (sleep 1.0))
           (sleep 2.0))
       (detach l)))
-  (run-script game
-    (fade-in game 1.0))
-  (run-script game
-    (unless (getenv "SKIP_INTRO")
-      ;; Intro
-      (let ((popcorn (make-popcorn (vec2 (/ %game-width 2.0) (+ %game-height 16.0))))
-            (bullet-speed 5.0)
-            (flower-1 (make-flower (vec2 194.0 210.0)))
-            (flower-2 (make-flower (vec2 50.0 206.0)))
-            (flower-3 (make-flower (vec2 280.0 201.0)))
-            (flower-4 (make-flower (vec2 121.0 197.0)))
-            (flower-5 (make-flower (vec2 58.0 134.0)))
-            (flower-6 (make-flower (vec2 145.0 135.0)))
-            (flower-7 (make-flower (vec2 220.0 151.0)))
-            (flower-8 (make-flower (vec2 290.0 129.0))))
-        (define (shoot-at flower)
-          (add-bullet (bullets game)
-                      medium-enemy-bullet
-                      (position popcorn)
-                      (vec2* (direction-to popcorn flower) bullet-speed)))
-        (change-state game 'intro)
-        (spawn game flower-1)
-        (spawn game flower-2)
-        (spawn game flower-3)
-        (spawn game flower-4)
-        (spawn game flower-5)
-        (spawn game flower-6)
-        (spawn game flower-7)
-        (spawn game flower-8)
-        (spawn game (make-flower (vec2 194.0 95.0)))
-        (spawn game (make-flower (vec2 102.0 82.0)))
-        (spawn game (make-flower (vec2 247.0 45.0)))
-        (spawn game (make-flower (vec2 159.0 40.0)))
-        (spawn game (make-flower (vec2 73.0 28.0)))
-        (teleport (player game) 159.0 40.0)
-        (play-music game intro-music)
-        (sleep 1.0)
-        (audio-play (asset-ref pollen-release-sound))
-        (sleep 0.6)
-        (move-to (player game) 247.0 45.0 1.0)
-        (sleep 0.2)
-        (audio-play (asset-ref pollen-release-sound))
-        (sleep 0.6)
-        (move-to (player game) 102.0 76.0 1.0)
-        (sleep 0.2)
-        (audio-play (asset-ref pollen-release-sound))
-        (sleep 2.0)
-        (run-script game
-          (tween 1.0 1.0 0.0
-                 (lambda (volume)
-                   (set-source-volume! (music-source game) volume))))
-        (source-stop (music-source game))
-        (spawn game popcorn)
-        (change-velocity popcorn 0.0 -1.0)
-        (tween 2.4 -1.0 0.0
-               (lambda (dy)
-                 (change-velocity popcorn 0.0 dy)))
-        (shoot-at flower-1)
-        (sleep 0.3)
-        (shoot-at flower-2)
-        (sleep 0.3)
-        (shoot-at flower-3)
-        (sleep 0.3)
-        (shoot-at flower-4)
-        (sleep 0.3)
-        (shoot-at flower-8)
-        (sleep 0.3)
-        (shoot-at flower-7)
-        (sleep 0.3)
-        (shoot-at flower-6)
-        (sleep 0.3)
-        (shoot-at flower-5)
-        (sleep 1.0)
-        (audio-play (asset-ref hehehe-sound))
-        (sleep 1.0)
-        (tween 0.5 0.0 1.5
-               (lambda (dy)
-                 (change-velocity popcorn 0.0 dy)))
-        (sleep 1.0)))
+  (run-script scene
+    (fade-in scene 1.0))
+  (run-script scene
+    (set! (scoring-enabled? (& scene player)) #f)
+    (set! (intro-script scene)
+          (run-script scene
+            ;; Intro
+            (let ((popcorn (make-popcorn (vec2 (/ %game-width 2.0) (+ %game-height 16.0))))
+                  (bullet-speed 5.0)
+                  (flower-1 (make-flower (vec2 194.0 210.0)))
+                  (flower-2 (make-flower (vec2 50.0 206.0)))
+                  (flower-3 (make-flower (vec2 280.0 201.0)))
+                  (flower-4 (make-flower (vec2 121.0 197.0)))
+                  (flower-5 (make-flower (vec2 58.0 134.0)))
+                  (flower-6 (make-flower (vec2 145.0 135.0)))
+                  (flower-7 (make-flower (vec2 220.0 151.0)))
+                  (flower-8 (make-flower (vec2 290.0 129.0))))
+              (define (shoot-at flower)
+                (add-bullet (& scene bullets)
+                            medium-enemy-bullet
+                            (position popcorn)
+                            (vec2* (direction-to popcorn flower) bullet-speed)))
+              (spawn scene flower-1)
+              (spawn scene flower-2)
+              (spawn scene flower-3)
+              (spawn scene flower-4)
+              (spawn scene flower-5)
+              (spawn scene flower-6)
+              (spawn scene flower-7)
+              (spawn scene flower-8)
+              (spawn scene (make-flower (vec2 194.0 95.0)))
+              (spawn scene (make-flower (vec2 102.0 82.0)))
+              (spawn scene (make-flower (vec2 247.0 45.0)))
+              (spawn scene (make-flower (vec2 159.0 40.0)))
+              (spawn scene (make-flower (vec2 73.0 28.0)))
+              (teleport (& scene player) 159.0 40.0)
+              (play-music scene intro-music)
+              (sleep 1.0)
+              (audio-play (artifact pollen-release-sound))
+              (sleep 0.6)
+              (move-to (& scene player) 247.0 45.0 1.0)
+              (sleep 0.2)
+              (audio-play (artifact pollen-release-sound))
+              (sleep 0.6)
+              (move-to (& scene player) 102.0 76.0 1.0)
+              (sleep 0.2)
+              (audio-play (artifact pollen-release-sound))
+              (sleep 2.0)
+              (run-script scene
+                (tween 1.0 1.0 0.0
+                       (lambda (volume)
+                         (set-source-volume! (music-source scene) volume))))
+              (source-stop (music-source scene))
+              (spawn scene popcorn)
+              (change-velocity popcorn 0.0 -1.0)
+              (tween 2.4 -1.0 0.0
+                     (lambda (dy)
+                       (change-velocity popcorn 0.0 dy)))
+              (shoot-at flower-1)
+              (sleep 0.3)
+              (shoot-at flower-2)
+              (sleep 0.3)
+              (shoot-at flower-3)
+              (sleep 0.3)
+              (shoot-at flower-4)
+              (sleep 0.3)
+              (shoot-at flower-8)
+              (sleep 0.3)
+              (shoot-at flower-7)
+              (sleep 0.3)
+              (shoot-at flower-6)
+              (sleep 0.3)
+              (shoot-at flower-5)
+              (sleep 1.0)
+              (audio-play (artifact hehehe-sound))
+              (sleep 1.0)
+              (tween 0.5 0.0 1.5
+                     (lambda (dy)
+                       (change-velocity popcorn 0.0 dy)))
+              (sleep 1.0)
+              (enable-pollen!)
+              (replace-major-mode scene (make <play-mode>))
+              (play-music scene main-music)
+              (set-source-volume! (music-source scene) 1.0)
+              ;; Tutorial
+              (tutorial "move with ARROW keys or controller DPAD"
+                        (lambda ()
+                          (moving? (& scene player))))
+              (tutorial "press Z key or A button to shoot"
+                        (lambda ()
+                          (shoot? (& scene player))))
+              (sleep 2.0)
+              (tutorial "shoot FLOWERS and collect POLLEN for special power" #f)
+              (tutorial "press X key or B button to unleash stored power"
+                        (lambda ()
+                          (let ((p (& scene player)))
+                            (or (bombing? p)
+                                ;; Ensure bomb can be used to avoid a soft lock.
+                                (begin
+                                  (unless (= (pollen p) %max-pollen)
+                                    (set! (pollen p) %max-pollen))
+                                  #f)))))
+              (tutorial "godspeed you, little bee!" #f))))
+    (join (intro-script scene))
+    (set! (intro-script scene) #f)
+    ;; The intro and tutorial sequence set up a bunch of state, but if
+    ;; the player skips it, we need to set it up here.  Each of the
+    ;; following operations may be no-ops, depending on how far into
+    ;; the intro the player was before they skipped it.
     (enable-pollen!)
-    (change-state game 'play)
-    (play-music game main-music)
-    (set-source-volume! (music-source game) 1.0)
-    (unless (getenv "SKIP_TUTORIAL")
-      ;; Tutorial
-      (tutorial "move with ARROW keys" #f)
-      (tutorial "press Z to shoot" 'z)
-      (sleep 2.0)
-      (tutorial "shoot FLOWERS and collect POLLEN for special power" #f)
-      (tutorial "press X to unleash stored power" 'x)
-      (tutorial "godspeed you, little bee!" #f))
-    (change-scroll-speed game 15.0)
+    (unless (is-a? (major-mode scene) <play-mode>)
+      (replace-major-mode scene (make <play-mode>)))
+    (play-music scene main-music)
+    (set-source-volume! (music-source scene) 1.0)
+    (set! (pollen (& scene player)) 0)
+    (and=> (& scene tutorial) detach)
+    (clear-bullets (& scene bullets))
+    (for-each-child (lambda (child)
+                      (when (and (is-a? child <actor>)
+                                 (not (is-a? child <player>)))
+                        (detach child)))
+                    scene)
+    ;; Start the game
+    (set! (scoring-enabled? (& scene player)) #t)
+    (change-scroll-speed scene 15.0)
+    (sleep 1.0)
     ;; Wave 1
     (define* (popcorn-line n spawn-point velocity delay #:optional script)
       (let loop ((i 0))
         (when (< i n)
           (let ((popcorn (make-popcorn (vec2-copy spawn-point) velocity)))
-            (spawn game popcorn)
+            (spawn scene popcorn)
             (when script
               (run-script popcorn (script popcorn))))
           (sleep delay)
           (loop (+ i 1)))))
     (define (spawn-flower x)
-      (spawn game (make-flower (vec2 x (+ %game-height 32.0)))))
+      (spawn scene (make-flower (vec2 x (+ %game-height 32.0)))))
     (unless (getenv "SKIP_WAVE1")
-      (spawn game (make-flower (vec2 (- %game-width 64.0) (+ %game-height 32.0))))
+      (spawn scene (make-flower (vec2 (- %game-width 64.0) (+ %game-height 32.0))))
       (popcorn-line 5 (vec2 64.0 (+ %game-height 16.0))
                     (vec2 0.0 -2.0) 0.2)
       (sleep 0.5)
       (popcorn-line 5 (vec2 (- %game-width 64.0) (+ %game-height 16.0))
                     (vec2 0.0 -2.0) 0.2)
       (sleep 0.5)
-      (spawn game (make-flower (vec2 64.0 (+ %game-height 32.0))))
+      (spawn scene (make-flower (vec2 64.0 (+ %game-height 32.0))))
       (popcorn-line 5 (vec2 (/ %game-width 2.0) (+ %game-height 16.0))
                     (vec2 0.0 -2.0) 0.2)
       (sleep 1.0)
-      (run-script game
+      (run-script scene
         (popcorn-line 10 (vec2 -16.0 220.0)
                       (vec2 3.0 -0.5) 0.2))
       (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                     (vec2 -3.0 -0.5) 0.2)
-      (spawn game (make-flower (vec2 (/ %game-width 2.0) (+ %game-height 32.0))))
+      (spawn scene (make-flower (vec2 (/ %game-width 2.0) (+ %game-height 32.0))))
       (sleep 1.0)
-      (run-script game
+      (run-script scene
         (popcorn-line 30 (vec2 -16.0 220.0)
                       (vec2 2.0 -2.0) 0.2))
-      (run-script game
+      (run-script scene
         (popcorn-line 30 (vec2 (+ %game-width 16.0) 220.0)
                       (vec2 -2.0 -2.0) 0.2))
-      (spawn game (make-flower (vec2 128.0 (+ %game-height 32.0))))
+      (spawn scene (make-flower (vec2 128.0 (+ %game-height 32.0))))
       (sleep 2.0)
-      (run-script game
+      (run-script scene
         (popcorn-line 20 (vec2 -16.0 20.0)
                       (vec2 2.0 2.0) 0.2))
-      (spawn game (make-flower (vec2 256.0 (+ %game-height 32.0))))
+      (spawn scene (make-flower (vec2 256.0 (+ %game-height 32.0))))
       (popcorn-line 20 (vec2 (+ %game-width 16.0) 20.0)
                     (vec2 -2.0 2.0) 0.2)
       (sleep 3.0))
     ;; Wave 2
     (define (spawn-turret x)
-      (spawn game (make-turret (vec2 x (+ %game-height 32.0)))))
+      (spawn scene (make-turret (vec2 x (+ %game-height 32.0)))))
     (define (shoot-down enemy)
       (sleep 0.2)
       (repeat 10
-       (add-bullet (bullets game)
-                   medium-enemy-bullet
-                   (position enemy)
-                   (vec2 0.0 -2.0))
-       (sleep 0.1)))
+        (add-bullet (& scene bullets)
+                    medium-enemy-bullet
+                    (position enemy)
+                    (vec2 0.0 -2.0))
+        (sleep 0.1)))
     (unless (getenv "SKIP_WAVE2")
       (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                     (vec2 -3.0 -0.5) 0.2)
@@ -409,7 +460,7 @@
       (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                     (vec2 -3.0 -0.5) 0.2)
       (sleep 1.0)
-      (run-script game
+      (run-script scene
         (spawn-turret (* %game-width 0.25))
         (sleep 2.0)
         (spawn-turret (* %game-width 0.75))
@@ -425,14 +476,14 @@
                                                  (- (random:uniform) 0.5)))
                                            (+ %game-height 16.0))
                                      (vec2 0.0 -2.0))))
-          (spawn game popcorn)
+          (spawn scene popcorn)
           (run-script popcorn
             (sleep 0.5)
             (tween 0.5 -2.0 0.0
                    (lambda (dy)
                      (change-velocity popcorn 0.0 dy)))
             (let ((d (vec2-normalize
-                      (vec2- (vec2+ (position (player game)) (vec2 0.0 16.0))
+                      (vec2- (vec2+ (position (& scene player)) (vec2 0.0 16.0))
                              (position popcorn)))))
               (tween 0.5 0.0 4.0
                      (lambda (speed)
@@ -442,7 +493,7 @@
     ;; Wave 3
     (define (spawn-moth p)
       (let ((moth (make-moth p)))
-        (spawn game moth)
+        (spawn scene moth)
         (run-script moth
           (sleep 0.2)
           (tween 1.0 -2.0 0.0
@@ -456,11 +507,11 @@
                      (n 9)
                      (arc-step (/ (- arc-end arc-start) n))
                      (speed 1.9))
-                (audio-play (asset-ref enemy-shoot-sound))
+                (audio-play (artifact enemy-shoot-sound))
                 (let arc-loop ((j 0))
                   (when (< j n)
                     (let ((theta (+ arc-start (* j arc-step))))
-                      (add-bullet (bullets game)
+                      (add-bullet (& scene bullets)
                                   medium-enemy-bullet
                                   (position moth)
                                   (vec2 (* (cos theta) speed)
@@ -507,11 +558,11 @@
       (sleep 7.0))
     ;; Boss
     (unless (getenv "SKIP_BOSS")
-      (run-script game
+      (run-script scene
         (repeat 8
-          (audio-play (asset-ref alarm-sound))
+          (audio-play (artifact alarm-sound))
           (sleep 1.0)))
-      (run-script game
+      (run-script scene
         (let ((warning (make <shadow-label>
                          #:name 'warning
                          #:rank 9
@@ -520,11 +571,11 @@
                          #:text "WARNING!! BIG OL' BAD THING AHEAD!"
                          #:align 'center
                          #:color %text-color)))
-          (attach-to game warning)
+          (attach-to scene warning)
           (blink warning 15 0.25)
           (detach warning)))
       (sleep 7.0)
-      (spawn game (make <boss>
+      (spawn scene (make <boss>
                     #:name 'boss
                     #:rank 2
                     #:position (vec2 (/ %game-width 2.0)
@@ -535,49 +586,65 @@
       (sleep 4.5)
       (tween 1.0 15.0 0.0
              (lambda (speed)
-               (change-scroll-speed game speed)))
-      (wait-until (dead? (& game boss)))
-      (clear-bullets (bullets game)))
+               (change-scroll-speed scene speed)))
+      (wait-until (dead? (& scene boss)))
+      (clear-bullets (& scene bullets)))
     ;; Victory!
-    (set! (invincible? (player game)) #t)
-    (add-to-score (player game) (* (lives (player game)) 50000))
-    (game-complete game)))
+    (set! (invincible? (& scene player)) #t)
+    (add-to-score (& scene player) (* (lives (& scene player)) 50000))
+    (game-complete scene)))
 
-(define-method (reset-game (game <game>))
-  (stop-scripts game)
+(define-method (reset-game (scene <game-scene>))
+  (stop-scripts scene)
   (disable-pollen!)
-  (change-scroll-speed game 0.0)
-  (clear-bullets (bullets game))
-  (quadtree-clear! (quadtree game))
-  (show (& game hud-lives))
-  (show (& game hud-pollen))
+  (change-scroll-speed scene 0.0)
+  (clear-bullets (& scene bullets))
+  (quadtree-clear! (quadtree scene))
+  (show (& scene hud lives))
+  (show (& scene hud pollen))
   (for-each-child (lambda (child)
                     (when (or (is-a? child <actor>)
                               (memq (name child)
                                     '(game-over game-complete tutorial warning)))
                       (detach child)))
-                  game)
-  (spawn game
+                  scene)
+  (spawn scene
          (make <player>
            #:name 'player
            #:rank 3
-           #:position (vec2 (/ %game-width 2.0) 20.0)
+           #:position (vec2-copy %default-player-position)
            #:hitbox (make-rect -0.5 -0.5 1.0 1.0)))
-  (run-level game))
+  (run-level scene))
 
-(define-method (on-enter (game <game>))
-  (reset-game game))
+(define-method (on-boot (scene <game-scene>))
+  (attach-to scene
+             (make <background>
+               #:name 'background
+               #:texture background-image)
+             (make <particles>
+               #:name 'particles
+               #:particles (make-particles 2048
+                                           #:texture (artifact particle-image)
+                                           #:end-color (make-color 1.0 1.0 1.0 0.0)))
+             (make <bullets>
+               #:name 'bullets
+               #:rank 4
+               #:quadtree (quadtree scene))
+             (make <hud>
+               #:name 'hud
+               #:rank 5)))
 
-(define-method (game-complete (game <game>))
-  (hide (& game hud-pollen))
+(define-method (game-complete (scene <game-scene>))
+  (set! (scoring-enabled? (& scene player)) #f)
+  (hide (& scene hud pollen))
   (tween 1.0 1.0 0.0
          (lambda (volume)
-           (set-source-volume! (music-source game) volume)))
-  (source-stop (music-source game))
-  (play-music game intro-music)
-  (set-source-volume! (music-source game) 1.0)
-  (change-state game 'pre-game-complete)
-  (let ((p (player game)))
+           (set-source-volume! (music-source scene) volume)))
+  (source-stop (music-source scene))
+  (play-music scene intro-music)
+  (set-source-volume! (music-source scene) 1.0)
+  (replace-major-mode scene (make <nothing-mode>))
+  (let ((p (& scene player)))
     (stop-scripts p)
     (set! (shoot? p) #f)
     (set! (move-left? p) #f)
@@ -585,20 +652,20 @@
     (set! (move-down? p) #f)
     (set! (move-up? p) #f))
   (sleep 1.0)
-  (audio-play (asset-ref pickup-sound))
-  (spawn game (make-flower (vec2 (/ %game-width 4) 160.0)))
+  (audio-play (artifact pickup-sound))
+  (spawn scene (make-flower (vec2 (/ %game-width 4) 160.0)))
   (sleep 1.0)
-  (audio-play (asset-ref pickup-sound))
-  (spawn game (make-flower (vec2 (/ %game-width 2) 160.0)))
+  (audio-play (artifact pickup-sound))
+  (spawn scene (make-flower (vec2 (/ %game-width 2) 160.0)))
   (sleep 1.0)
-  (audio-play (asset-ref pickup-sound))
-  (spawn game (make-flower (vec2 (- %game-width (/ %game-width 4)) 160.0)))
+  (audio-play (artifact pickup-sound))
+  (spawn scene (make-flower (vec2 (- %game-width (/ %game-width 4)) 160.0)))
   (sleep 1.0)
-  (change-state game 'game-complete)
+  (replace-major-mode scene (make <game-complete-mode>))
   (let ((group (make <node-2d>
                  #:name 'game-complete
                  #:rank 5)))
-    (attach-to game group)
+    (attach-to scene group)
     (attach-to group
                (make <shadow-label>
                  #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
@@ -609,22 +676,23 @@
                (make <shadow-label>
                  #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0))
                  #:font monogram-font
-                 #:text "press ENTER to play again"
+                 #:text "press ENTER key or START button to play again"
                  #:align 'center
                  #:color %text-color)))
   (forever
-   (add-bullet (bullets game)
+   (add-bullet (& scene bullets)
                pollen-pickup
                (vec2 (random %game-width) (+ %game-height 0.0))
                (vec2 0.0 (- (+ (random:uniform) 0.5))))
    (sleep 0.1)))
 
-(define-method (game-over (game <game>))
-  (hide (& game hud-lives))
-  (hide (& game hud-pollen))
-  (change-state game 'game-over)
-  (stop-scripts game)
-  (let ((p (player game)))
+(define-method (game-over (scene <game-scene>))
+  (set! (scoring-enabled? (& scene player)) #f)
+  (hide (& scene hud lives))
+  (hide (& scene hud pollen))
+  (replace-major-mode scene (make <game-over-mode>))
+  (stop-scripts scene)
+  (let ((p (& scene player)))
     (stop-scripts p)
     (hide p)
     (set! (shoot? p) #f)
@@ -632,14 +700,14 @@
     (set! (move-right? p) #f)
     (set! (move-down? p) #f)
     (set! (move-up? p) #f))
-  (run-script game
-    (tween 1.0 (scroll-speed game) 0.0
+  (run-script scene
+    (tween 1.0 (scroll-speed scene) 0.0
            (lambda (speed)
-             (change-scroll-speed game speed))))
+             (change-scroll-speed scene speed))))
   (let ((group (make <node-2d>
                  #:name 'game-over
                  #:rank 5)))
-    (attach-to game group)
+    (attach-to scene group)
     (attach-to group
                (make <shadow-label>
                  #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
@@ -650,21 +718,21 @@
                (make <shadow-label>
                  #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0))
                  #:font monogram-font
-                 #:text "press ENTER to try again"
+                 #:text "press ENTER key or START button to try again"
                  #:align 'center
                  #:color %text-color))))
 
-(define-method (toggle-pause (game <game>))
-  (if (paused? game)
+(define-method (toggle-pause (scene <game-scene>))
+  (if (paused? scene)
       (begin
-        (detach (& game pause-overlay))
-        (source-play (music-source game))
-        (resume game))
+        (detach (& scene pause-overlay))
+        (source-play (music-source scene))
+        (resume scene))
       (let ((overlay (make <node-2d>
                        #:name 'pause-overlay
                        #:rank 99)))
-        (pause game)
-        (source-pause (music-source game))
+        (pause scene)
+        (source-pause (music-source scene))
         (attach-to overlay
                    (make <sprite>
                      #:texture darkness-image
@@ -676,110 +744,145 @@
                      #:align 'center
                      #:vertical-align 'center
                      #:color %text-color))
-        (attach-to game overlay))))
+        (attach-to scene overlay))))
 
-(define-method (play-again (game <game>))
-  (change-state game 'play-again)
-  (run-script game
+(define-method (play-again (scene <game-scene>))
+  (replace-major-mode scene (make <nothing-mode>))
+  (run-script scene
     (tween 0.5 1.0 0.0
            (lambda (volume)
-             (set-source-volume! (music-source game) volume)))
-    (source-stop (music-source game))
-    (set-source-volume! (music-source game) 1.0))
-  (run-script game
-    (fade-out game 1.0)
-    (reset-game game)))
-
-(define-method (close-game (game <game>))
-  (pop-scene (current-kernel)))
-
-(define-method (on-quit (game <game>))
-  (close-game game))
-
-(define-method (on-key-press (game <game>) key modifiers repeat?)
-  (case (state game)
-    ((play)
-     (case key
-       ((left)
-        (set! (move-left? (player game)) #t))
-       ((right)
-        (set! (move-right? (player game)) #t))
-       ((down)
-        (set! (move-down? (player game)) #t))
-       ((up)
-        (set! (move-up? (player game)) #t))
-       ((z)
-        (set! (shoot? (player game)) #t))
-       ((x)
-        (bomb (player game)))
-       ((escape)
-        (close-game game))
-       ((return)
-        (toggle-pause game))))
-    ((intro)
-     (case key
-       ((escape)
-        (close-game game))
-       ((return)
-        (toggle-pause game))))
-    ((game-over game-complete)
-     (case key
-       ((escape)
-        (close-game game))
-       ((return)
-        (play-again game))))))
-
-(define-method (on-key-release (game <game>) key modifiers)
-  (case (state game)
-    ((play)
-     (case key
-       ((left)
-        (set! (move-left? (player game)) #f))
-       ((right)
-        (set! (move-right? (player game)) #f))
-       ((down)
-        (set! (move-down? (player game)) #f))
-       ((up)
-        (set! (move-up? (player game)) #f))
-       ((z)
-        (set! (shoot? (player game)) #f))))))
-
-(define-method (update (game <game>) dt)
+             (set-source-volume! (music-source scene) volume)))
+    (source-stop (music-source scene))
+    (set-source-volume! (music-source scene) 1.0))
+  (run-script scene
+    (fade-out scene 1.0)
+    (replace-major-mode scene (make <intro-mode>))))
+
+(define-method (clean-up-actors (scene <game-scene>))
+  (let ((p (& scene player)))
+    ;; This probably shouldn't be here, but it is.
+    (shoot-maybe p (& scene bullets))
+    ;; Remove dead actors and actors that have gone too far off
+    ;; screen.
+    (for-each-child (lambda (child)
+                      (cond
+                       ((dead? child)
+                        (on-death child)
+                        (quadtree-delete! (quadtree scene)
+                                          (world-hitbox child)
+                                          child)
+                        (add-to-score (& scene player) (points child))
+                        (detach child))
+                       ((out-of-bounds? child)
+                        (quadtree-delete! (quadtree scene)
+                                          (world-hitbox child)
+                                          child)
+                        (detach child))))
+                    scene)
+    (when (= (lives p) 0) ; bummer
+      (game-over scene))))
+
+(define-method (update (scene <game-scene>) dt)
   (next-method)
-  (let ((bg (& game background)))
-    (set! (scroll-y bg) (+ (scroll-y bg) (* (scroll-speed game) dt))))
-  (case (state game)
-    ((intro play)
-     (let ((p (player game)))
-       (when (not (= (last-lives game) (lives p)))
-         (set! (text (& game hud-lives))
-               (string-append "lives " (number->string (lives p))))
-         (when (= (lives p) 0)
-           (game-over game)))
-       (when (not (= (last-pollen game) (pollen p)))
-         (let ((n (pollen p)))
-           (set! (text (& game hud-pollen))
-                 (string-append "pollen "
-                                (if (= n %max-pollen) "MAX" (number->string n))))))
-       (when (not (= (last-score game) (score p)))
-         (set! (text (& game hud-score))
-               (string-append "score " (number->string (score p)))))
-       (set! (last-lives game) (lives p))
-       (set! (last-pollen game) (pollen p))
-       (set! (last-score game) (score p))
-       (shoot-maybe p (bullets game))
-       (for-each-child (lambda (child)
-                         (cond
-                          ((dead? child)
-                           (on-death child)
-                           (quadtree-delete! (quadtree game)
-                                             (world-hitbox child)
-                                             child)
-                           (add-to-score (player game) (points child))
-                           (detach child))
-                          ((out-of-bounds? child)
-                           (quadtree-delete! (quadtree game)
-                                             (world-hitbox child)
-                                             child)
-                           (detach child))))
-                       game)))))
+  (let ((bg (& scene background)))
+    (set! (scroll-y bg) (+ (scroll-y bg) (* (scroll-speed scene) dt)))))
+
+
+;;;
+;;; Modes
+;;;
+
+(define-method (close-game (mode <major-mode>))
+  (exit-catbird))
+
+(define-method (pause-game (mode <major-mode>))
+  (toggle-pause (parent mode)))
+
+(define-method (skip-intro (mode <major-mode>))
+  (skip-intro (parent mode)))
+
+(define-class <intro-mode> (<major-mode>))
+
+(define-method (on-enter (mode <intro-mode>))
+  (reset-game (parent mode)))
+
+(define-method (update (mode <intro-mode>) dt)
+  (clean-up-actors (parent mode)))
+
+(bind-input <intro-mode> (key-press 'escape) close-game)
+(bind-input <intro-mode> (key-press 'return) skip-intro)
+(bind-input <intro-mode> (controller-press '0 'back) close-game)
+(bind-input <intro-mode> (controller-press '0 'start) skip-intro)
+
+(define-class <play-mode> (<major-mode>))
+
+(define-method (update (mode <play-mode>) dt)
+  (clean-up-actors (parent mode)))
+
+(define (move-command accessor value)
+  (lambda (mode)
+    (set! (accessor (& (parent mode) player)) value)))
+
+(define-method (player-shoot (mode <play-mode>))
+  (set! (shoot? (& (parent mode) player)) #t))
+
+(define-method (player-stop-shooting (mode <play-mode>))
+  (set! (shoot? (& (parent mode) player)) #f))
+
+(define-method (player-bomb (mode <play-mode>))
+  (bomb (& (parent mode) player)))
+
+(define-method (skip-intro-or-pause-game (mode <play-mode>))
+  (let ((scene (parent mode)))
+    (if (intro-script scene)
+        (skip-intro scene)
+        (toggle-pause scene))))
+
+(bind-input <play-mode> (key-press 'left) (move-command move-left? #t))
+(bind-input <play-mode> (key-press 'right) (move-command move-right? #t))
+(bind-input <play-mode> (key-press 'down) (move-command move-down? #t))
+(bind-input <play-mode> (key-press 'up) (move-command move-up? #t))
+(bind-input <play-mode> (key-release 'left) (move-command move-left? #f))
+(bind-input <play-mode> (key-release 'right) (move-command move-right? #f))
+(bind-input <play-mode> (key-release 'down) (move-command move-down? #f))
+(bind-input <play-mode> (key-release 'up) (move-command move-up? #f))
+(bind-input <play-mode> (key-press 'z) player-shoot)
+(bind-input <play-mode> (key-release 'z) player-stop-shooting)
+(bind-input <play-mode> (key-press 'x) player-bomb)
+(bind-input <play-mode> (key-press 'escape) close-game)
+(bind-input <play-mode> (key-press 'return) skip-intro-or-pause-game)
+(bind-input <play-mode> (controller-press 0 'dpad-left) (move-command move-left? #t))
+(bind-input <play-mode> (controller-press 0 'dpad-right) (move-command move-right? #t))
+(bind-input <play-mode> (controller-press 0 'dpad-down) (move-command move-down? #t))
+(bind-input <play-mode> (controller-press 0 'dpad-up) (move-command move-up? #t))
+(bind-input <play-mode> (controller-release 0 'dpad-left) (move-command move-left? #f))
+(bind-input <play-mode> (controller-release 0 'dpad-right) (move-command move-right? #f))
+(bind-input <play-mode> (controller-release 0 'dpad-down) (move-command move-down? #f))
+(bind-input <play-mode> (controller-release 0 'dpad-up) (move-command move-up? #f))
+(bind-input <play-mode> (controller-press 0 'a) player-shoot)
+(bind-input <play-mode> (controller-release 0 'a) player-stop-shooting)
+(bind-input <play-mode> (controller-press 0 'b) player-bomb)
+(bind-input <play-mode> (controller-press 0 'back) close-game)
+(bind-input <play-mode> (controller-press 0 'start) skip-intro-or-pause-game)
+
+(define-class <game-over-mode> (<major-mode>))
+
+(define-method (play-game-again (mode <major-mode>))
+  (play-again (parent mode)))
+
+(bind-input <game-over-mode> (key-press 'escape) close-game)
+(bind-input <game-over-mode> (key-press 'return) play-game-again)
+(bind-input <game-over-mode> (controller-press 0 'back) close-game)
+(bind-input <game-over-mode> (controller-press 0 'start) play-game-again)
+
+(define-class <game-complete-mode> (<major-mode>))
+
+(bind-input <game-complete-mode> (key-press 'escape) close-game)
+(bind-input <game-complete-mode> (key-press 'return) play-game-again)
+(bind-input <game-complete-mode> (controller-press 0 'back) close-game)
+(bind-input <game-complete-mode> (controller-press 0 'start) play-game-again)
+
+(define (make-game-scene)
+  (let ((scene (make <game-scene>)))
+    (replace-major-mode scene (make <intro-mode>))
+    scene))
-- 
cgit v1.2.3