diff options
Diffstat (limited to 'lisparuga/bullets.scm')
| -rw-r--r-- | lisparuga/bullets.scm | 60 |
1 files changed, 37 insertions, 23 deletions
diff --git a/lisparuga/bullets.scm b/lisparuga/bullets.scm index e241694..6645f0d 100644 --- a/lisparuga/bullets.scm +++ b/lisparuga/bullets.scm @@ -39,7 +39,7 @@ bullet-hitbox-rect bullet-tile ikaruga-bullet - ikaruga-missle + ikaruga-missile small-dot medium-dot large-dot @@ -48,7 +48,6 @@ <bullet-field> spawn-bullet - collision? size capacity texture-atlas)) @@ -68,11 +67,11 @@ (tile-black bullet-tile-black)) (define ikaruga-bullet - (make-bullet 'ikaruga (make-rect 0.0 0.0 0.0 0.0) 0 1)) + (make-bullet 'ikaruga (make-rect -3.0 -1.0 6.0 10.0) 0 1)) (define ikaruga-missile - (make-bullet 'ikaruga-missile (make-rect 0.0 0.0 0.0 0.0) 0 1)) + (make-bullet 'ikaruga-missile (make-rect -3.0 -1.0 6.0 10.0) 4 5)) (define small-dot - (make-bullet 'small-dot (make-rect 0.0 0.0 0.0 0.0) 0 1)) + (make-bullet 'small-dot (make-rect -1.0 -1.0 2.0 2.0) 0 1)) (define medium-dot (make-bullet 'medium-dot (make-rect 0.0 0.0 0.0 0.0) 0 1)) (define large-dot @@ -98,6 +97,7 @@ (positions #:accessor positions) (velocities #:accessor velocities) (hitboxes #:accessor hitboxes) + (procs #:accessor procs) (texture-atlas #:accessor texture-atlas #:init-keyword #:texture-atlas) (scratch-rect #:getter scratch-rect #:init-form (make-rect 0.0 0.0 0.0 0.0))) @@ -115,7 +115,8 @@ (set! (polarities bullets) (make-vector capacity)) (set! (positions bullets) (seed-vector (lambda () #v(0.0 0.0)))) (set! (velocities bullets) (seed-vector (lambda () #v(0.0 0.0)))) - (set! (hitboxes bullets) (seed-vector (lambda () (make-rect 0.0 0.0 0.0 0.0)))))) + (set! (hitboxes bullets) (seed-vector (lambda () (make-rect 0.0 0.0 0.0 0.0)))) + (set! (procs bullets) (make-vector capacity)))) (define-method (spawn-bullet (bullets <bullet-field>) id polarity x y dx dy) (let* ((i (size bullets)) @@ -128,22 +129,29 @@ (vector-set! (polarities bullets) i polarity) (set-vec2! p x y) (set-vec2! v dx dy) - (set-rect-x! h (rect-x r)) - (set-rect-y! h (rect-y r)) + (set-rect-x! h (+ x (rect-x r))) + (set-rect-y! h (+ y (rect-y r))) (set-rect-width! h (rect-width r)) - (set-rect-height! h (rect-height r)))) + (set-rect-height! h (rect-height r)) + (vector-set! (procs bullets) i #f))) + +(define-method (spawn-bullet (bullets <bullet-field>) id polarity x y dx dy proc) + (spawn-bullet bullets id polarity x y dx dy) + (vector-set! (procs bullets) (- (size bullets) 1) proc)) (define-method (move-bullet (bullets <bullet-field>) from to) (let ((ids (ids bullets)) (polarities (polarities bullets)) (positions (positions bullets)) (velocities (velocities bullets)) - (hitboxes (hitboxes bullets))) + (hitboxes (hitboxes bullets)) + (procs (procs bullets))) (vector-set! ids to (vector-ref ids from)) (vector-set! polarities to (vector-ref polarities from)) (vec2-copy! (vector-ref positions from) (vector-ref positions to)) (vec2-copy! (vector-ref velocities from) (vector-ref velocities to)) - (rect-copy! (vector-ref hitboxes from) (vector-ref hitboxes to)))) + (rect-copy! (vector-ref hitboxes from) (vector-ref hitboxes to)) + (vector-set! procs to (vector-ref procs from)))) (define-method (kill-bullet (bullets <bullet-field>) i) (let ((new-size (- (size bullets) 1))) @@ -158,6 +166,7 @@ (positions (positions bullets)) (velocities (velocities bullets)) (hitboxes (hitboxes bullets)) + (procs (procs bullets)) ;; Delete bullets that go too far off the screen. (min-x -32.0) (min-y -32.0) @@ -171,7 +180,9 @@ (when (< i l) (let ((p (vector-ref positions i)) (v (vector-ref velocities i)) - (h (vector-ref hitboxes i))) + (h (vector-ref hitboxes i)) + (proc (vector-ref procs i))) + (and (procedure? proc) (proc p v)) (vec2-add! p v) ;; Remove bullets that go out of bounds of the play area. (if (or (< (vec2-x p) min-x) @@ -198,17 +209,20 @@ (polarities (polarities bullets)) (hitboxes (hitboxes bullets))) (let loop ((i 0)) - (when (< i l) - (let* ((id (vector-ref ids i)) - (h (vector-ref hitboxes i)) - (wh (find (lambda (wh) - (world-hitbox-collision? wh h)) - (world-hitboxes actor)))) - (if (and wh - (on-collision actor id (vector-ref polarities i) - (world-hitbox-parent wh))) - (kill-bullet bullets i) - (loop (+ i 1)))))))) + (if (< i l) + (let* ((id (vector-ref ids i)) + (h (vector-ref hitboxes i)) + (collided? (find (lambda (wh) + (and (world-hitbox-collision? wh h) + (on-collision actor id (vector-ref polarities i) + (world-hitbox-parent wh)))) + (world-hitboxes actor)))) + (if collided? + (begin + (kill-bullet bullets i) + #t) + (loop (+ i 1)))) + #f)))) (define %identity-matrix (make-identity-matrix4)) |