diff options
Diffstat (limited to 'super-bloom/player.scm')
| -rw-r--r-- | super-bloom/player.scm | 170 |
1 files changed, 170 insertions, 0 deletions
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)))) |