diff options
Diffstat (limited to 'strigoform/bullets.scm')
| -rw-r--r-- | strigoform/bullets.scm | 106 |
1 files changed, 106 insertions, 0 deletions
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))))))) |