;;; Lisparuga
;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
;;;
;;; Lisparuga is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published
;;; by the Free Software Foundation, either version 3 of the License,
;;; or (at your option) any later version.
;;;
;;; Lisparuga is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Player actor.
;;
;;; Code:

(define-module (lisparuga player)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (chickadee scripting)
  #:use-module (chickadee render texture)
  #:use-module (lisparuga actor)
  #:use-module (lisparuga asset)
  #:use-module (lisparuga bullets)
  #:use-module (lisparuga config)
  #:use-module (lisparuga node)
  #:use-module (lisparuga node-2d)
  #:use-module (oop goops)
  #:export (<player>
            make-player
            score
            lives
            energy
            chain
            chain-progress
            speed
            steer
            start-shooting
            stop-shooting
            toggle-polarity
            fire-homing-missiles))

(define-asset ship (load-image (scope-asset "images/player.png")))
(define-asset ship-atlas (load-tile-atlas (scope-asset "images/player.png") 24 24))

(define kill-hitbox (make-hitbox 'kill (make-rect 0.0 0.0 0.0 0.0)))
(define graze-hitbox (make-hitbox 'graze (make-rect 0.0 0.0 0.0 0.0)))

(define-class <player> (<actor>)
  (score #:accessor score #:init-value 0)
  (lives #:accessor lives #:init-value 2)
  (energy #:accessor energy #:init-value 0)
  (chain #:accessor chain #:init-value 0)
  (chain-progress #:accessor chain-progress #:init-form '())
  (speed #:accessor speed #:init-value 1.75)
  (invincible? #:accessor invincible? #:init-value #f)
  (shooting? #:accessor shooting? #:init-value #f)
  (shoot-time #:accessor shoot-time #:init-value 0))

(define (make-player bullet-field)
  (make <player>
    #:name 'player
    #:hitboxes (list graze-hitbox kill-hitbox)
    #:position (vec2 80.0 24.0)
    #:bullet-field bullet-field
    #:polarity 'white))

(define-method (on-boot (player <player>))
  (attach-to player
             (make <atlas-sprite>
               #:name 'ship
               #:atlas ship-atlas
               #:index 0
               #:origin (vec2 12.0 12.0))))

(define (shoot player ox)
  (let ((speed 8.0)
        (pos (position player))
        (bullets (bullet-field player))
        (y-offset 6.0))
    (spawn-bullet bullets ikaruga-bullet (polarity player)
                  (+ (vec2-x pos) ox) (+ (vec2-y pos) y-offset)
                  0.0 speed)))

(define-method (update (player <player>) dt)
  ;; Adjust velocity to force player to stay within the bounds of the
  ;; screen.
  (let ((p (position player))
        (v (velocity player)))
    (cond
     ((< (+ (vec2-x p) (vec2-x v)) 0.0)
      (set-vec2-x! v (- (vec2-x p))))
     ((> (+ (vec2-x p) (vec2-x v)) 160.0)
      (set-vec2-x! v (- 160.0 (vec2-x p)))))
    (cond
     ((< (+ (vec2-y p) (vec2-y v)) 0.0)
      (set-vec2-y! v (- (vec2-y p))))
     ((> (+ (vec2-y p) (vec2-y v)) 240.0)
      (set-vec2-y! v (- 240.0 (vec2-y p))))))
  ;; Shooting logic
  (when (shooting? player)
    (let ((t (shoot-time player)))
      ;; Fire every n frames
      (when (and (zero? (modulo t 2))
                 ;; can't shoot while switching polarity.
                 (not (eq? (polarity player) 'none)))
        ;; The first shot is a single shot, everything after is double
        ;; fire.  This enables players to just tap the fire button to
        ;; fire off precision shots.
        (cond
         ;; single shot
         ((zero? t)
          (shoot player 0.0))
         ;; double shot. give a buffer of 4 frames so players can
         ;; reliably fire just a single shot.
         ((> t 4)
          (shoot player 5.0)
          (shoot player -5.0))))
      (set! (shoot-time player) (+ t 1))))
  (next-method))

(define-method (steer (player <player>) up? down? left? right?)
  (let ((v (velocity player)))
    (set-vec2! v (+ (if left? -1.0 0.0) (if right? 1.0 0.0))
               (+ (if up? 1.0 0.0) (if down? -1.0 0.0)))
    (vec2-normalize! v)
    (vec2-mult! v (speed player))))

(define-method (start-shooting (player <player>))
  (set! (shooting? player) #t)
  (set! (shoot-time player) 0))

(define-method (stop-shooting (player <player>))
  (set! (shooting? player) #f))

(define-method (toggle-polarity (player <player>))
  (let ((old (polarity player)))
    ;; If polarity is none it means we are already switching so ignore
    ;; the request.
    (unless (eq? old 'none)
      (run-script player
        ;; There's a brief moment when switching polarity where the
        ;; player is vulnerable to all bullets.
        (set! (polarity player) 'none)
        (sleep 7)
        (set! (polarity player) (if (eq? old 'white) 'black 'white))
        ;; Change sprite
        (set! (index (& player ship)) (if (eq? old 'white) 4 0))))))

(define-method (fire-homing-missiles (player <player>))
  (let* ((e (energy player))
         (n (quotient e 10)))
    (set! (energy player) (- e (* n 10)))
    ;; TODO: search for nearest enemy and fire missiles
    #t))

(define-method (increment-energy (player <player>))
  (set! (energy player) (min (+ (energy player) 1) 120)))

(define-method (kill-maybe (player <player>))
  (unless (invincible? player)
    (set! (lives player) (- (lives player) 1))
    ;; Give player invincibility for a bit while they recover.
    (run-script player
      (set! (invincible? player) #t)
      ;; 3 seconds of blinking
      (blink 18 5)
      (set! (invincible? player) #f))))

(define-method (on-collision (player <player>) (other <actor>)
                             hitbox other-hitbox)
  (when (eq? hitbox kill-hitbox)
    (kill-maybe player)))

(define-method (on-collision (player <player>) bullet bullet-polarity hitbox)
  (cond
   ;; Absorb bullets of the same polarity.
   ((and (eq? hitbox graze-hitbox)
         (eq? bullet-polarity (polarity player)))
    (increment-energy player)
    #t)
   ;; If a bullet makes it to the kill hitbox, lose a life.
   ((eq? hitbox kill-hitbox)
    (kill-maybe player)
    #t)
   (else #f)))