path: root/bonnie-bee/bullet.scm

(define-module (bonnie-bee bullet)
  #:use-module (bonnie-bee actor)
  #:use-module (bonnie-bee assets)
  #:use-module (bonnie-bee common)
  #: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 (srfi srfi-9)
  #:use-module (catbird asset)
  #:use-module (catbird node)
  #:use-module (catbird node-2d)
  #:export (<bullet-type>
            player-bullet?
            player-primary-bullet?
            player-bomb-bullet?
            enemy-bullet?
            player-primary-bullet
            player-bomb-bullet
            large-enemy-bullet
            medium-enemy-bullet
            small-enemy-bullet
            pollen-pickup
            <bullets>
            clear-bullets
            <bullet>
            type
            kill-bullet
            add-bullet))

(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 (artifact 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)))

(define player-bomb-bullet
  (make <bullet-type> #:name 'player-bomb #:atlas-index 5
        #:hitbox (make-rect -4.0 -4.0 8.0 8.0)))

(define large-enemy-bullet
  (make <bullet-type> #:name 'large-enemy #:atlas-index 0
        #:hitbox (make-rect -4.0 -4.0 8.0 8.0)))

(define medium-enemy-bullet
  (make <bullet-type> #:name 'medium-enemy #:atlas-index 1
        #:hitbox (make-rect -1.25 -1.25 2.5 2.5)))

(define small-enemy-bullet
  (make <bullet-type> #:name 'small-enemy #:atlas-index 2
        #:hitbox (make-rect -0.5 -0.5 1.0 1.0)))

;; Yeah... pollen is a bullet.  Didn't you know that??
(define pollen-pickup
  (make <bullet-type> #:name 'pollen #:atlas-index 6
        #:hitbox (make-rect -16.0 -16.0 32.0 32.0)))

(define (make-bullet-sprite-batch)
  (make-sprite-batch
   (texture-parent
    (texture-atlas-ref (artifact bullet-atlas) 0))))

(define (make-vector* size proc)
  (let ((v (make-vector size)))
    (for-range ((i size))
      (vector-set! v i (proc i)))
    v))

(define (make-null-vec2 i)
  (vec2 0.0 0.0))

(define (make-null-rect i)
  (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)
  (num-bullets #:accessor num-bullets #:init-value 0)
  (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-method (default-width (bullets <bullets>))
  %game-width)

(define-method (default-height (bullets <bullets>))
  %game-height)

(define-method (clear-bullets (bullets <bullets>))
  (set! (num-bullets bullets) 0))

(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 (num-bullets bullets)))
    (when (< i (capacity bullets))
      (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)))
        (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)))
        (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! (num-bullets bullets) (+ i 1))
        (quadtree-insert! (quadtree bullets) h d)))))

(define-method (remove-bullet (bullets <bullets>) i)
  (let* ((s (- (num-bullets 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))
    (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! (num-bullets bullets) s)
    (quadtree-delete! q h d)))

(define-method (render (bullets <bullets>) alpha)
  (let ((ds (descriptors bullets))
        (rs (regions bullets))
        (b (batch bullets)))
    (sprite-batch-clear! b)
    (for-range ((i (num-bullets 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 (num-bullets bullets))
        (let ((d (vector-ref ds i))
              (r (vector-ref rs i))
              (v (vector-ref vs i))
              (h (vector-ref hs i)))
          (cond
           ((or (dead? d)
                (< (rect-left h) -16.0)
                (> (rect-right h) 336.0)
                (< (rect-bottom h) -16.0)
                (> (rect-top h) 284.0))
            (remove-bullet bullets i)
            (loop i))
           ((and (= (vec2-x v) 0.0)
                 (= (vec2-y v) 0.0))
            (loop (+ i 1)))
           (else
             (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-insert! q h d)
             (loop (+ i 1)))))))))

(define (player-bullet? bullet)
  (let ((t (type bullet)))
    (or (eq? t player-primary-bullet)
        (eq? t player-bomb-bullet))))

(define (player-primary-bullet? bullet)
  (eq? (type bullet) player-primary-bullet))

(define (player-bomb-bullet? bullet)
  (eq? (type bullet) player-bomb-bullet))

(define (enemy-bullet? bullet)
  (let ((t (type bullet)))
    (or (eq? t small-enemy-bullet)
        (eq? t medium-enemy-bullet)
        (eq? t large-enemy-bullet))))