Giant code and assets drop.

1 files changed, 255 insertions, 0 deletions

diff --git a/super-bloom/game.scm b/super-bloom/game.scm
new file mode 100644
index 0000000..f5f1d99
--- /dev/null
+++ b/super-bloom/game.scm
@@ -0,0 +1,255 @@
+;;; Copyright 2023 David Thompson
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;    http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-module (super-bloom game)
+  #:use-module (catbird)
+  #:use-module (catbird asset)
+  #:use-module (catbird camera)
+  #:use-module (catbird kernel)
+  #:use-module (catbird mode)
+  #:use-module (catbird node)
+  #:use-module (catbird node-2d)
+  #:use-module (catbird region)
+  #:use-module (catbird scene)
+  #:use-module (chickadee data quadtree)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics particles)
+  #:use-module (chickadee graphics texture)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (oop goops)
+  #:use-module (super-bloom actor)
+  #:use-module (super-bloom common)
+  #:use-module (super-bloom dirt-ball)
+  #:use-module (super-bloom flower)
+  #:use-module (super-bloom player)
+  #:use-module (super-bloom water)
+  #:export (<super-bloom-mode>
+            reset-game!))
+
+(define-asset (background-texture (file (scope-datadir "assets/images/background.png")))
+  (load-image file))
+
+(define-asset (chickadee-texture (file (scope-datadir "assets/images/chickadee.png")))
+  (load-image file))
+
+(define-asset (water-particle-texture (file (scope-datadir "assets/images/water-particle.png")))
+  (load-image file))
+
+(define-asset (trail-particle-texture (file (scope-datadir "assets/images/trail-particle.png")))
+  (load-image file))
+
+(define-asset (explosion-particle-texture (file (scope-datadir "assets/images/explosion-particle.png")))
+  (load-image file))
+
+(define (make-game-quadtree)
+  (make-quadtree (make-rect 0.0 0.0 %game-width %game-height)))
+
+(define-class <super-bloom-mode> (<major-mode>)
+  (quadtree #:getter quadtree #:init-thunk make-game-quadtree))
+
+(define-method (on-enter (mode <super-bloom-mode>))
+  (let ((scene (parent mode))
+        (water-particles
+         (make <particles>
+           #:name 'water-particles
+           #:rank 1
+           #:particles
+           (make-particles 1024
+                           #:texture (artifact water-particle-texture)
+                           #:start-color white
+                           #:end-color white
+                           #:speed-range (vec2 2.0 5.0)
+                           #:acceleration-range (vec2 0.1 0.3)
+                           #:lifetime 10)))
+        (trail-particles
+         (make <particles>
+           #:name 'trail-particles
+           #:rank 1
+           #:particles
+           (make-particles 1024
+                           #:texture (artifact trail-particle-texture)
+                           #:animation-columns 3
+                           #:start-color white
+                           #:end-color white
+                           #:speed-range (vec2 0.2 0.5)
+                           #:acceleration-range (vec2 0.1 0.2)
+                           #:lifetime 12)))
+        (explosion-particles
+         (make <particles>
+           #:name 'explosion-particles
+           #:rank 1
+           #:particles
+           (make-particles 1024
+                           #:texture (artifact explosion-particle-texture)
+                           #:lifetime 20
+                           #:end-color white))))
+    (attach-to scene
+               (make <sprite>
+                 #:name 'background
+                 #:rank 0
+                 #:texture background-texture)
+               water-particles
+               trail-particles
+               explosion-particles
+               (make <player>
+                 #:name 'player
+                 #:rank 2
+                 #:position (vec2 (/ %game-width:float 2.0)
+                                  (/ %game-height:float 4.0))
+                 #:quadtree (quadtree mode)
+                 #:water-particles water-particles
+                 #:trail-particles trail-particles)
+               (make <flower>
+                 #:name 'flower
+                 #:rank 4
+                 #:position (vec2 (/ %game-width:float 2.0)
+                                  (/ %game-height:float 2.0))
+                 #:quadtree (quadtree mode)
+                 #:growth-goal 10
+                 #:growth-interval 0.5))))
+
+(define-method (player (mode <super-bloom-mode>))
+  (& (parent mode) player))
+
+(define-method (player-move-left (mode <super-bloom-mode>))
+  (set! (move-left? (player mode)) #t))
+(define-method (player-move-left-stop (mode <super-bloom-mode>))
+  (set! (move-left? (player mode)) #f))
+(define-method (player-move-right (mode <super-bloom-mode>))
+  (set! (move-right? (player mode)) #t))
+(define-method (player-move-right-stop (mode <super-bloom-mode>))
+  (set! (move-right? (player mode)) #f))
+(define-method (player-move-down (mode <super-bloom-mode>))
+  (set! (move-down? (player mode)) #t))
+(define-method (player-move-down-stop (mode <super-bloom-mode>))
+  (set! (move-down? (player mode)) #f))
+(define-method (player-move-up (mode <super-bloom-mode>))
+  (set! (move-up? (player mode)) #t))
+(define-method (player-move-up-stop (mode <super-bloom-mode>))
+  (set! (move-up? (player mode)) #f))
+
+(define-method (add-random-water (mode <super-bloom-mode>))
+  (let ((p (vec2 (random:float %game-width:float) (random:float %game-height:float))))
+    (attach-to (parent mode)
+               (make <water>
+                 #:rank 3
+                 #:position p
+                 #:quadtree (quadtree mode)))))
+
+(define-method (add-random-dirt-ball (mode <super-bloom-mode>))
+  (let ((p (vec2 (if (= (random 2) 0) -32.0 (+ %game-width:float 32.0))
+                 (+ (/ %game-height 2.0)
+                    (* (/ %game-height 2.0)
+                       (- (random:float 2.0) 1.0))))))
+    (attach-to (parent mode)
+               (make <dirt-ball>
+                 #:rank 3
+                 #:position p
+                 #:quadtree (quadtree mode)
+                 #:flower (& (parent mode) flower)
+                 #:speed 1.0
+                 #:explosion-particles (& (parent mode) explosion-particles)))))
+
+(define-method (do-spray-water (mode <super-bloom-mode>))
+  (spray-water (player mode)))
+
+(define-method (do-quit (mode <super-bloom-mode>))
+  (exit-catbird))
+
+(define-method (update (mode <super-bloom-mode>) dt)
+  (let* ((scene (parent mode))
+         (flower (& scene flower)))
+    (if flower
+        (when (= (growth-progress flower) (growth-goal flower))
+          (stop-moving (& scene player))
+          (replace-major-mode scene (make <win-mode>)))
+        (begin
+          (pk 'no-flower)
+          (stop-moving (& scene player))
+          (replace-major-mode scene (make <game-over-mode>))))))
+
+(bind-input <super-bloom-mode> (key-press 'escape) do-quit)
+(bind-input <super-bloom-mode> (key-press 'left) player-move-left)
+(bind-input <super-bloom-mode> (key-release 'left) player-move-left-stop)
+(bind-input <super-bloom-mode> (key-press 'right) player-move-right)
+(bind-input <super-bloom-mode> (key-release 'right) player-move-right-stop)
+(bind-input <super-bloom-mode> (key-press 'down) player-move-down)
+(bind-input <super-bloom-mode> (key-release 'down) player-move-down-stop)
+(bind-input <super-bloom-mode> (key-press 'up) player-move-up)
+(bind-input <super-bloom-mode> (key-release 'up) player-move-up-stop)
+(bind-input <super-bloom-mode> (key-press 'space) add-random-water)
+(bind-input <super-bloom-mode> (key-press 'return) add-random-dirt-ball)
+(bind-input <super-bloom-mode> (key-press 'z) do-spray-water)
+
+(define-class <game-over-mode> (<major-mode>))
+
+(define-method (on-enter (mode <game-over-mode>))
+  (let ((scene (parent mode)))
+    (attach-to scene
+               (make <label>
+                 #:name 'game-over-label
+                 #:rank 99
+                 #:position (vec2 0.0 200.0)
+                 #:font monogram-font
+                 #:text "GAME OVER")
+               (make <label>
+                 #:name 'instructions-label
+                 #:rank 99
+                 #:font monogram-font
+                 #:text "Press <Z> to play again"))
+    (center-in-parent (& scene game-over-label))
+    (center-horizontal-in-parent (& scene instructions-label))
+    (place-below (& scene game-over-label)
+                 (& scene instructions-label)
+                 #:padding 16.0)))
+
+(define-method (do-reset (mode <game-over-mode>))
+  (clear (parent mode))
+  (replace-major-mode (parent mode) (make <super-bloom-mode>)))
+
+(bind-input <game-over-mode> (key-press 'z) do-reset)
+
+(define-class <win-mode> (<major-mode>))
+
+(define-method (on-enter (mode <win-mode>))
+  (let ((scene (parent mode)))
+    (attach-to scene
+               (make <label>
+                 #:name 'win-label
+                 #:rank 99
+                 #:position (vec2 0.0 200.0)
+                 #:font monogram-font
+                 #:text "YES! YOUR FLOWER HAS BLOOMED :)")
+               (make <label>
+                 #:name 'instructions-label
+                 #:rank 99
+                 #:font monogram-font
+                 #:text "Press <Z> to play again"))
+    (center-horizontal-in-parent (& scene win-label))
+    (center-horizontal-in-parent (& scene instructions-label))
+    (place-below (& scene win-label)
+                 (& scene instructions-label)
+                 #:padding 16.0)))
+
+(define-method (do-reset (mode <win-mode>))
+  (clear (parent mode))
+  (replace-major-mode (parent mode) (make <super-bloom-mode>)))
+
+(bind-input <win-mode> (key-press 'z) do-reset)
+
+(define (reset-game!)
+  (let ((game-scene (scene (find-region-by-name 'main))))
+    (clear game-scene)
+    (replace-major-mode game-scene (make <super-bloom-mode>))))