(library (strigoform particles)
  (export make-particle-pool
          particle-pool?
          particle-pool-add!
          particle-pool-reset!
          particle-pool-update!
          draw-particles
          explode)
  (import (scheme base)
          (scheme inexact)
          (hoot match)
          (strigoform canvas)
          (strigoform math)
          (strigoform type))

  (define-type particle-pool
    %make-particle-pool
    particle-pool?
    (length particle-pool-length set-particle-pool-length!)
    (capacity particle-pool-capacity set-particle-pool-capacity!)
    (image particle-pool-image set-particle-pool-image!)
    (ticks particle-pool-ticks set-particle-pool-ticks!)
    (particles particle-pool-particles set-particle-pool-particles!))

  ;; per particle: spawn-time, lifespan, tile-x, x, y, dx, dy
  (define %particle-size (+ 4 4 8 8 8 8 8))
  (define particle-tile-width 8.0)
  (define particle-tile-height 8.0)

  (define (make-particle-pool capacity image)
    (let ((particles (make-bytevector (* capacity %particle-size))))
      (%make-particle-pool 0 capacity image 0 particles)))

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

  (define (particle-pool-add! pool type lifespan x y dx dy)
    (match pool
      (#('particle-pool length capacity image ticks particles)
       (let ((offset (particle-pool-offset length))
             (tx (* (match type
                      ('muzzle-flash 0.0)
                      ('explosion 1.0)
                      ('hit-wall 2.0))
                    particle-tile-width)))
         (s32-set! particles offset ticks)
         (s32-set! particles (+ offset 4) lifespan)
         (f64-set! particles (+ offset 8) tx)
         (f64-set! particles (+ offset 16) x)
         (f64-set! particles (+ offset 24) y)
         (f64-set! particles (+ offset 32) dx)
         (f64-set! particles (+ offset 40) dy)
         (set-particle-pool-length! pool (+ length 1))))))

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

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

  (define (particle-pool-update! pool)
    (match pool
      (#('particle-pool length capacity image ticks particles)
       (let ((t (+ ticks 1)))
         (let loop ((i 0) (k length))
           (when (< i k)
             (let* ((offset (particle-pool-offset i))
                    (t* (s32-ref particles offset))
                    (l (s32-ref particles (+ offset 4)))
                    (x (f64-ref particles (+ offset 16)))
                    (y (f64-ref particles (+ offset 24)))
                    (dx (f64-ref particles (+ offset 32)))
                    (dy (f64-ref particles (+ offset 40)))
                    (x* (+ x dx))
                    (y* (+ y dy)))
               (cond
                ((>= (- t t*) l)
                 (particle-pool-remove! pool i)
                 (loop i (- k 1)))
                (else
                 (f64-set! particles (+ offset 16) (+ x dx))
                 (f64-set! particles (+ offset 24) (+ y dy))
                 (loop (+ i 1) k))))))
         (set-particle-pool-ticks! pool t)))))

  (define (draw-particles context pool)
    (match pool
      (#('particle-pool length capacity image ticks particles)
       (do ((i 0 (+ i 1)))
           ((= i length))
         (let* ((offset (particle-pool-offset i))
                (tx (f64-ref particles (+ offset 8)))
                (x (f64-ref particles (+ offset 16)))
                (y (f64-ref particles (+ offset 24))))
           (draw-image context image tx 0.0
                       particle-tile-width particle-tile-height
                       (- x (/ particle-tile-width 2.0))
                       (- y (/ particle-tile-height 2.0))
                       particle-tile-width particle-tile-height))))))

  (define (explode particles x y)
    (let ((speed 1.0))
      (do-circle
       (lambda (theta)
         (particle-pool-add! particles 'explosion 20 x y
                             (* (cos theta) speed) (* (sin theta) speed)))
       16))))