summaryrefslogtreecommitdiff
path: root/bonnie-bee/bullet.scm
diff options
context:
space:
mode:
Diffstat (limited to 'bonnie-bee/bullet.scm')
-rw-r--r--bonnie-bee/bullet.scm168
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)))))))))