;;; 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 (chickadee scripting) #: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 ( 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 () (quadtree #:getter quadtree #:init-thunk make-game-quadtree)) (define-method (on-enter (mode )) (let ((scene (parent mode)) (water-particles (make #: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 #: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 #:name 'explosion-particles #:rank 1 #:particles (make-particles 1024 #:texture (artifact explosion-particle-texture) #:lifetime 20 #:end-color white)))) (attach-to scene (make #:name 'background #:rank 0 #:texture background-texture) water-particles trail-particles explosion-particles (make #: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 #:name 'flower #:rank 4 #:position (vec2 (/ %game-width:float 2.0) (/ %game-height:float 2.0)) #:quadtree (quadtree mode) #:growth-goal 20 #:growth-interval 3.0)) (start-game mode))) (define-method (spawn-water (mode ) position) (attach-to (parent mode) (make #:rank 3 #:position position #:quadtree (quadtree mode)))) (define-method (spawn-dirt-ball (mode ) position) (attach-to (parent mode) (make #:rank 3 #:position position #:quadtree (quadtree mode) #:flower (& (parent mode) flower) #:speed 1.0 #:explosion-particles (& (parent mode) explosion-particles)))) (define-method (spawn-random-water (mode )) (spawn-water mode (vec2 (random:float %game-width:float) (random:float %game-height:float)))) (define-method (spawn-random-dirt-ball (mode )) (spawn-dirt-ball mode (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)))))) (define-method (wave1 (mode )) (spawn-random-water mode) (sleep 1.0) (spawn-random-water mode) (sleep 1.0) (spawn-random-dirt-ball mode)) (define-method (wave2 (mode )) (spawn-random-water mode) (spawn-random-water mode) (sleep 1.0) (spawn-random-water mode) (spawn-random-water mode) (sleep 1.0) (spawn-random-dirt-ball mode) (sleep 1.0) (spawn-random-dirt-ball mode) (sleep 1.0) (spawn-random-dirt-ball mode)) (define-method (wave3 (mode )) (spawn-random-water mode) (spawn-random-water mode) (spawn-random-water mode) (spawn-random-water mode) (spawn-random-water mode) (spawn-random-water mode) (sleep 1.0) (spawn-random-dirt-ball mode) (sleep 1.0) (spawn-random-dirt-ball mode) (spawn-random-dirt-ball mode) (sleep 1.0) (spawn-random-dirt-ball mode)) (define hw (/ %game-width:float 2.0)) (define hh (/ %game-height:float 2.0)) (define-method (wave4 (mode )) (let ((offset 200.0)) (spawn-random-water mode) (spawn-random-water mode) (sleep 1.0) (spawn-dirt-ball mode (vec2 hw (+ hh offset))) (spawn-dirt-ball mode (vec2 hw (- hh offset))) (spawn-dirt-ball mode (vec2 (+ hw offset) hh)) (spawn-dirt-ball mode (vec2 (- hw offset) hh)))) (define waves (vector wave1 wave2 wave3 wave4)) (define-method (do-random-wave (mode )) (let ((wave (vector-ref waves (random (vector-length waves))))) (wave mode))) (define-method (start-game (mode )) (run-script mode (spawn-water mode (vec2 120.0 100.0)) (sleep 1.0) (spawn-water mode (vec2 160.0 140.0)) (sleep 1.0) (spawn-water mode (vec2 200.0 100.0)) (sleep 3.0) (wave1 mode) (sleep 5.0) (wave2 mode) (sleep 5.0) (forever (do-random-wave mode) (sleep 5.0)))) (define-method (player (mode )) (& (parent mode) player)) (define-method (player-move-left (mode )) (set! (move-left? (player mode)) #t)) (define-method (player-move-left-stop (mode )) (set! (move-left? (player mode)) #f)) (define-method (player-move-right (mode )) (set! (move-right? (player mode)) #t)) (define-method (player-move-right-stop (mode )) (set! (move-right? (player mode)) #f)) (define-method (player-move-down (mode )) (set! (move-down? (player mode)) #t)) (define-method (player-move-down-stop (mode )) (set! (move-down? (player mode)) #f)) (define-method (player-move-up (mode )) (set! (move-up? (player mode)) #t)) (define-method (player-move-up-stop (mode )) (set! (move-up? (player mode)) #f)) (define-method (do-spray-water (mode )) (spray-water (player mode))) (define-method (do-quit (mode )) (exit-catbird)) (define-method (update (mode ) dt) (with-agenda (agenda mode) (update-agenda dt)) (let* ((scene (parent mode)) (flower (& scene flower))) (if flower (when (= (growth-progress flower) (growth-goal flower)) (stop-moving (& scene player)) (for-each-child (lambda (child) (when (is-a? child ) (set! (dead? child) #t))) scene) (replace-major-mode scene (make ))) (begin (pk 'no-flower) (stop-moving (& scene player)) (replace-major-mode scene (make )))))) (define-method (do-reset (mode )) (clear (parent mode)) (replace-major-mode (parent mode) (make ))) (bind-input (key-press 'escape) do-quit) (bind-input (key-press 'left) player-move-left) (bind-input (key-release 'left) player-move-left-stop) (bind-input (key-press 'right) player-move-right) (bind-input (key-release 'right) player-move-right-stop) (bind-input (key-press 'down) player-move-down) (bind-input (key-release 'down) player-move-down-stop) (bind-input (key-press 'up) player-move-up) (bind-input (key-release 'up) player-move-up-stop) (bind-input (key-press 'space) add-random-water) (bind-input (key-press 'return) add-random-dirt-ball) (bind-input (key-press 'z) do-spray-water) (bind-input (key-press 'r) do-reset) (define-class ()) (define-method (on-enter (mode )) (let ((scene (parent mode))) (attach-to scene (make