(define-module (bonnie-bee actor) #:use-module (chickadee data quadtree) #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (oop goops) #:use-module (starling node) #:use-module (starling node-2d) #:export ( velocity hitbox world-hitbox quadtree on-collide dead? damage on-death)) (define-class () (velocity #:getter velocity #:init-form (vec2 0.0 0.0)) (hitbox #:getter hitbox #:init-keyword #:hitbox) (world-hitbox #:getter world-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0)) (quadtree #:accessor quadtree #:init-keyword #:quadtree)) (define-method (add-to-quadtree (actor )) (quadtree-insert! (quadtree actor) (world-hitbox actor) actor)) (define-method (remove-from-quadtree (actor )) (quadtree-delete! (quadtree actor) (world-hitbox actor) actor)) (define-method (refresh-world-hitbox (actor )) (let ((p (position actor)) (h (hitbox actor)) (wh (world-hitbox actor))) (set-rect-x! wh (+ (vec2-x p) (rect-x h))) (set-rect-y! wh (+ (vec2-y p) (rect-y h))) (set-rect-width! wh (rect-width h)) (set-rect-height! wh (rect-height h)))) (define-method (on-collide a b) (pk 'unhandled-collision a b) #f) (define-method (on-enter (actor )) (refresh-world-hitbox actor) (add-to-quadtree actor)) (define-method (collision-check (actor )) (let ((p (position actor)) (r (world-hitbox actor))) (quadtree-find (quadtree actor) r (lambda (other) (and (not (eq? other actor)) (rect-intersects? r (world-hitbox other)) (on-collide actor other)))))) (define-method (update (actor ) dt) (let ((p (position actor)) (v (velocity actor))) (if (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0)) (collision-check actor) (begin (remove-from-quadtree actor) (vec2-add! p v) (refresh-world-hitbox actor) (collision-check actor) (add-to-quadtree actor) (dirty! actor))))) (define-class () (health #:accessor health #:init-keyword #:health)) (define-method (dead? (d )) (= (health d) 0)) (define-method (damage (d ) x) (set! (health d) (max (- (health d) x) 0))) (define-method (on-death (d ) bullets) #t)