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