diff options
Diffstat (limited to 'bonnie-bee/bullet.scm')
| -rw-r--r-- | bonnie-bee/bullet.scm | 168 |
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))))))))) |