From ebc1c54b8f184ff485561b7c039be368b6a9d2c9 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 10 Apr 2020 22:42:26 -0400 Subject: Day 1 progress. --- lisparuga/bullets.scm | 243 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 243 insertions(+) create mode 100644 lisparuga/bullets.scm (limited to 'lisparuga/bullets.scm') diff --git a/lisparuga/bullets.scm b/lisparuga/bullets.scm new file mode 100644 index 0000000..e241694 --- /dev/null +++ b/lisparuga/bullets.scm @@ -0,0 +1,243 @@ +;;; Lisparuga +;;; Copyright © 2020 David Thompson +;;; +;;; Lisparuga is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Lisparuga is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Lisparuga. If not, see . + +;;; Commentary: +;; +;; Bullet state and logic. +;; +;;; Code: + +(define-module (lisparuga bullets) + #:use-module (chickadee math matrix) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (chickadee render color) + #:use-module (chickadee render sprite) + #:use-module (chickadee render texture) + #:use-module (lisparuga actor) + #:use-module (lisparuga asset) + #:use-module (lisparuga node) + #:use-module (lisparuga node-2d) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:export (make-bullet + bullet-name + bullet-hitbox-rect + bullet-tile + ikaruga-bullet + ikaruga-missle + small-dot + medium-dot + large-dot + tapered-shot + big-laser + + + spawn-bullet + collision? + size + capacity + texture-atlas)) + + +;;; +;;; Bullet Identifiers +;;; + +(define-record-type + (make-bullet name hitbox-rect tile-white tile-black) + bullet? + (name bullet-name) + ;; *NOT* a instance, those are just for actors. + (hitbox-rect bullet-hitbox-rect) + (tile-white bullet-tile-white) + (tile-black bullet-tile-black)) + +(define ikaruga-bullet + (make-bullet 'ikaruga (make-rect 0.0 0.0 0.0 0.0) 0 1)) +(define ikaruga-missile + (make-bullet 'ikaruga-missile (make-rect 0.0 0.0 0.0 0.0) 0 1)) +(define small-dot + (make-bullet 'small-dot (make-rect 0.0 0.0 0.0 0.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 + (make-bullet 'large-dot (make-rect 0.0 0.0 0.0 0.0) 0 1)) +(define tapered-shot + (make-bullet 'tapered-shot (make-rect 0.0 0.0 0.0 0.0) 0 1)) +;; Do lasers need a special data type? maybe I won't even get around +;; to implementing them... +(define big-laser + (make-bullet 'big-laser (make-rect 0.0 0.0 0.0 0.0) 0 1)) + + +;;; +;;; Mass bullet management +;;; + +(define-class () + (batch #:getter batch #:init-form (make-sprite-batch #f)) + (size #:accessor size #:init-form 0) + (capacity #:getter capacity #:init-form 1000 #:init-keyword #:capacity) + (ids #:accessor ids) + (polarities #:accessor polarities) + (positions #:accessor positions) + (velocities #:accessor velocities) + (hitboxes #:accessor hitboxes) + (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))) + +(define-method (initialize (bullets ) initargs) + (next-method) + (let ((capacity (capacity bullets))) + (define (seed-vector thunk) + (let ((v (make-vector capacity #f))) + (let loop ((i 0)) + (when (< i capacity) + (vector-set! v i (thunk)) + (loop (+ i 1)))) + v)) + (set! (ids bullets) (make-vector capacity)) + (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)))))) + +(define-method (spawn-bullet (bullets ) id polarity x y dx dy) + (let* ((i (size bullets)) + (p (vector-ref (positions bullets) i)) + (v (vector-ref (velocities bullets) i)) + (h (vector-ref (hitboxes bullets) i)) + (r (bullet-hitbox-rect id))) + (set! (size bullets) (+ i 1)) + (vector-set! (ids bullets) i id) + (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-width! h (rect-width r)) + (set-rect-height! h (rect-height r)))) + +(define-method (move-bullet (bullets ) from to) + (let ((ids (ids bullets)) + (polarities (polarities bullets)) + (positions (positions bullets)) + (velocities (velocities bullets)) + (hitboxes (hitboxes 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)))) + +(define-method (kill-bullet (bullets ) i) + (let ((new-size (- (size bullets) 1))) + (set! (size bullets) new-size) + (move-bullet bullets new-size i))) + +(define-method (clear-bullets (bullets )) + (set! (size bullets) 0)) + +(define-method (update (bullets ) dt) + (let ((l (size bullets)) + (positions (positions bullets)) + (velocities (velocities bullets)) + (hitboxes (hitboxes bullets)) + ;; Delete bullets that go too far off the screen. + (min-x -32.0) + (min-y -32.0) + (max-x (+ 160.0 32.0)) + (max-y (+ 240.0 32.0))) + (define (delete i) + (let ((new-l (- l 1))) + (set! l new-l) + (move-bullet bullets new-l i))) + (let loop ((i 0)) + (when (< i l) + (let ((p (vector-ref positions i)) + (v (vector-ref velocities i)) + (h (vector-ref hitboxes i))) + (vec2-add! p v) + ;; Remove bullets that go out of bounds of the play area. + (if (or (< (vec2-x p) min-x) + (> (vec2-x p) max-x) + (< (vec2-y p) min-y) + (> (vec2-y p) max-y)) + (begin + (delete i) + (loop i)) + (begin + ;; Adjust hitbox. + (set-rect-x! h (+ (rect-x h) (vec2-x v))) + (set-rect-y! h (+ (rect-y h) (vec2-y v))) + (loop (+ i 1))))))) + (set! (size bullets) l))) + +;; Actor-bullet collision event. +(define-method (on-collision (actor ) bullet bullet-polarity hitbox) + #t) + +(define-method (collide (bullets ) (actor )) + (let ((l (size bullets)) + (ids (ids bullets)) + (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)))))))) + +(define %identity-matrix (make-identity-matrix4)) + +(define-method (render (bullets ) alpha) + (let ((l (size bullets)) + (batch (batch bullets)) + (ids (ids bullets)) + (polarities (polarities bullets)) + (positions (positions bullets)) + (atlas (asset-ref (texture-atlas bullets))) + (r (scratch-rect bullets))) + (set-sprite-batch-texture! batch (texture-atlas-texture atlas)) + (sprite-batch-clear! batch) + (let loop ((i 0)) + (when (< i l) + (let* ((p (vector-ref positions i)) + (id (vector-ref ids i)) + (polarity (vector-ref polarities i)) + (tile (if (eq? polarity 'white) + (bullet-tile-white id) + (bullet-tile-black id))) + (texture (texture-atlas-ref atlas tile)) + (tw (texture-width texture)) + (th (texture-height texture))) + (set-rect-x! r (- (vec2-x p) (/ tw 2.0))) + (set-rect-y! r (- (vec2-y p) (/ th 2.0))) + (set-rect-width! r tw) + (set-rect-height! r th) + (sprite-batch-add* batch r %identity-matrix + #:texture-region texture)) + (loop (+ i 1)))) + (draw-sprite-batch* batch (world-matrix bullets)))) -- cgit v1.2.3