Enemies that can take damage from player bullets.

1 files changed, 182 insertions, 72 deletions

diff --git a/game.scm b/game.scm
index d84cdfa..131cb65 100644
--- a/game.scm
+++ b/game.scm
@@ -200,9 +200,13 @@
          (>= y ry)
          (<= x (+ rx rw))
          (<= y (+ ry rh))))
-    (define (vec2-within-rect? v r)
-    (within? (vec2-x v) (vec2-y v)
-             (rect-x r) (rect-y r) (rect-w r) (rect-h r)))
+  (define (rect-within? ax ay aw ah bx by bw bh)
+    (let ((ax* (+ ax aw))
+          (ay* (+ ay ah)))
+      (or (within? ax ay bx by bw bh)
+          (within? ax* ay bx by bw bh)
+          (within? ax* ay* bx by bw bh)
+          (within? ax ay* bx by bw bh))))
 
   (define demichrome0 "#211e20")
   (define demichrome1 "#555568")
@@ -219,80 +223,65 @@
   (define image:player (get-element-by-id "image-player"))
   (define image:player-bullet (get-element-by-id "image-player-bullet"))
   (define image:map (get-element-by-id "image-map"))
+  (define image:enemies (get-element-by-id "image-enemies"))
 
-  ;; header: length, capacity
-  (define %bullet-pool-header-size (+ 4 4))
   ;; per bullet: type, x, y, dx, dy
-  (define %bullet-pool-bullet-size (+ 4 8 8 8 8))
+  (define %bullet-size (+ 4 8 8 8 8))
   (define (make-bullet-pool capacity)
-    (let ((pool (make-bytevector (+ %bullet-pool-header-size
-                                    (* capacity %bullet-pool-bullet-size)))))
-      (bytevector-s32-native-set! pool 4 capacity)
-      pool))
-  (define (bullet-pool-length pool)
-    (bytevector-s32-native-ref pool 0))
-  (define (set-bullet-pool-length! pool length)
-    (bytevector-s32-native-set! pool 0 length))
-  (define (bullet-pool-capacity pool)
-    (bytevector-s32-native-ref pool 4))
+    (let ((pool (make-bytevector (* capacity %bullet-size))))
+      (vector 0 capacity pool)))
   (define (bullet-pool-offset i)
-    (+ %bullet-pool-header-size (* i %bullet-pool-bullet-size)))
+    (* i %bullet-size))
   (define (bullet-pool-add! pool type x y dx dy)
-    (let* ((k (bullet-pool-length pool))
-           (offset (bullet-pool-offset k)))
-      (bytevector-s32-native-set! pool offset type)
-      (bytevector-ieee-double-native-set! pool (+ offset 4) x)
-      (bytevector-ieee-double-native-set! pool (+ offset 12) y)
-      (bytevector-ieee-double-native-set! pool (+ offset 20) dx)
-      (bytevector-ieee-double-native-set! pool (+ offset 28) dy)
-      (set-bullet-pool-length! pool (+ k 1))))
+    (match pool
+      (#(length capacity bullets)
+       (let ((offset (bullet-pool-offset length)))
+         (bytevector-s32-native-set! bullets offset type)
+         (bytevector-ieee-double-native-set! bullets (+ offset 4) x)
+         (bytevector-ieee-double-native-set! bullets (+ offset 12) y)
+         (bytevector-ieee-double-native-set! bullets (+ offset 20) dx)
+         (bytevector-ieee-double-native-set! bullets (+ offset 28) dy)
+         (vector-set! pool 0 (+ length 1))))))
   (define (bullet-pool-remove! pool i)
-    (let ((k (bullet-pool-length pool)))
-      (when (and (>= i 0) (< i k))
-        (let ((at (bullet-pool-offset i))
-              (start (bullet-pool-offset (- k 1))))
-          (bytevector-copy! pool at pool start
-                            (+ start %bullet-pool-bullet-size))
-          (set-bullet-pool-length! pool (- k 1))))))
-  (define (bullet-pool-ref pool i)
-    (let ((offset (bullet-pool-offset i)))
-      (values
-       (bytevector-s32-native-ref pool offset)
-       (bytevector-ieee-double-native-ref pool (+ offset 4))
-       (bytevector-ieee-double-native-ref pool (+ offset 12))
-       (bytevector-ieee-double-native-ref pool (+ offset 20))
-       (bytevector-ieee-double-native-ref pool (+ offset 28)))))
-  (define (bullet-pool-update! pool)
-    (let ((padding 16.0))
-      (let loop ((i 0) (k (bullet-pool-length player-bullets)))
-        (let* ((offset (bullet-pool-offset i))
-               (x (bytevector-ieee-double-native-ref pool (+ offset 4)))
-               (y (bytevector-ieee-double-native-ref pool (+ offset 12)))
-               (dx (bytevector-ieee-double-native-ref pool (+ offset 20)))
-               (dy (bytevector-ieee-double-native-ref pool (+ offset 28)))
-               (x* (+ x dx))
-               (y* (+ y dy)))
-          (cond
-           ((= i k) #t)
-           ((or (not (within? x* y* (- padding) (- padding)
-                              (+ game-width padding) (+ game-height padding)))
-                (point-collides-with-level? level x* y*))
-            (bullet-pool-remove! pool i)
-            (loop i (- k 1)))
-           (else
-            (bytevector-ieee-double-native-set! pool (+ offset 4) x*)
-            (bytevector-ieee-double-native-set! pool (+ offset 12) y*)
-            (loop (+ i 1) k)))))))
+    (match pool
+      (#(length capacity bullets)
+       (when (and (>= i 0) (< i length))
+         (let ((at (bullet-pool-offset i))
+               (start (bullet-pool-offset (- length 1))))
+           (bytevector-copy! bullets at bullets start (+ start %bullet-size))
+           (vector-set! pool 0 (- length 1)))))))
+  (define (bullet-pool-update! pool collide)
+    (match pool
+      (#(length capacity bullets)
+       (let loop ((i 0) (k length))
+         (when (< i k)
+           (let* ((offset (bullet-pool-offset i))
+                  (x (bytevector-ieee-double-native-ref bullets (+ offset 4)))
+                  (y (bytevector-ieee-double-native-ref bullets (+ offset 12)))
+                  (dx (bytevector-ieee-double-native-ref bullets (+ offset 20)))
+                  (dy (bytevector-ieee-double-native-ref bullets (+ offset 28)))
+                  (x* (+ x dx))
+                  (y* (+ y dy)))
+             (cond
+              ;; TODO: different bullet hitbox sizes.
+              ((collide x y 2.0 2.0)
+               (bullet-pool-remove! pool i)
+               (loop i (- k 1)))
+              (else
+               (bytevector-ieee-double-native-set! bullets (+ offset 4) x*)
+               (bytevector-ieee-double-native-set! bullets (+ offset 12) y*)
+               (loop (+ i 1) k)))))))))
   (define (draw-bullets pool image w h)
-    (let ((k (bullet-pool-length player-bullets)))
-      (do ((i 0 (+ i 1)))
-          ((= i k))
-        (let* ((offset (bullet-pool-offset i))
-               (type (bytevector-s32-native-ref pool offset))
-               (x (bytevector-ieee-double-native-ref pool (+ offset 4)))
-               (y (bytevector-ieee-double-native-ref pool (+ offset 12))))
-          (draw-image context image (* type w) (* type h) w h
-                      (- x (/ w 2.0)) (- y (/ w 2.0)) w h)))))
+    (match pool
+      (#(length capacity bullets)
+       (do ((i 0 (+ i 1)))
+           ((= i length))
+         (let* ((offset (bullet-pool-offset i))
+                (type (bytevector-s32-native-ref bullets offset))
+                (x (bytevector-ieee-double-native-ref bullets (+ offset 4)))
+                (y (bytevector-ieee-double-native-ref bullets (+ offset 12))))
+           (draw-image context image (* type w) (* type h) w h
+                       (- x (/ w 2.0)) (- y (/ w 2.0)) w h))))))
 
   (define player-bullets (make-bullet-pool 100))
   (define enemy-bullets (make-bullet-pool 200))
@@ -400,6 +389,102 @@
                            (* t tw) 0.0 tw th
                            tx ty tw th))))))))
 
+  ;; Enemies:
+  ;; length, capacity, pool
+  ;; enemy: type, health, x, y, w, h, dx, dy
+  (define %enemy-size (+ 4 4 8 8 8 8 8 8))
+  (define (make-enemy-pool capacity)
+    (let ((enemies (make-bytevector (* capacity %enemy-size))))
+      (vector 0 capacity enemies)))
+  (define (enemy-pool-offset i)
+    (* i %enemy-size))
+  (define (enemy-pool-add! pool type hp x y w h dx dy)
+    (match pool
+      (#(length capacity enemies)
+       (unless (= length capacity)
+         (let ((offset (enemy-pool-offset length)))
+           (bytevector-s32-native-set! enemies offset type)
+           (bytevector-s32-native-set! enemies (+ offset 4) hp)
+           (bytevector-ieee-double-native-set! enemies (+ offset 8) x)
+           (bytevector-ieee-double-native-set! enemies (+ offset 16) y)
+           (bytevector-ieee-double-native-set! enemies (+ offset 24) w)
+           (bytevector-ieee-double-native-set! enemies (+ offset 32) h)
+           (bytevector-ieee-double-native-set! enemies (+ offset 40) dx)
+           (bytevector-ieee-double-native-set! enemies (+ offset 48) dy)
+           (vector-set! pool 0 (+ length 1)))))))
+  (define (enemy-pool-remove! pool i)
+    (match pool
+      (#(length capacity enemies)
+       (when (and (>= i 0) (< i length))
+         (let ((at (enemy-pool-offset i))
+               (start (enemy-pool-offset (- length 1))))
+           (bytevector-copy! enemies at enemies start (+ start %enemy-size))
+           (vector-set! pool 0 (- length 1)))))))
+  (define (enemy-pool-update! pool collide)
+    (match pool
+      (#(length capacity enemies)
+       (let ((padding 16.0))
+         (let loop ((i 0) (k length))
+           (unless (= i k)
+             (let* ((offset (enemy-pool-offset i))
+                    (hp (bytevector-s32-native-ref enemies (+ offset 4)))
+                    (x (bytevector-ieee-double-native-ref enemies (+ offset 8)))
+                    (y (bytevector-ieee-double-native-ref enemies (+ offset 16)))
+                    (w (bytevector-ieee-double-native-ref enemies (+ offset 24)))
+                    (h (bytevector-ieee-double-native-ref enemies (+ offset 32)))
+                    (dx (bytevector-ieee-double-native-ref enemies (+ offset 40)))
+                    (dy (bytevector-ieee-double-native-ref enemies (+ offset 48)))
+                    (x* (+ x dx))
+                    (y* (+ y dy)))
+               (let ((new-hp (collide x y w h hp)))
+                 (cond
+                  ((or (<= hp 0)
+                       (out-of-bounds? x* y* w h))
+                   (enemy-pool-remove! pool i)
+                   (loop i (- k 1)))
+                  (else
+                   (bytevector-s32-native-set! enemies (+ offset 4) new-hp)
+                   (bytevector-ieee-double-native-set! enemies (+ offset 8) x*)
+                   (bytevector-ieee-double-native-set! enemies (+ offset 16) y*)
+                   (loop (+ i 1) k)))))))))))
+  (define (draw-enemies pool)
+    (match pool
+      (#(length capacity enemies)
+       (do ((i 0 (+ i 1)))
+           ((= i length))
+         (let* ((offset (enemy-pool-offset i))
+                (t (bytevector-s32-native-ref enemies offset))
+                (x (bytevector-ieee-double-native-ref enemies (+ offset 8)))
+                (y (bytevector-ieee-double-native-ref enemies (+ offset 16)))
+                (w 64.0)
+                (h 64.0))
+           (draw-image context image:enemies (* t w) (* t h) w h
+                       (- x (/ w 2.0)) (- y (/ h 2.0)) w h))))))
+  (define (find-enemy pool x y w h)
+    (match pool
+      (#(length capacity enemies)
+       (let loop ((i 0))
+         (and (< i length)
+              (let* ((offset (enemy-pool-offset i))
+                     (x* (bytevector-ieee-double-native-ref enemies (+ offset 8)))
+                     (y* (bytevector-ieee-double-native-ref enemies (+ offset 16)))
+                     (w* (bytevector-ieee-double-native-ref enemies (+ offset 24)))
+                     (h* (bytevector-ieee-double-native-ref enemies (+ offset 32))))
+                (if (rect-within? x y w h x* y* w* h*)
+                    i
+                    (loop (+ i 1)))))))))
+  (define (damage-enemy! pool i damage)
+    (match pool
+      (#(length capacity enemies)
+       (when (and (>= i 0) (< i length))
+         (let* ((offset (enemy-pool-offset i))
+                (hp (bytevector-s32-native-ref enemies (+ offset 4))))
+           (bytevector-s32-native-set! enemies (+ offset 4)
+                                               (- hp damage)))))))
+
+  (define enemies (make-enemy-pool 64))
+  (enemy-pool-add! enemies 0 20 70.0 100.0 16.0 16.0 0.0 0.0)
+
   ;; Player state:
   (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0)))
   (define player-velocity (vec2 0.0 0.0))
@@ -412,7 +497,6 @@
   ;; left, right, down, up, fire
   (define key-state (vector #f #f #f #f #f))
   (define (update-player-velocity!)
-    ;; TODO: Normalize
     (match key-state
       (#(left? right? down? up? _)
        (set-vec2-x! player-velocity
@@ -449,6 +533,10 @@
   (define (draw-player-bullets)
     (draw-bullets player-bullets image:player-bullet 8.0 8.0))
 
+  (define (draw-enemy-bullets)
+    ;;(draw-bullets enemy-bullets image:enemy-bullets 8.0 8.0)
+    #t)
+
   (define (draw-player)
     (draw-image context image:player
                 0.0 0.0 player-width player-height
@@ -466,7 +554,9 @@
     (fill-rect context 0.0 0.0 game-width game-height)
     (draw-tiles level)
     (draw-player-bullets)
+    (draw-enemies enemies)
     (draw-player)
+    (draw-enemy-bullets)
     (request-animation-frame draw))
 
   (define (on-key-down event)
@@ -497,11 +587,31 @@
        ((string-=? code "KeyZ")
         (set-firing! #f)))))
 
+  (define (out-of-bounds? x y w h)
+    (let ((padding 16.0))
+      (not (rect-within? x y w h (- padding) (- padding)
+                         (+ game-width padding) (+ game-height padding)))))
+
+  (define (player-bullet-collide x y w h)
+    (let ((x* (- x (/ w 2.0)))
+          (y* (- y(/ h 2.0))))
+      (or (out-of-bounds? x* y* w h)
+          (rect-collides-with-level? level x* y* w h)
+          (let ((enemy-id (find-enemy enemies x y w h)))
+            (and enemy-id
+                 (begin
+                   (damage-enemy! enemies enemy-id 1)
+                   #t))))))
+
+  (define (enemy-collide x y w h hp)
+    hp)
+
   (define dt (/ 1000.0 60.0))
   (define (update)
     (vec2-add! player-position player-velocity)
     (vec2-clamp! player-position 0.0 0.0 game-width game-height)
-    (bullet-pool-update! player-bullets)
+    (bullet-pool-update! player-bullets player-bullet-collide)
+    (enemy-pool-update! enemies enemy-collide)
     (when (firing?)
       (set! *player-fire-counter*
             (modulo (+ *player-fire-counter* 1) player-fire-interval))