1 files changed, 192 insertions, 0 deletions
diff --git a/lisparuga/player.scm b/lisparuga/player.scm
new file mode 100644
index 0000000..a810e48
--- /dev/null
+++ b/lisparuga/player.scm
@@ -0,0 +1,192 @@
+;;; 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)))