diff options
Diffstat (limited to 'super-bloom')
| -rw-r--r-- | super-bloom/actor.scm | 99 | ||||
| -rw-r--r-- | super-bloom/common.scm | 69 | ||||
| -rw-r--r-- | super-bloom/dirt-ball.scm | 81 | ||||
| -rw-r--r-- | super-bloom/flower.scm | 146 | ||||
| -rw-r--r-- | super-bloom/game.scm | 255 | ||||
| -rw-r--r-- | super-bloom/main.scm | 75 | ||||
| -rw-r--r-- | super-bloom/player.scm | 170 | ||||
| -rw-r--r-- | super-bloom/water.scm | 60 |
8 files changed, 938 insertions, 17 deletions
diff --git a/super-bloom/actor.scm b/super-bloom/actor.scm new file mode 100644 index 0000000..0ba495f --- /dev/null +++ b/super-bloom/actor.scm @@ -0,0 +1,99 @@ +(define-module (super-bloom actor) + #:use-module (catbird asset) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (chickadee audio) + #:use-module (chickadee data quadtree) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (oop goops) + #:export (<actor> + velocity + hitbox + world-hitbox + quadtree + change-velocity + direction-to + angle-to + after-move + on-collide + refresh-world-hitbox)) + +(define-class <actor> (<node-2d>) + (velocity #:getter velocity #:init-keyword #:velocity #:init-form (vec2 0.0 0.0)) + (hitbox #:getter hitbox #:init-keyword #:hitbox) + (world-hitbox #:getter world-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0)) + (quadtree #:accessor quadtree #:init-keyword #:quadtree)) + +(define-method (initialize (actor <actor>) initargs) + (next-method) + (refresh-world-hitbox actor)) + +(define-method (change-velocity (actor <actor>) dx dy) + (set-vec2! (velocity actor) dx dy)) + +(define-method (direction-to (actor <actor>) (other <actor>)) + (let ((dir (vec2- (position other) (position actor)))) + (vec2-normalize! dir) + dir)) + +(define-method (angle-to (actor <actor>) (other <actor>)) + (let ((p1 (position actor)) + (p2 (position other))) + (atan (- (vec2-y p2) (vec2-y p1)) + (- (vec2-x p2) (vec2-x p1))))) + +(define-method (add-to-quadtree (actor <actor>)) + (quadtree-insert! (quadtree actor) (world-hitbox actor) actor)) + +(define-method (remove-from-quadtree (actor <actor>)) + (quadtree-delete! (quadtree actor) (world-hitbox actor) actor)) + +(define-method (refresh-world-hitbox (actor <actor>)) + (let ((p (position actor)) + (h (hitbox actor)) + (wh (world-hitbox actor))) + (set-rect-x! wh (+ (vec2-x p) (rect-x h))) + (set-rect-y! wh (+ (vec2-y p) (rect-y h))) + (set-rect-width! wh (rect-width h)) + (set-rect-height! wh (rect-height h)))) + +(define-method (on-collide a b) + #f) + +(define-method (on-enter (actor <actor>)) + (refresh-world-hitbox actor) + (add-to-quadtree actor)) + +(define-method (on-exit (actor <actor>)) + (remove-from-quadtree actor)) + +(define-method (collision-check (actor <actor>)) + (let ((p (position actor)) + (r (world-hitbox actor))) + (quadtree-find + (quadtree actor) r + (lambda (other) + (and (not (eq? other actor)) + (rect-intersects? r (world-hitbox other)) + (on-collide actor other)))))) + +(define-method (after-move (actor <actor>)) + #t) + +(define-method (update (actor <actor>) dt) + (let ((p (position actor)) + (v (velocity actor))) + (if (and (= (vec2-x v) 0.0) + (= (vec2-y v) 0.0)) + (collision-check actor) + (begin + (remove-from-quadtree actor) + (set-vec2! p + (+ (vec2-x p) (vec2-x v)) + (+ (vec2-y p) (vec2-y v))) + (after-move actor) + (refresh-world-hitbox actor) + (collision-check actor) + (add-to-quadtree actor) + (expire-local-matrix actor))))) diff --git a/super-bloom/common.scm b/super-bloom/common.scm new file mode 100644 index 0000000..08d4eae --- /dev/null +++ b/super-bloom/common.scm @@ -0,0 +1,69 @@ +;;; 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 common) + #:use-module (catbird asset) + #:use-module (chickadee) + #:use-module (chickadee audio) + #:use-module (chickadee graphics text) + #:use-module (oop goops) + #:export (%default-width + %default-height + %game-width + %game-height + %game-width:float + %game-height:float + scope-datadir + monogram-font + explosion-sound + absorb-sound + watered-sound + spray-sound + random:float + steps + water)) + +(define %default-width 640) +(define %default-height 480) +(define %game-width 320) +(define %game-height 240) +(define %game-width:float (exact->inexact %game-width)) +(define %game-height:float (exact->inexact %game-height)) + +(define (scope-datadir file-name) + (let ((prefix (or (getenv "SUPERBLOOM_DATADIR") (getcwd)))) + (string-append prefix "/" file-name))) + +(define-asset (monogram-font (file (scope-datadir "assets/fonts/monogram_extended.ttf"))) + (load-font file 12 #:smooth? #f)) + +(define-asset (explosion-sound (file (scope-datadir "assets/audio/explosion.wav"))) + (load-audio file)) + +(define-asset (absorb-sound (file (scope-datadir "assets/audio/absorb.wav"))) + (load-audio file)) + +(define-asset (watered-sound (file (scope-datadir "assets/audio/watered.wav"))) + (load-audio file)) + +(define-asset (spray-sound (file (scope-datadir "assets/audio/spray.wav"))) + (load-audio file)) + +(define (random:float n) + (* (random:uniform) n)) + +(define (steps n) + (* n (current-timestep))) + +(define-accessor water) diff --git a/super-bloom/dirt-ball.scm b/super-bloom/dirt-ball.scm new file mode 100644 index 0000000..fd86d5b --- /dev/null +++ b/super-bloom/dirt-ball.scm @@ -0,0 +1,81 @@ +;;; 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 dirt-ball) + #:use-module (catbird asset) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (chickadee audio) + #:use-module (chickadee graphics particles) + #:use-module (chickadee graphics texture) + #:use-module (chickadee math) + #: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 flower) + #:use-module (super-bloom water) + #:export (<dirt-ball>)) + +(define-asset (dirt-ball-tileset (file (scope-datadir "assets/images/dirt-ball.png"))) + (load-tileset file 32 32)) + +(define-class <dirt-ball> (<actor>) + (flower #:accessor flower #:init-keyword #:flower) + (speed #:accessor speed #:init-keyword #:speed) + (dead? #:accessor dead? #:init-value #f) + (hitbox #:getter hitbox #:init-form (make-rect -8.0 -8.0 16.0 16.0)) + (explosion-particles #:accessor explosion-particles #:init-keyword #:explosion-particles)) + +(define-method (initialize (dirt-ball <dirt-ball>) initargs) + (next-method) + (attach-to dirt-ball + (make <animated-sprite> + #:name 'sprite + #:atlas dirt-ball-tileset + #:origin (vec2 16.0 16.0) + #:animations `((default . ,(make <animation> + #:frames #(0 1) + #:frame-duration 0.3)) + (up . ,(make <animation> + #:frames #(2 3) + #:frame-duration 0.3))))) + (let ((dir (direction-to dirt-ball (flower dirt-ball)))) + (change-velocity dirt-ball + (* (vec2-x dir) (speed dirt-ball)) + (* (vec2-y dir) (speed dirt-ball)))) + (update-animation dirt-ball)) + +(define-method (update-animation (dirt-ball <dirt-ball>)) + (let ((dy (vec2-y (velocity dirt-ball)))) + (change-animation (& dirt-ball sprite) (if (> dy 0.0) 'up 'default)))) + +(define-method (on-splash (dirt-ball <dirt-ball>)) + (set! (dead? dirt-ball) #t)) + +(define-method (on-collide (dirt-ball <dirt-ball>) (flower <flower>)) + (damage flower 5) + (set! (dead? dirt-ball) #t)) + +(define-method (update (dirt-ball <dirt-ball>) _dt) + (next-method) + (when (dead? dirt-ball) + (let ((p (position dirt-ball))) + (audio-play (artifact explosion-sound)) + (add-particle-emitter (particles (explosion-particles dirt-ball)) + (make-particle-emitter (make-rect (vec2-x p) (vec2-y p) 0.0 0.0) + 40 3)) + (detach dirt-ball)))) diff --git a/super-bloom/flower.scm b/super-bloom/flower.scm new file mode 100644 index 0000000..428b158 --- /dev/null +++ b/super-bloom/flower.scm @@ -0,0 +1,146 @@ +;;; 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 flower) + #:use-module (catbird asset) + #:use-module (catbird mixins) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (chickadee audio) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics particles) + #:use-module (chickadee graphics path) + #:use-module (chickadee graphics texture) + #:use-module (chickadee math) + #: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 water) + #:export (<flower> + water + damage + growth-goal + growth-progress)) + +(define %max-water 1) + +(define-asset (flower-tileset (file (scope-datadir "assets/images/flower.png"))) + (load-tileset file 48 48)) + +;; Every growth-interval, the flower gains 1 growth point (accumulated +;; in growth-progress) and consumes 1 unit of water. If there is no +;; water, the flower is thirsty and stops growing. +(define-class <flower> (<actor>) + (water #:accessor water #:init-value 0) + (growth-goal #:accessor growth-goal #:init-keyword #:growth-goal) + (growth-progress #:accessor growth-progress #:init-value 1) + (growth-interval #:accessor growth-interval #:init-keyword #:growth-interval) + (growth-accumulator #:accessor growth-accumulator #:init-value 0.0) + (hitbox #:getter hitbox #:init-form (make-rect -8.0 -8.0 16.0 16.0))) + +(define-method (initialize (flower <flower>) initargs) + (next-method) + (attach-to flower + (make <animated-sprite> + #:name 'sprite + #:atlas flower-tileset + #:origin (vec2 24.0 24.0) + #:animations `((default . ,(make <animation> + #:frames #(0 1) + #:frame-duration 0.3)) + (stage-2 . ,(make <animation> + #:frames #(2 3 4 5) + #:frame-duration 0.3)) + (stage-3 . ,(make <animation> + #:frames #(6 7 8 9) + #:frame-duration 0.3)) + (stage-4 . ,(make <animation> + #:frames #(10 11 12 13) + #:frame-duration 0.3)))) + (make <canvas> + #:name 'progress-meter + #:position (vec2 -32.0 -28.0) + #:width 64.0 + #:height 8.0)) + (update-progress-meter flower)) + +(define-method (update-progress-meter (flower <flower>)) + (define w 64.0) + (define t (/ (growth-progress flower) (growth-goal flower))) + (set! (painter (& flower progress-meter)) + (superimpose + (with-style ((stroke-color (make-color 0.0 0.0 0.0 0.5)) + (stroke-width 2.0)) + (stroke + (line (vec2 0.0 0.0) (vec2 w 0.0)))) + (with-style ((stroke-color db32-tahiti-gold) + (stroke-width 2.0)) + (stroke + (line (vec2 0.0 0.0) (vec2 (* w t) 0.0)))))) + (resize (& flower progress-meter) + (default-width (& flower progress-meter)) + (default-height (& flower progress-meter)))) + + +(define-method (update-animation (flower <flower>)) + (define t (/ (growth-progress flower) (growth-goal flower))) + (change-animation (& flower sprite) + (cond + ((< t 1/3) 'default) + ((< t 2/3) 'stage-2) + ((< t 1) 'stage-3) + (else 'stage-4)))) + +(define-method (increment-water (flower <flower>) amount) + (set! (water flower) (min (+ (water flower) amount) %max-water))) + +(define-method (decrement-water (flower <flower>) amount) + (set! (water flower) (max (- (water flower) amount) 0))) + +(define-method (damage (flower <flower>) amount) + (set! (growth-progress flower) (max (- (growth-progress flower) amount) 0)) + (update-animation flower) + (update-progress-meter flower)) + +(define-method (thirsty? (flower <flower>)) + (= (water flower) 0)) + +(define-method (reset-growth-accumulator (flower <flower>)) + (set! (growth-accumulator flower) 0)) + +(define-method (on-splash (flower <flower>)) + (when (thirsty? flower) + (increment-water flower 1) + (audio-play (artifact watered-sound)))) + +(define-method (update (flower <flower>) dt) + (unless (thirsty? flower) + (let ((interval (growth-interval flower)) + (accum (+ (growth-accumulator flower) dt))) + (set! (growth-accumulator flower) accum) + (when (>= accum interval) + (set! (growth-progress flower) + (min (+ (growth-progress flower) 1) + (growth-goal flower))) + (set! (growth-accumulator flower) + (if (thirsty? flower) 0 (- accum interval))) + (decrement-water flower 1) + (update-animation flower) + (update-progress-meter flower)))) + (next-method) + (when (= (growth-progress flower) 0) + (detach flower))) 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>)))) diff --git a/super-bloom/main.scm b/super-bloom/main.scm index 2f49e9a..390003b 100644 --- a/super-bloom/main.scm +++ b/super-bloom/main.scm @@ -14,37 +14,78 @@ (define-module (super-bloom main) #:use-module (catbird) - #:use-module (catbird asset) #:use-module (catbird camera) #:use-module (catbird kernel) - #:use-module (catbird node) - #:use-module (catbird node-2d) + #:use-module (catbird mixins) #:use-module (catbird region) #:use-module (catbird scene) #:use-module (chickadee) - #:use-module (chickadee math vector) - #:use-module (chickadee graphics sprite) - #:use-module (chickadee graphics texture) + #:use-module (chickadee graphics color) + #:use-module (chickadee math rect) #:use-module (oop goops) + #:use-module (super-bloom common) + #:use-module (super-bloom game) #:export (launch-game)) -(define %default-width 1366) -(define %default-height 768) +(define-class <upscaled-centered-region> (<region>) + (area #:getter area #:init-form (make-rect 0.0 0.0 1.0 1.0)) + (unscaled-width #:getter unscaled-width #:init-keyword #:unscaled-width) + (unscaled-height #:getter unscaled-height #:init-keyword #:unscaled-height)) -(define-asset (chickadee-texture (file "assets/images/chickadee.png")) - (load-image file)) +(define-method (initialize (region <upscaled-centered-region>) initargs) + (next-method) + (refresh-area region + (window-width (current-window)) + (window-height (current-window)))) + +(define-method (on-window-resize (region <upscaled-centered-region>) width height) + (refresh-area region width height)) + +(define-method (refresh-camera (region <upscaled-centered-region>)) + (let ((c (camera region))) + (when c (resize c (unscaled-width region) (unscaled-height region))))) + +(define-method (refresh-area (region <upscaled-centered-region>) width height) + (let* ((w (unscaled-width region)) + (h (unscaled-height region)) + (scale (max (min (truncate-quotient width w) + (truncate-quotient height h)) + 1)) + (new-w (* w scale)) + (new-h (* h scale))) + (move region + (truncate-quotient (- width new-w) 2) + (truncate-quotient (- height new-h) 2)) + (resize region new-w new-h))) + +(define* (create-upscaled-centered-region width height #:key (rank 0) (name #f)) + (let ((region (make <upscaled-centered-region> + #:name name + #:rank rank + #:unscaled-width width + #:unscaled-height height))) + (add-region (current-kernel) region) + region)) + +(define-class <game-scene> (<scene>)) + +(define-method (width (scene <game-scene>)) + %game-width:float) + +(define-method (height (scene <game-scene>)) + %game-height:float) (define (init) - (let ((region (create-full-region #:name 'main)) - (scene (make <scene> #:name 'super-bloom))) + (let ((region (create-upscaled-centered-region %game-width %game-height #:name 'main)) + (scene (make <game-scene> #:name 'super-bloom)) + (camera (make <camera-2d> #:width %game-width #:height %game-height))) (replace-scene region scene) - (set-camera region (make <camera-2d>)) - (attach-to scene (make <sprite> - #:name 'chickadee - #:texture chickadee-texture)) - (center-in-parent (& scene chickadee)))) + (set-camera region camera) + (replace-major-mode scene (make <super-bloom-mode>)))) (define (launch-game) (run-catbird init + #:title "SUPER BLOOM (Spring Lisp Game Jam 2023)" + #:clear-color black #:width %default-width #:height %default-height)) diff --git a/super-bloom/player.scm b/super-bloom/player.scm new file mode 100644 index 0000000..4e00c1d --- /dev/null +++ b/super-bloom/player.scm @@ -0,0 +1,170 @@ +;;; 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 player) + #:use-module (catbird asset) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (chickadee audio) + #:use-module (chickadee data quadtree) + #:use-module (chickadee graphics particles) + #:use-module (chickadee graphics texture) + #:use-module (chickadee math) + #: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 water) + #:export (%max-water + <player> + move-left? + move-right? + move-down? + move-up? + shoot? + invincible? + speed + stop-moving + spray-water)) + +(define %max-water 1) + +(define-asset (player-tileset (file (scope-datadir "assets/images/player.png"))) + (load-tileset file 32 32)) + +(define-class <player> (<actor>) + (move-left? #:accessor move-left? #:init-value #f #:watch? #t) + (move-right? #:accessor move-right? #:init-value #f #:watch? #t) + (move-down? #:accessor move-down? #:init-value #f) + (move-up? #:accessor move-up? #:init-value #f) + (shoot? #:accessor shoot? #:init-value #f #:watch? #t) + (last-shot #:accessor last-shot #:init-value 0) + (speed #:accessor speed #:init-value 3.0) + (lives #:accessor lives #:init-value 3) + (invincible? #:accessor invincible? #:init-value #f) + (water #:accessor water #:init-value 0) + (water-particles #:accessor water-particles #:init-keyword #:water-particles) + (trail-particles #:accessor trail-particles #:init-keyword #:trail-particles) + (hitbox #:getter hitbox #:init-form (make-rect -8.0 -8.0 16.0 16.0))) + +(define-method (initialize (player <player>) initargs) + (next-method) + (attach-to player + (make <animated-sprite> + #:name 'sprite + #:atlas player-tileset + #:origin (vec2 16.0 16.0) + #:animations `((default . ,(make <animation> + #:frames #(0 1 2 3) + #:frame-duration 0.1)) + (full . ,(make <animation> + #:frames #(4 5 6 7) + #:frame-duration 0.1))))) + (add-particle-emitter (particles (trail-particles player)) + (make-particle-emitter (world-hitbox player) 2))) + +(define-method (update-animation (player <player>)) + (change-animation (& player sprite) + (if (= (water player) 0) + 'default + 'full))) + +(define-method (stop-moving (player <player>)) + (set! (move-left? player) #f) + (set! (move-right? player) #f) + (set! (move-up? player) #f) + (set! (move-down? player) #f)) + +(define-method (after-move (player <player>)) + (let ((p (position player))) + (cond + ((< (vec2-x p) 0.0) + (set-vec2-x! p 0.0)) + ((> (vec2-x p) %game-width:float) + (set-vec2-x! p %game-width:float))) + (cond + ((< (vec2-y p) 0.0) + (set-vec2-y! p 0.0)) + ((> (vec2-y p) %game-height:float) + (set-vec2-y! p %game-height:float))))) + +(define-method (update (player <player>) dt) + (let ((v (velocity player))) + (set-vec2! v + (+ (if (move-left? player) -1.0 0.0) + (if (move-right? player) 1.0 0.0)) + (+ (if (move-down? player) -1.0 0.0) + (if (move-up? player) 1.0 0.0))) + (vec2-normalize! v) + (vec2-mult! v (speed player))) + (next-method)) + +(define-method (increment-water (player <player>) amount) + (set! (water player) (min (+ (water player) amount) %max-water)) + (update-animation player)) + +(define-method (decrement-water (player <player>) amount) + (set! (water player) (max (- (water player) amount) 0)) + (update-animation player)) + +(define-method (saturated? (player <player>)) + (= (water player) %max-water)) + +(define-method (dry? (player <player>)) + (= (water player) 0)) + +(define-method (on-collide (player <player>) (droplet <water>)) + (unless (or (invincible? player) (saturated? player)) + (increment-water player 1) + (absorb! droplet) + (audio-play (artifact absorb-sound)))) + +(define-method (on-collide (player <player>) (dirt-ball <dirt-ball>)) + (hit player)) + +(define-method (on-collide (dirt-ball <dirt-ball>) (player <player>)) + (on-collide player dirt-ball)) + +(define-method (spray-water (player <player>)) + (unless (dry? player) + (decrement-water player 1) + (let ((p (position player)) + (r (rect-inflate (world-hitbox player) 64.0 64.0))) + (add-particle-emitter (particles (water-particles player)) + (make-particle-emitter (make-rect (vec2-x p) (vec2-y p) 0.0 0.0) + 200 2)) + (quadtree-for-each + (quadtree player) r + (lambda (other) + (when (and (not (eq? other player)) + (rect-intersects? r (world-hitbox other))) + (on-splash other)))) + (audio-play (artifact spray-sound))))) + +(define-method (hit (player <player>)) + (unless (invincible? player) + ;;(set! (lives player) (max (- (lives player) 1) 0)) + (set! (water player) 0) + (set! (invincible? player) #t) + (audio-play (artifact explosion-sound)) + (update-animation player) + ;; (add-particle-emitter (particles (particles (parent player))) + ;; (make-particle-emitter (world-hitbox player) + ;; 10 5)) + (run-script player + (blink player 10 (steps 5)) + (set! (invincible? player) #f)))) diff --git a/super-bloom/water.scm b/super-bloom/water.scm new file mode 100644 index 0000000..d2533fd --- /dev/null +++ b/super-bloom/water.scm @@ -0,0 +1,60 @@ +;;; 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 water) + #:use-module (catbird asset) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (chickadee audio) + #:use-module (chickadee graphics particles) + #:use-module (chickadee graphics texture) + #:use-module (chickadee math) + #: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) + #:export (<water> + absorbed? + absorb! + on-splash)) + +(define-asset (water-tileset (file (scope-datadir "assets/images/water.png"))) + (load-tileset file 32 32)) + +(define-class <water> (<actor>) + (hitbox #:getter hitbox #:init-form (make-rect -16.0 -16.0 32.0 32.0)) + (absorbed? #:accessor absorbed? #:init-value #f)) + +(define-method (initialize (water <water>) initargs) + (next-method) + (attach-to water + (make <animated-sprite> + #:name 'sprite + #:atlas water-tileset + #:origin (vec2 16.0 16.0) + #:animations `((default . ,(make <animation> + #:frames #(0 1) + #:frame-duration 0.3)))))) + +(define-method (absorb! (water <water>)) + (set! (absorbed? water) #t)) + +(define-method (update (water <water>) _dt) + (when (absorbed? water) (detach water)) + (next-method)) + +(define-method (on-splash (actor <actor>)) + #t) |