;;; 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))))