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.scm109
1 files changed, 66 insertions, 43 deletions
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)))))))))