From bef945517b78b2354960ade9ea1095e7770cfab6 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 30 Apr 2016 22:38:48 -0400
Subject: Add collision detection, score accumulation, and more!

---
 game.scm | 373 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 339 insertions(+), 34 deletions(-)

(limited to 'game.scm')

diff --git a/game.scm b/game.scm
index 1616398..c015b10 100644
--- a/game.scm
+++ b/game.scm
@@ -39,45 +39,79 @@
 (define player-bounds (rect-inflate bounds -6 -8))
 (define bullet-bounds (rect-inflate bounds 32 32))
 (define player-speed 1.1)
+(define player-attack 1)
 
 (define origin2 (vector2 0 0))
 
+
+;;;
+;;; Data types
+;;;
+
 (define-record-type* <bullet>
   %make-bullet make-bullet
   bullet?
   (type bullet-type 'generic)
+  (polarity bullet-polarity 'light)
   (live? bullet-live? #t)
   (position bullet-position origin2)
-  (direction bullet-direction 0))
+  (direction bullet-direction 0)
+  (hitbox bullet-hitbox (make-rect -1 -1 1 1)))
 
 (define-record-type* <player>
   %make-player make-player
   player?
+  (polarity player-polarity 'light)
   (position player-position (vector2 (/ (vx resolution) 2) 4))
   (direction player-direction (vector2 0 0))
   (shooting? player-shooting? #f)
-  (hitbox player-hitbox (make-rect -1 1 2 2))
-  (lives player-lives 3)
-  (score player-score 0))
+  (hitbox player-hitbox (make-rect -1 1 2 4))
+  (last-death-time player-last-death-time #f))
 
 (define-record-type* <enemy>
   %make-enemy make-enemy
   enemy?
   (position enemy-position origin2)
-  (type enemy-type 'generic)
+  (aim enemy-aim 0) ; angle for firing bullets
+  ;; TODO: We could leave out the '-light' part and use the polarity
+  ;; field to figure things out, but it's more work so forget it.
+  (type enemy-type 'popcorn-light)
+  (polarity enemy-polarity 'light)
   (hitbox enemy-hitbox (make-rect -3 -3 6 6))
+  (last-hit-time enemy-last-hit-time #f)
   (health enemy-health 0))
 
+(define-record-type* <stats>
+  %make-stats make-stats
+  stats?
+  (score stats-score 0)
+  (lives stats-lives 3)
+  (chain stats-chain 0)
+  (chain-type stats-chain-type #f)
+  (chain-progress stats-chain-progress 0))
+
+(define-record-type* <explosion>
+  %make-explosion make-explosion
+  explosion?
+  (type explosion-type 'regular)
+  (position explosion-position origin2)
+  (time explosion-time 0))
+
 (define-record-type* <world>
   %make-world make-world
   world?
+  (level world-level #f)
+  (stats world-stats (make-stats))
   (player world-player (make-actor (make-player) idle))
   (player-bullets world-player-bullets '())
   (enemies world-enemies '())
-  (enemy-bullets world-enemy-bullets '()))
+  (enemy-bullets world-enemy-bullets '())
+  (explosions world-explosions '()))
 
-(define (player-dead? player)
-  (zero? (player-lives player)))
+
+;;;
+;;; Enemies
+;;;
 
 (define (enemy-dead? enemy)
   (zero? (enemy-health enemy)))
@@ -85,6 +119,45 @@
 (define (enemy-alive? enemy)
   (> (enemy-health enemy) 0))
 
+(define (damage-enemy enemy bullet time)
+  (make-enemy #:inherit enemy
+              #:last-hit-time time
+              #:health (max 0
+                            (- (enemy-health enemy)
+                               (if (eq? (enemy-polarity enemy)
+                                        (bullet-polarity bullet))
+                                   player-attack
+                                   ;; Bullets of opposite polarity
+                                   ;; deal double damage.
+                                   (* player-attack 2))))))
+
+
+;;;
+;;; Player
+;;;
+
+(define (kill-player player time)
+  (make-player #:inherit player #:last-death-time time))
+
+(define player-invincible-time (* 4 60))
+
+(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)))
+
+
+;;;
+;;; Bullets
+;;;
+
 (define (kill-bullet bullet)
   (make-bullet #:inherit bullet #:live? #f))
 
@@ -128,6 +201,9 @@
 
 (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))
 
@@ -179,6 +255,163 @@
                 (simple-enemy-bullet position (- direction (/ pi 16)) speed))))
     (add-enemy-bullets world bullets)))
 
+(define (explosion-active? explosion current-time)
+  (> (- current-time (explosion-time explosion)) 120))
+
+
+;;;
+;;; Stats
+;;;
+
+(define (decrement-life stats)
+  (make-stats #:inherit stats
+              #:lives (max 0 (1- (stats-lives stats)))))
+
+(define max-chain-multiplier 10)
+
+(define (add-to-score stats enemy)
+  ;; TODO: Award different points for different types of enemies.
+  (make-stats #:inherit stats
+              #:score (+ (stats-score stats)
+                         1000          ; base kill points
+                         ;; Chain multiplier.
+                         (* 255
+                            (min (stats-chain stats)
+                                 max-chain-multiplier)))))
+
+
+;;;
+;;; Collision detection
+;;;
+
+(define (player-world-hitbox player)
+  (rect-move (player-hitbox player) (player-position player)))
+
+(define (enemy-world-hitbox enemy)
+  (rect-move (enemy-hitbox enemy) (enemy-position enemy)))
+
+(define (bullet-world-hitbox bullet)
+  (rect-move (bullet-hitbox bullet) (bullet-position bullet)))
+
+(define (enemy/player-collision? enemy player)
+  (rect-intersects? (enemy-world-hitbox enemy)
+                    (player-world-hitbox player)))
+
+(define (enemy/bullet-collision? enemy bullet)
+  (rect-intersects? (enemy-world-hitbox enemy)
+                    (bullet-world-hitbox bullet)))
+
+(define (player/bullet-collision? player bullet)
+  (rect-intersects? (player-world-hitbox player)
+                    (bullet-world-hitbox bullet)))
+
+(define (collide-enemies-and-bullets enemies player-bullets stats time)
+  (define (collide enemy bullets stats explosions)
+    (let loop ((bullets bullets)
+               (prev-bullets '())
+               (stats stats))
+      (match bullets
+        (()
+         (values enemy (reverse prev-bullets) stats explosions))
+        ((bullet . rest)
+         (if (enemy/bullet-collision? (actor-ref enemy) (actor-ref bullet))
+             (let ((new-enemy (call-with-actor enemy
+                                (lambda (enemy)
+                                  (damage-enemy enemy
+                                                (actor-ref bullet)
+                                                time)))))
+               (values new-enemy
+                       ;; Remove bullet.
+                       (append (reverse prev-bullets) rest)
+                       (if (enemy-alive? (actor-ref new-enemy))
+                           stats
+                           ;; Enemy killed, add to player score.
+                           (add-to-score stats (actor-ref new-enemy)))
+                       (if (enemy-alive? (actor-ref new-enemy))
+                           explosions
+                           ;; Add new explosion.
+                           (cons (make-explosion #:type 'regular
+                                                 #:position (enemy-position
+                                                             (actor-ref enemy))
+                                                 #:time time)
+                                 explosions))))
+             (loop rest (cons bullet prev-bullets) stats))))))
+
+  (let loop ((enemies enemies)
+             (new-enemies '())
+             (bullets player-bullets)
+             (explosions '())
+             (stats stats))
+    (match enemies
+      (()
+       (values (reverse new-enemies) bullets stats explosions))
+      ((enemy . rest)
+       (let-values (((new-enemy bullets stats explosions)
+                     (collide enemy bullets stats explosions)))
+         (loop rest
+               (if (enemy-alive? (actor-ref new-enemy))
+                   (cons new-enemy new-enemies)
+                   new-enemies)
+               bullets
+               explosions
+               stats))))))
+
+(define (collide-player-and-enemies player enemies stats time)
+  (let loop ((enemies enemies))
+    (match enemies
+      (()
+       (values player stats '()))
+      ((enemy . rest)
+       (if (enemy/player-collision? (actor-ref enemy) (actor-ref player))
+           (let* ((invincible? (player-invincible? (actor-ref player) time))
+                  (new-player (if invincible?
+                                  player
+                                  (call-with-actor player
+                                    (lambda (player)
+                                      (kill-player player time)))))
+                  (position (player-position (actor-ref player)))
+                  (explosion (make-explosion #:type 'player
+                                             #:position position
+                                             #:time time)))
+             (values new-player
+                     (if invincible?
+                         stats
+                         (decrement-life stats))
+                     (list explosion)))
+           (loop rest))))))
+
+(define (collide-player-and-bullets player enemy-bullets stats time)
+  (let loop ((bullets enemy-bullets)
+             (new-bullets '()))
+    (match bullets
+      (()
+       (values player (reverse new-bullets) stats '()))
+      ((bullet . rest)
+       (if (player/bullet-collision? (actor-ref player) (actor-ref bullet))
+           (let* ((invincible? (player-invincible? (actor-ref player) time))
+                  (matched-polarity? (eq? (player-polarity (actor-ref player))
+                                          (bullet-polarity (actor-ref bullet))))
+                  (hit? (not (or invincible? matched-polarity?)))
+                  (new-player (if hit?
+                                  (call-with-actor player
+                                    (lambda (player)
+                                      (kill-player player time)))
+                                  player))
+                  (position (player-position (actor-ref player)))
+                  (explosion (make-explosion #:type 'player
+                                             #:position position
+                                             #:time time)))
+             (values new-player
+                     (append (reverse new-bullets) rest)
+                     (if hit? (decrement-life stats) stats)
+                     (if hit? (list explosion) '())))
+           (loop rest (cons bullet new-bullets)))))))
+
+
+;;;
+;;; Game world simulation
+;;;
+
 (define (keep-bullet? bullet)
   (and (bullet-live? bullet)
        (bullet-in-bounds? bullet)))
@@ -204,7 +437,7 @@
 (define (update-player effects world)
   (update-actor world effects (world-player world)))
 
-(define (update-world world)
+(define (update-world world time)
   ;; TODO: collision detection
   (let*-values
       (((effects new-player) (update-player '() world))
@@ -212,18 +445,37 @@
        ((effects new-player-bullets)
         (update-bullets effects world (world-player-bullets world)))
        ((effects new-enemy-bullets)
-        (update-bullets effects world (world-enemy-bullets world))))
+        (update-bullets effects world (world-enemy-bullets world)))
+       ((stats) (world-stats world))
+       ((new-enemies new-player-bullets new-stats explosions1)
+        (collide-enemies-and-bullets new-enemies new-player-bullets
+                                     stats time))
+       ((new-player new-enemy-bullets new-stats explosions3)
+        (collide-player-and-bullets new-player new-enemy-bullets
+                                    new-stats time))
+       ((new-player new-stats explosions2)
+        (collide-player-and-enemies new-player new-enemies
+                                    new-stats time))
+       ((new-explosions)
+        (filter (lambda (explosion)
+                  (explosion-active? explosion time))
+                (append explosions1
+                        explosions2
+                        explosions3
+                        (world-explosions world)))))
     (apply-effects effects
                    (make-world #:player new-player
                                #:player-bullets new-player-bullets
                                #:enemies new-enemies
-                               #:enemy-bullets new-enemy-bullets))))
+                               #:enemy-bullets new-enemy-bullets
+                               #:stats new-stats
+                               #:explosions new-explosions))))
 
 (define (world-eval exp world)
   (match exp
     (('null) world)
     (('tick time)
-     (update-world world))
+     (update-world world time))
     (('player-direction direction)
      (make-world #:inherit world
                  #:player (call-with-actor (world-player world)
@@ -233,7 +485,14 @@
      (make-world #:inherit world
                  #:player (call-with-actor (world-player world)
                             (lambda (player)
-                              (set-player-shooting player shooting?)))))))
+                              (set-player-shooting player shooting?)))))
+    (('player-toggle-polarity)
+     (make-world #:inherit world
+                 #:player (call-with-actor (world-player world)
+                            toggle-polarity)))))
+
+(define (game-over? world)
+  (zero? (stats-lives (world-stats world))))
 
 (define player-shoot* (action-effect-lift player-shoot))
 (define move-enemy* (action-lift move-enemy))
@@ -281,7 +540,12 @@
                 (signal-let ((direction key-arrows))
                   `(player-direction ,direction))
                 (signal-let ((shoot? (signal-drop-repeats (key-down? 'z))))
-                  `(player-shoot ,shoot?)))))
+                  `(player-shoot ,shoot?))
+                (signal-let ((toggle?
+                              (signal-filter identity #f
+                                             (signal-drop-repeats
+                                              (key-down? 'x)))))
+                  `(player-toggle-polarity)))))
 
 (define (key-toggle key)
   "Create a signal that is initially #f and toggles between #t and #f
@@ -333,37 +597,46 @@ each time KEY is pressed."
     (if font
         (move (vector2 (vx resolution) 0)
               (render-sprite
-               (make-label font (format #f "~d fps" fps)
+               (make-label font
+                           (format #f "~d fps" fps)
                            #:blended? #f
                            #:anchor 'bottom-right)))
         render-nothing)))
 
 (define-signal score-text
-  (signal-let ((font font))
+  (signal-let ((font font)
+               (world world))
     (if font
         (move resolution
               (render-sprite
-               (make-label font "123456789"
+               (make-label font
+                           (number->string (stats-score (world-stats world)))
                            #:blended? #f
                            #:anchor 'top-right)))
         render-nothing)))
 
 (define-signal lives-text
-  (signal-let ((font font))
+  (signal-let ((font font)
+               (world world))
     (if font
-        (move origin2
+        (move (vector2 (/ (vx resolution) 2) (vy resolution))
               (render-sprite
-               (make-label font "3 ship"
+               (make-label font
+                           (format #f "~d ship"
+                                   (stats-lives (world-stats world)))
                            #:blended? #f
-                           #:anchor 'bottom-left)))
+                           #:anchor 'top-center)))
         render-nothing)))
 
 (define-signal chain-text
-  (signal-let ((font font))
+  (signal-let ((font font)
+               (world world))
     (if font
-        (move (vector2 0 (vy resolution))
+        (move (vector2 1 (vy resolution))
               (render-sprite
-               (make-label font "0 chain"
+               (make-label font
+                           (format #f "~d chain"
+                                   (stats-chain (world-stats world)))
                            #:blended? #f
                            #:anchor 'top-left)))
         render-nothing)))
@@ -389,8 +662,20 @@ each time KEY is pressed."
   (load-tileset/live "assets/images/enemies.png" 16 16))
 
 (define-signal player-sprite
-  (signal-map-maybe (lambda (tileset)
-                      (make-sprite (tileset-ref tileset 12)))
+  (signal-map-maybe (lambda (world tileset)
+                      (make-sprite
+                       (let* ((player (actor-ref (world-player world)))
+                              (dx (vx (player-direction player)))
+                              (offset (cond
+                                       ((zero? dx) 0)
+                                       ((positive? dx) 1)
+                                       ((negative? dx) 2))))
+                         (tileset-ref tileset
+                                      (+ (match (player-polarity player)
+                                           ('light 12)
+                                           ('dark 8))
+                                         offset)))))
+                    world
                     player-tileset))
 
 (define (make-scrolling-background background time speed)
@@ -434,22 +719,41 @@ each time KEY is pressed."
                          (tex (tileset-ref tileset
                                            (match (bullet-type bullet)
                                              ('generic 12)
-                                             ('enemy-basic 13)))))
+                                             ('enemy-basic 9)
+                                             ('player-light 12)
+                                             ('player-dark 13)
+                                             ('large-light 9)
+                                             ('dark-light 8)
+                                             ('small-light 11)
+                                             ('small-dark 10)))))
                     (sprite-batch-add! batch context tex rect)))
                 bullets))))
 
-(define (render-enemies enemies tileset batch)
+(define (render-enemies enemies tileset batch time)
   (lambda (context)
     (with-sprite-batch batch context
       (for-each (lambda (actor)
                   (let* ((enemy (actor-ref actor))
+                         (hit-time (enemy-last-hit-time enemy))
+                         (hit? (and hit-time (zero? (- time hit-time))))
                          (rect (rect-move enemy-rect (enemy-position enemy)))
                          (tex (tileset-ref tileset
-                                           (match (enemy-type enemy)
-                                             ('generic 12)))))
+                                           (+ (match (enemy-type enemy)
+                                                ('popcorn-dark 0)
+                                                ('popcorn-light 4)
+                                                ('pincer-dark 8)
+                                                ('pincer-light 12))
+                                              (if hit? 2 0)))))
                     (sprite-batch-add! batch context tex rect)))
                 enemies))))
 
+(define (render-player player sprite time)
+  (if (and (player-invincible? player time)
+           (odd? (round (/ time 3))))
+      render-nothing
+      (move (player-position player)
+            (render-sprite sprite))))
+
 (define-signal scene
   (signal-let ((fps-text fps-text)
                (score-text score-text)
@@ -463,7 +767,8 @@ each time KEY is pressed."
                (bullet-tileset bullet-tileset)
                (enemy-tileset enemy-tileset)
                (batch batch)
-               (world world))
+               (world world)
+               (time timer))
     (if (and framebuffer framebuffer-sprite batch bullet-tileset
              enemy-tileset player-sprite)
         (let ((player (actor-ref (world-player world))))
@@ -475,14 +780,14 @@ each time KEY is pressed."
                 (render-bullets (world-player-bullets world)
                                 bullet-tileset
                                 batch)
-                (move (player-position player)
-                      (render-sprite player-sprite))
+                (render-player player player-sprite time)
                 (render-bullets (world-enemy-bullets world)
                                 bullet-tileset
                                 batch)
                 (render-enemies (world-enemies world)
                                 enemy-tileset
-                                batch)
+                                batch
+                                time)
                 (with-color font-color
                   (render-begin
                    (if display-fps?
-- 
cgit v1.2.3