From 45791c1360c98957ebe27655d59a2ae9db6cd709 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 4 Jun 2023 09:25:06 -0400 Subject: Giant code and assets drop. --- super-bloom/game.scm | 255 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 255 insertions(+) create mode 100644 super-bloom/game.scm (limited to 'super-bloom/game.scm') 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 ( + 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 10 + #:growth-interval 0.5)))) + +(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 (add-random-water (mode )) + (let ((p (vec2 (random:float %game-width:float) (random:float %game-height:float)))) + (attach-to (parent mode) + (make + #:rank 3 + #:position p + #:quadtree (quadtree mode))))) + +(define-method (add-random-dirt-ball (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 + #: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 )) + (spray-water (player mode))) + +(define-method (do-quit (mode )) + (exit-catbird)) + +(define-method (update (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 ))) + (begin + (pk 'no-flower) + (stop-moving (& scene player)) + (replace-major-mode scene (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) + +(define-class ()) + +(define-method (on-enter (mode )) + (let ((scene (parent mode))) + (attach-to scene + (make