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