;;; Lisparuga
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;;
;;; 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/>.

(define-module (lisparuga player)
  #:use-module (ice-9 match)
  #:use-module (sly actor)
  #:use-module (sly math)
  #:use-module (sly math rect)
  #:use-module (sly math vector)
  #:use-module (sly records)
  #:use-module (lisparuga bullets)
  #:use-module (lisparuga utils)
  #:export (%player-bounds
            %player-speed
            %player-attack
            %player-invincible-time
            make-player
            player?
            player-polarity
            player-position
            player-direction
            player-shooting?
            player-hitbox
            player-absorb-hitbox
            player-last-death-time
            kill-player
            player-invincible?
            toggle-polarity
            direct-player
            move-player
            set-player-shooting
            player-forward
            player-bullet-script
            make-player-bullet
            player-world-hitbox
            player-world-absorb-hitbox))

(define %player-bounds (rect-inflate bounds -6 -8))
(define %player-speed 1.1)
(define %player-attack 1)
(define %player-invincible-time (* 4 60))

(define-record-type* <player>
  %make-player make-player
  player?
  (polarity player-polarity 'light)
  (position player-position (vector2 (/ (vx resolution) 2) 8))
  (direction player-direction (vector2 0 0))
  (shooting? player-shooting? #f)
  (hitbox player-hitbox (make-rect -1 1 2 4))
  (absorb-hitbox player-absorb-hitbox (make-rect -9 -2 16 6))
  (last-death-time player-last-death-time #f))

(define (kill-player player time)
  (make-player #:inherit player #:last-death-time time))

(define (player-invincible? player time)
  (let ((last-death (player-last-death-time player)))
    (and last-death
         (negative?
          (- time (+ last-death %player-invincible-time))))))

(define (toggle-polarity player)
  (make-player #:inherit player
               #:polarity (if (eq? (player-polarity player) 'light)
                              'dark
                              'light)))

(define (direct-player player direction)
  (make-player #:inherit player #:direction direction))

(define (move-player player offset)
  (make-player #:inherit player
               #:position (rect-clamp %player-bounds
                                      (v+ (player-position player)
                                          offset))))

(define (set-player-shooting player shooting?)
  (make-player #:inherit player #:shooting? shooting?))

(define (player-forward speed)
  (lambda (world effects player)
    (values #f
            effects
            (move-player player (v* speed (player-direction player))))))

(define player-bullet-script
  (forever (forward 5)))

(define player-bullet-direction (/ pi 2))

(define (make-player-bullet player offset)
  (make-actor (make-bullet #:position (v+ (player-position player) offset)
                           #:type (match (player-polarity player)
                                    ('light 'player-light)
                                    ('dark 'player-dark))
                           #:direction player-bullet-direction)
              player-bullet-script))

(define (player-world-hitbox player)
  (rect-move (player-hitbox player) (player-position player)))

(define (player-world-absorb-hitbox player)
  (rect-move (player-absorb-hitbox player) (player-position player)))