(library (strigoform bullets)
  (export make-bullet-pool
          bullet-pool?
          bullet-pool-add!
          bullet-pool-remove!
          bullet-pool-reset!
          bullet-pool-update!
          draw-bullets)
  (import (scheme base)
          (hoot match)
          (strigoform canvas)
          (strigoform game-area)
          (strigoform math)
          (strigoform particles)
          (strigoform type))

  (define-type bullet-pool
    %make-bullet-pool
    bullet-pool?
    (length bullet-pool-length set-bullet-pool-length!)
    (capacity bullet-pool-capacity set-bullet-pool-capacity!)
    (image bullet-pool-image set-bullet-pool-image!)
    (bullets bullet-pool-bullets set-bullet-pool-bullets!))

  (define bullet-tile-width 16.0)
  (define bullet-tile-height 16.0)
  ;; per bullet: type, tile-x, x, y, w, h, dx, dy
  (define %bullet-size (+ 4 8 8 8 8 8 8 8))

  (define (make-bullet-pool capacity image)
    (let ((bullets (make-bytevector (* capacity %bullet-size))))
      (%make-bullet-pool 0 capacity image bullets)))

  (define (bullet-pool-offset i)
    (* i %bullet-size))

  (define (bullet-pool-add! pool type x y w h dx dy)
    (match pool
      (#('bullet-pool length capacity image bullets)
       (let ((offset (bullet-pool-offset length)))
         (s32-set! bullets offset type)
         (f64-set! bullets (+ offset 4) (* type bullet-tile-width))
         (f64-set! bullets (+ offset 12) x)
         (f64-set! bullets (+ offset 20) y)
         (f64-set! bullets (+ offset 28) w)
         (f64-set! bullets (+ offset 36) h)
         (f64-set! bullets (+ offset 44) dx)
         (f64-set! bullets (+ offset 52) dy)
         (set-bullet-pool-length! pool (+ length 1))))))

  (define (bullet-pool-remove! pool i)
    (match pool
      (#('bullet-pool length capacity image bullets)
       (when (and (>= i 0) (< i length))
         (let ((at (bullet-pool-offset i))
               (start (bullet-pool-offset (- length 1))))
           (bytevector-copy! bullets at bullets start (+ start %bullet-size))
           (set-bullet-pool-length! pool (- length 1)))))))

  (define (bullet-pool-reset! pool)
    (set-bullet-pool-length! pool 0))

  (define (bullet-pool-update! pool collide dscroll on-collide)
    (match pool
      (#('bullet-pool length capacity image bullets)
       (let loop ((i 0) (k length))
         (when (< i k)
           (let* ((offset (bullet-pool-offset i))
                  (type (s32-ref bullets offset))
                  (x (f64-ref bullets (+ offset 12)))
                  (y (f64-ref bullets (+ offset 20)))
                  (w (f64-ref bullets (+ offset 28)))
                  (h (f64-ref bullets (+ offset 36)))
                  (dx (f64-ref bullets (+ offset 44)))
                  (dy (f64-ref bullets (+ offset 52)))
                  (x* (+ x dx))
                  (y* (+ y dy dscroll)))
             (cond
              ((out-of-bounds? x* y* w h)
               (bullet-pool-remove! pool i)
               (loop i (- k 1)))
              ((collide type x* y* w h)
               (on-collide type x* y*)
               (bullet-pool-remove! pool i)
               (loop i (- k 1)))
              (else
               (f64-set! bullets (+ offset 12) x*)
               (f64-set! bullets (+ offset 20) y*)
               (loop (+ i 1) k)))))))))

  (define (draw-bullets context pool)
    (match pool
      (#('bullet-pool length capacity image bullets)
       (do ((i 0 (+ i 1)))
           ((= i length))
         (let* ((offset (bullet-pool-offset i))
                (tx (f64-ref bullets (+ offset 4)))
                (x (f64-ref bullets (+ offset 12)))
                (y (f64-ref bullets (+ offset 20)))
                (w (f64-ref bullets (+ offset 28)))
                (h (f64-ref bullets (+ offset 36))))
           (draw-image context image tx 0.0
                       bullet-tile-width bullet-tile-height
                       (- x (/ bullet-tile-width 2.0))
                       (- y (/ bullet-tile-height 2.0))
                       bullet-tile-width bullet-tile-height)))))))