path: root/lisparuga/player.scm

;;; 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 audio)
  #:use-module (chickadee math)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (chickadee scripting)
  #:use-module (chickadee render texture)
  #:use-module (ice-9 match)
  #:use-module (lisparuga actor)
  #:use-module (lisparuga asset)
  #:use-module (lisparuga bullets)
  #:use-module (lisparuga config)
  #:use-module (lisparuga enemy)
  #:use-module (lisparuga node)
  #:use-module (lisparuga node-2d)
  #:use-module (oop goops)
  #:export (<player>
            make-player
            score
            lives
            energy
            chain
            chain-progress
            max-chain
            speed
            invincible?
            shooting?
            bounds-check?
            steer
            start-shooting
            stop-shooting
            toggle-polarity
            fire-homing-missiles
            kill-maybe
            on-kill
            add-energy
            reset))

(define-asset ship-atlas (load-tile-atlas (scope-asset "images/player.png") 24 24))
(define-asset shoot-sound (load-audio (scope-asset "sounds/player-shoot.wav")))
(define-asset missile-sound (load-audio (scope-asset "sounds/player-missile.wav")))
(define-asset death-sound (load-audio (scope-asset "sounds/player-death.wav")))
(define-asset energy-max-sound (load-audio (scope-asset "sounds/energy-max.wav")))
(define-asset max-chain-sound (load-audio (scope-asset "sounds/max-chain.wav")))

(define kill-hitbox (make-hitbox 'kill (make-rect -2.0 -2.0 4.0 4.0)))
(define graze-hitbox (make-hitbox 'graze (make-rect -12.0 -12.0 24.0 24.0)))

(define-class <player> (<actor>)
  (score #:accessor score #:init-value 0)
  (lives #:accessor lives #:init-value 3)
  (energy #:accessor energy #:init-value 0)
  (chain #:accessor chain #:init-value 0)
  (chain-progress #:accessor chain-progress #:init-form '())
  (max-chain #:accessor max-chain #:init-value 0)
  (speed #:accessor speed #:init-value 2.5)
  (invincible? #:accessor invincible? #:init-value #f)
  (shooting? #:accessor shooting? #:init-value #f)
  (shoot-time #:accessor shoot-time #:init-value 0)
  (bounds-check? #:accessor bounds-check? #:init-value #t))

(define-method (reset (player <player>))
  (show player)
  (set! (polarity player) 'white)
  (set-vec2! (velocity player) 0.0 0.0)
  (set! (score player) 0)
  (set! (lives player) 3)
  (set! (energy player) 0)
  (set! (chain player) 0)
  (set! (chain-progress player) '())
  (set! (max-chain player) 0)
  (set! (invincible? player) #f)
  (set! (shooting? player) #f)
  (set! (shoot-time player) 0)
  (set! (bounds-check? player) #t)
  (refresh-sprite player))

(define-method (dead? (player <player>))
  (zero? (lives player)))

(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-method (shoot (player <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.
  (when (bounds-check? player)
    (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)
          (audio-play (asset-ref shoot-sound))
          (shoot player 0.0))
         ;; double shot. give a buffer of 4 frames so players can
         ;; reliably fire just a single shot.
         ((> t 4)
          (audio-play (asset-ref shoot-sound))
          (shoot player 6.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>))
  (unless (shooting? player)
    (set! (shooting? player) #t)
    (set! (shoot-time player) 0)))

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

(define-method (refresh-sprite (player <player>))
  (set! (index (& player ship)) (if (eq? (polarity player) 'white) 0 4)))

(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))
        (refresh-sprite player)))))

(define-method (fire-homing-missiles (player <player>) enemies)
  (let* ((e (energy player))
         (n (quotient e 10))
         (p (position player))
         (bullets (bullet-field player)))
    (define (distance-to-player enemy)
      ;; We don't need the true distance here so no need to use an
      ;; expensive sqrt call.
      (let ((ep (position enemy)))
        (+ (expt (- (vec2-x ep) (vec2-x p)) 2)
           (expt (- (vec2-y ep) (vec2-y p)) 2))))
    (define (find-closest-enemy enemies)
      (let loop ((enemies enemies)
                 (closest-enemy #f)
                 (distance 999999999.0))
        (match enemies
          ((enemy . rest)
           (if (dead? enemy)
               (loop rest closest-enemy distance)
               (let ((d (distance-to-player enemy)))
                 (if (< d distance)
                     (loop rest enemy d)
                     (loop rest closest-enemy distance)))))
          (()
           closest-enemy))))
    (define (fire-missiles n enemy)
      (let ((speed 10.0))
        (if enemy
            (let* ((ep (position enemy)))
              (define (aim-at-enemy bp bv)
                (unless (dead? enemy)
                  (let ((dir (atan (- (vec2-y ep) (vec2-y bp))
                                   (- (vec2-x ep) (vec2-x bp)))))
                    (set-vec2! bv (* (cos dir) speed) (* (sin dir) speed)))))
              (run-script player
                (let loop ((i 0))
                  (when (< i n)
                    (spawn-bullet bullets ikaruga-missile (polarity player)
                                  (vec2-x p) (vec2-y p) 0.0 0.0 aim-at-enemy)
                    (sleep 3)
                    (loop (+ i 1))))))
            (let loop ((i 0))
              (when (< i n)
                (let ((theta (+ (* (random:uniform) .5 pi)
                                (* .25 pi))))
                  (spawn-bullet bullets ikaruga-missile (polarity player)
                                (vec2-x p) (vec2-y p)
                                (* (cos theta) speed) (* (sin theta) speed))
                  (loop (+ i 1))))))))
    (when (> e 10)
      (audio-play (asset-ref missile-sound)
                  #:volume 0.5))
    ;; Distribute missiles amongst closest enemies
    (let loop ((enemies enemies)
               (missiles-remaining (quotient e 10))
               (missiles-used 0))
      (if (zero? missiles-remaining)
          (set! (energy player) (- e (* missiles-used 10)))
          (let ((closest-enemy (find-closest-enemy enemies)))
            (if closest-enemy
                ;; Either kill the enemy or use all missiles.
                (let ((missiles-to-fire (min (inexact->exact
                                              (ceiling
                                               (/ (health closest-enemy) 10.0)))
                                             missiles-remaining)))
                  (fire-missiles missiles-to-fire closest-enemy)
                  (loop (delq closest-enemy enemies)
                        (- missiles-remaining missiles-to-fire)
                        (+ missiles-used missiles-to-fire)))
                ;; No enemy available, fire missiles into the void
                (begin
                  (fire-missiles missiles-remaining #f)
                  (loop enemies 0 (+ missiles-used missiles-remaining)))))))
    #t))

(define-method (add-energy (player <player>) n)
  (let* ((old-energy (energy player))
         (new-energy (min (+ old-energy n) 120)))
    (set! (energy player) new-energy)
    (when (and (not (= old-energy new-energy))
               (= new-energy 120))
      (audio-play (asset-ref energy-max-sound)))))

(define-method (kill-maybe (player <player>))
  (unless (invincible? player)
    (audio-play (asset-ref death-sound))
    (let ((new-lives (max (- (lives player) 1) 0)))
      (set! (lives player) new-lives)
      (set! (energy player) 0)
      (set! (chain-progress player) '())
      (set! (chain player) 0)
      (if (zero? new-lives)
          (begin
            ;; to stop the death events from happening over and over
            ;; after game over condition is reached.
            (set! (invincible? player) #t)
            (set-vec2! (velocity player) 0.0 0.0)
            (hide player))
          ;; Give player invincibility for a bit while they recover.
          (run-script player
            (set! (invincible? player) #t)
            ;; 3 seconds of blinking
            (blink player 18 5)
            (set! (invincible? player) #f))))))

(define-method (on-collision (player <player>) (other <actor>)
                             hitbox other-hitbox)
  (if (eq? hitbox kill-hitbox)
      (begin
        (kill-maybe player)
        #t)
      #f))

(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)))
    (add-energy player 1)
    ;; From what I can tell by watching youtube replays at .25 speed,
    ;; each bullet absorbed is worth 100 points.
    (set! (score player) (+ (score player) 100))
    #t)
   ;; If a bullet makes it to the kill hitbox, lose a life.
   ((and (eq? hitbox kill-hitbox)
         (not (invincible? player)))
    (kill-maybe player)
    #t)
   (else #f)))

(define-method (add-to-chain (player <player>) polarity)
  (let ((current-chain (cons polarity (chain-progress player))))
    (match current-chain
      ;; complete chain.
      ((or ('white 'white 'white)
           ('black 'black 'black))
       (let ((new-chain (+ (chain player) 1)))
         (set! (max-chain player) (max (max-chain player) new-chain))
         (set! (chain player) new-chain)
         (set! (chain-progress player) '())
         (set! (score player)
           (+ (score player)
              ;; Chain formula yields these results:
              ;;
              ;; - 1 Chain --- 100 points
              ;; - 2 Chain --- 200 points
              ;; - 3 Chain --- 400 points
              ;; - 4 Chain --- 800 points
              ;; - 5 Chain --- 1,600 points
              ;; - 6 Chain --- 3,200 points
              ;; - 7 Chain --- 6,400 points
              ;; - 8 Chain --- 12,800 points
              ;; - 9+ Chain -- 25,600 points
              (* (expt 2 (- (min new-chain 9) 1)) 100)))
         (when (>= new-chain 9)
           (audio-play (asset-ref max-chain-sound)))))
      ;; 1st or 2nd kill of the chain.
      ((or ('white) ('black) ('white 'white) ('black 'black))
       (set! (chain-progress player) current-chain))
      ;; failed chain, start over.
      (_
       (set! (chain-progress player) '())
       (set! (chain player) 0)))))

(define-method (on-kill (player <player>) (enemy <enemy>))
  (set! (score player) (+ (score player) (points enemy)))
  (add-to-chain player (polarity enemy)))