From 6696a0b5fcb1b17895285d80d9636defb2df3f9d Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 10 Apr 2024 14:49:03 -0400
Subject: Sloppily refactor into modules.

---
 strigoform/bullets.scm | 106 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 106 insertions(+)
 create mode 100644 strigoform/bullets.scm

(limited to 'strigoform/bullets.scm')

diff --git a/strigoform/bullets.scm b/strigoform/bullets.scm
new file mode 100644
index 0000000..f271d43
--- /dev/null
+++ b/strigoform/bullets.scm
@@ -0,0 +1,106 @@
+(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)))))))
-- 
cgit v1.2.3