Day 1 check-in.

1 files changed, 168 insertions, 0 deletions

diff --git a/bonnie-bee/bullet.scm b/bonnie-bee/bullet.scm
new file mode 100644
index 0000000..ecf7b53
--- /dev/null
+++ b/bonnie-bee/bullet.scm
@@ -0,0 +1,168 @@
+(define-module (bonnie-bee bullet)
+  #:use-module (bonnie-bee actor)
+  #:use-module (bonnie-bee assets)
+  #:use-module (chickadee data quadtree)
+  #:use-module (chickadee graphics sprite)
+  #:use-module (chickadee graphics texture)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee utils)
+  #:use-module (oop goops)
+  #:use-module (starling asset)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:export (<bullet>
+            type
+            pollen-pickup
+            <bullets>
+            add-bullet))
+
+(define-class <bullet> ()
+  (type #:getter type #:init-keyword #:type)
+  (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)))
+
+(define pollen-pickup
+  (make <bullet> #:type 'pollen #:atlas-index 6
+        #:hitbox (make-rect -10.0 -10.0 20.0 20.0)))
+
+(define (make-bullet-sprite-batch)
+  (make-sprite-batch
+   (texture-parent
+    (texture-atlas-ref (asset-ref bullet-atlas) 0))))
+
+(define (make-vector* size thunk)
+  (let ((v (make-vector size)))
+    (for-range ((i size))
+      (vector-set! v i (thunk)))
+    v))
+
+(define (make-null-vec2)
+  (vec2 0.0 0.0))
+
+(define (make-null-rect)
+  (make-rect 0.0 0.0 0.0 0.0))
+
+(define %max-bullets 2048)
+(define %identity-matrix (make-identity-matrix4))
+
+(define-class <bullets> (<node-2d>)
+  (quadtree #:getter quadtree #:init-keyword #:quadtree)
+  (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)
+  (let ((i (size bullets)))
+    (when (< i (capacity bullets))
+      (let ((bh (hitbox bullet))
+            (v (vector-ref (velocities bullets) i))
+            (h (vector-ref (hitboxes bullets) i))
+            (r (vector-ref (regions bullets) i)))
+        (vector-set! (descriptors bullets) i bullet)
+        (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)))
+        (set-rect-width! h (rect-width bh))
+        (set-rect-height! h (rect-height bh))
+        (set-rect-x! r (- (vec2-x position) 8.0))
+        (set-rect-y! r (- (vec2-y position) 8.0))
+        (set-rect-width! r 16.0)
+        (set-rect-height! r 16.0)
+        (set! (size bullets) (+ i 1))
+        (quadtree-insert! (quadtree bullets) r bullet)))))
+
+(define-method (remove-bullet (bullets <bullets>) i)
+  (let* ((s (- (size bullets) 1))
+         (ds (descriptors bullets))
+         (rs (regions bullets))
+         (vs (velocities bullets))
+         (hs (hitboxes bullets))
+         (q (quadtree bullets))
+         (d (vector-ref ds i))
+         (r (vector-ref rs i))
+         (v (vector-ref vs i))
+         (h (vector-ref hs i)))
+    (when (or (> i s) (< i 0))
+      (error "bullet index out of bounds" 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))
+    (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)))
+
+(define-method (render (bullets <bullets>) alpha)
+  (let ((ds (descriptors bullets))
+        (rs (regions bullets))
+        (b (batch bullets)))
+    (sprite-batch-clear! b)
+    (for-range ((i (size bullets)))
+      (let ((d (vector-ref ds i))
+            (r (vector-ref rs i)))
+        (sprite-batch-add* b r %identity-matrix
+                           #:texture-region (bullet-texture d))))
+    (draw-sprite-batch* b (world-matrix bullets))))
+
+(define-method (update (bullets <bullets>) dt)
+  (let ((ds (descriptors bullets))
+        (rs (regions bullets))
+        (vs (velocities bullets))
+        (hs (hitboxes bullets))
+        (q (quadtree bullets)))
+    (let loop ((i 0))
+      (when (< i (size bullets))
+        (let ((d (vector-ref ds i))
+              (r (vector-ref rs i))
+              (v (vector-ref vs i))
+              (h (vector-ref hs i)))
+          (cond
+           ((or (< (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)
+             (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)
+             (loop (+ i 1)))))))))