From de833c9d524d2e47b3812612995290795d2e7b84 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Sat, 16 Oct 2021 16:22:08 -0400
Subject: Allow player to shoot and add flowers to harvest pollen from.

---
 bonnie-bee/bullet.scm | 109 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 66 insertions(+), 43 deletions(-)

(limited to 'bonnie-bee/bullet.scm')

diff --git a/bonnie-bee/bullet.scm b/bonnie-bee/bullet.scm
index ecf7b53..0fb351b 100644
--- a/bonnie-bee/bullet.scm
+++ b/bonnie-bee/bullet.scm
@@ -9,25 +9,36 @@
   #:use-module (chickadee math vector)
   #:use-module (chickadee utils)
   #:use-module (oop goops)
+  #:use-module (srfi srfi-9)
   #:use-module (starling asset)
   #:use-module (starling node)
   #:use-module (starling node-2d)
-  #:export (<bullet>
-            type
+  #:export (<bullet-type>
+            name
+            player-primary-bullet
             pollen-pickup
             <bullets>
+            <bullet>
+            type
+            kill-bullet
             add-bullet))
 
-(define-class <bullet> ()
-  (type #:getter type #:init-keyword #:type)
+(define-class <bullet-type> ()
+  (name #:getter name #:init-keyword #:name)
   (atlas-index #:getter atlas-index #:init-keyword #:atlas-index)
   (hitbox #:getter hitbox #:init-keyword #:hitbox))
 
 (define (bullet-texture bullet)
-  (texture-atlas-ref (asset-ref bullet-atlas) (atlas-index bullet)))
+  (texture-atlas-ref (asset-ref bullet-atlas)
+                     (atlas-index (type bullet))))
 
+(define player-primary-bullet
+  (make <bullet-type> #:name 'player-primary #:atlas-index 4
+        #:hitbox (make-rect -7.0 -7.0 14.0 14.0)))
+
+;; Yeah... pollen is a bullet.  Didn't you know that??
 (define pollen-pickup
-  (make <bullet> #:type 'pollen #:atlas-index 6
+  (make <bullet-type> #:name 'pollen #:atlas-index 6
         #:hitbox (make-rect -10.0 -10.0 20.0 20.0)))
 
 (define (make-bullet-sprite-batch)
@@ -35,16 +46,16 @@
    (texture-parent
     (texture-atlas-ref (asset-ref bullet-atlas) 0))))
 
-(define (make-vector* size thunk)
+(define (make-vector* size proc)
   (let ((v (make-vector size)))
     (for-range ((i size))
-      (vector-set! v i (thunk)))
+      (vector-set! v i (proc i)))
     v))
 
-(define (make-null-vec2)
+(define (make-null-vec2 i)
   (vec2 0.0 0.0))
 
-(define (make-null-rect)
+(define (make-null-rect i)
   (make-rect 0.0 0.0 0.0 0.0))
 
 (define %max-bullets 2048)
@@ -55,22 +66,48 @@
   (batch #:getter batch #:init-thunk make-bullet-sprite-batch)
   (capacity #:getter capacity #:init-value %max-bullets)
   (size #:accessor size #:init-value 0)
-  (descriptors #:getter descriptors #:init-form (make-vector %max-bullets #f))
-  (velocities #:getter velocities
-              #:init-form (make-vector* %max-bullets make-null-vec2))
-  (hitboxes #:getter hitboxes
-            #:init-form (make-vector* %max-bullets make-null-rect))
-  (regions #:getter regions
-           #:init-form (make-vector* %max-bullets make-null-rect)))
-
-(define-method (add-bullet (bullets <bullets>) bullet position velocity)
+  (descriptors #:accessor descriptors)
+  (velocities #:accessor velocities)
+  (hitboxes #:accessor hitboxes)
+  (regions #:accessor regions))
+
+(define-method (initialize (bullets <bullets>) args)
+  (define (make-descriptor i)
+    (make <bullet> #:parent bullets #:index i))
+  (next-method)
+  (set! (descriptors bullets) (make-vector* %max-bullets make-descriptor))
+  (set! (velocities bullets) (make-vector* %max-bullets make-null-vec2))
+  (set! (hitboxes bullets) (make-vector* %max-bullets make-null-rect))
+  (set! (regions bullets) (make-vector* %max-bullets make-null-rect)))
+
+(define-class <bullet> ()
+  (parent #:getter parent #:init-keyword #:parent)
+  (type #:accessor type)
+  (index #:accessor index #:init-keyword #:index)
+  (alive? #:accessor alive? #:init-value #f))
+
+(define-method (dead? (bullet <bullet>))
+  (not (alive? bullet)))
+
+(define-method (kill-bullet (bullet <bullet>))
+  (set! (alive? bullet) #f))
+
+(define-method (velocity (bullet <bullet>))
+  (vector-ref (velocities (parent bullet)) (index bullet)))
+
+(define-method (world-hitbox (bullet <bullet>))
+  (vector-ref (hitboxes (parent bullet)) (index bullet)))
+
+(define-method (add-bullet (bullets <bullets>) bullet-type position velocity)
   (let ((i (size bullets)))
     (when (< i (capacity bullets))
-      (let ((bh (hitbox bullet))
+      (let ((bh (hitbox bullet-type))
+            (d (vector-ref (descriptors bullets) i))
             (v (vector-ref (velocities bullets) i))
             (h (vector-ref (hitboxes bullets) i))
             (r (vector-ref (regions bullets) i)))
-        (vector-set! (descriptors bullets) i bullet)
+        (set! (type d) bullet-type)
+        (set! (alive? d) #t)
         (vec2-copy! velocity (vector-ref (velocities bullets) i))
         (set-rect-x! h (+ (vec2-x position) (rect-x bh)))
         (set-rect-y! h (+ (vec2-y position) (rect-y bh)))
@@ -81,7 +118,7 @@
         (set-rect-width! r 16.0)
         (set-rect-height! r 16.0)
         (set! (size bullets) (+ i 1))
-        (quadtree-insert! (quadtree bullets) r bullet)))))
+        (quadtree-insert! (quadtree bullets) h d)))))
 
 (define-method (remove-bullet (bullets <bullets>) i)
   (let* ((s (- (size bullets) 1))
@@ -96,16 +133,18 @@
          (h (vector-ref hs i)))
     (when (or (> i s) (< i 0))
       (error "bullet index out of bounds" i))
+    (set! (index (vector-ref ds s)) i)
     (vector-set! ds i (vector-ref ds s))
     (vector-set! rs i (vector-ref rs s))
     (vector-set! vs i (vector-ref vs s))
     (vector-set! hs i (vector-ref hs s))
+    (set! (index d) s)
     (vector-set! ds s d)
     (vector-set! rs s r)
     (vector-set! vs s v)
     (vector-set! hs s h)
     (set! (size bullets) s)
-    (quadtree-delete! q r d)))
+    (quadtree-delete! q h d)))
 
 (define-method (render (bullets <bullets>) alpha)
   (let ((ds (descriptors bullets))
@@ -132,37 +171,21 @@
               (v (vector-ref vs i))
               (h (vector-ref hs i)))
           (cond
-           ((or (< (rect-left h) -16.0)
+           ((or (dead? d)
+                (< (rect-left h) -16.0)
                 (> (rect-right h) 336.0)
                 (< (rect-bottom h) -16.0)
                 (> (rect-top h) 256.0))
-            (pk 'remove i)
             (remove-bullet bullets i)
             (loop i))
            ((and (= (vec2-x v) 0.0)
                  (= (vec2-y v) 0.0))
             (loop (+ i 1)))
            (else
-             (quadtree-delete! q r d)
+             (quadtree-delete! q h d)
              (set-rect-x! r (+ (rect-x r) (vec2-x v)))
              (set-rect-y! r (+ (rect-y r) (vec2-y v)))
              (set-rect-x! h (+ (rect-x h) (vec2-x v)))
              (set-rect-y! h (+ (rect-y h) (vec2-y v)))
-             (quadtree-find
-              (quadtree bullets) r
-              (lambda (other)
-                ;; Calculate overlap.
-                (if (is-a? other <actor>)
-                    (let* ((ro (world-hitbox other))
-                           (xo (max (- (min (rect-right r) (rect-right ro))
-                                       (max (rect-left r) (rect-left ro)))
-                                    0.0))
-                           (yo (max (- (min (rect-top r) (rect-top ro))
-                                       (max (rect-bottom r) (rect-bottom ro)))
-                                    0.0)))
-                      (if (or (= xo 0.0) (= yo 0.0))
-                          #f          ; no collision
-                          (on-collide d other)))
-                    #f)))
-             (quadtree-insert! q r d)
+             (quadtree-insert! q h d)
              (loop (+ i 1)))))))))
-- 
cgit v1.2.3