summaryrefslogtreecommitdiff
path: root/super-bloom
diff options
context:
space:
mode:
Diffstat (limited to 'super-bloom')
-rw-r--r--super-bloom/actor.scm99
-rw-r--r--super-bloom/common.scm69
-rw-r--r--super-bloom/dirt-ball.scm81
-rw-r--r--super-bloom/flower.scm146
-rw-r--r--super-bloom/game.scm255
-rw-r--r--super-bloom/main.scm75
-rw-r--r--super-bloom/player.scm170
-rw-r--r--super-bloom/water.scm60
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)