diff options
Diffstat (limited to 'strigoform/enemies.scm')
| -rw-r--r-- | strigoform/enemies.scm | 241 |
1 files changed, 241 insertions, 0 deletions
diff --git a/strigoform/enemies.scm b/strigoform/enemies.scm new file mode 100644 index 0000000..a457c8d --- /dev/null +++ b/strigoform/enemies.scm @@ -0,0 +1,241 @@ +(library (strigoform enemies) + (export make-enemy + enemy? + enemy-type + enemy-health set-enemy-health! + enemy-position + enemy-x set-enemy-x! + enemy-y set-enemy-y! + enemy-size + enemy-width + enemy-height + enemy-velocity + enemy-dx set-enemy-dx! + enemy-dy set-enemy-dy! + enemy-script + enemy-points + enemy-spawn-time + enemy-animation + enemy-image + enemy-image-size + enemy-damage! + enemy-dead? + enemy-out-of-bounds? + enemy-within-rect? + enemy-start! + enemy-stop! + draw-enemy + + make-enemy-pool + enemy-pool? + enemy-pool-length + enemy-pool-capacity + enemy-pool-enemies + enemy-pool-add! + enemy-pool-remove! + enemy-pool-reset! + enemy-pool-update! + draw-enemies + find-enemy) + (import (scheme base) + (hoot match) + (strigoform assets) + (strigoform audio) + (strigoform canvas) + (strigoform game-area) + (strigoform math) + (strigoform particles) + (strigoform scripts) + (strigoform time) + (strigoform type)) + + (define-type enemy + %make-enemy + enemy? + (type enemy-type set-enemy-type!) + (health enemy-health set-enemy-health!) + (position enemy-position set-enemy-position!) + (size enemy-size set-enemy-size!) + (velocity enemy-velocity set-enemy-velocity!) + (script enemy-script set-enemy-script!) + (points enemy-points set-enemy-points!) + (spawn-time enemy-spawn-time set-enemy-spawn-time!) + (animation enemy-animation set-enemy-animation!) + (image enemy-image set-enemy-image!) + (image-size enemy-image-size set-enemy-image-size!)) + + (define (make-enemy type health position size velocity + script points animation image image-size) + (%make-enemy type health position size velocity script + points (current-time) animation image + image-size)) + + (define (enemy-x enemy) + (vec2-x (enemy-position enemy))) + + (define (enemy-y enemy) + (vec2-y (enemy-position enemy))) + + (define (set-enemy-x! enemy x) + (set-vec2-x! (enemy-position enemy) x)) + + (define (set-enemy-y! enemy y) + (set-vec2-y! (enemy-position enemy) y)) + + (define (enemy-width enemy) + (vec2-x (enemy-size enemy))) + + (define (enemy-height enemy) + (vec2-y (enemy-size enemy))) + + (define (enemy-dx enemy) + (vec2-x (enemy-velocity enemy))) + + (define (enemy-dy enemy) + (vec2-y (enemy-velocity enemy))) + + (define (set-enemy-dx! enemy dx) + (set-vec2-x! (enemy-velocity enemy) dx)) + + (define (set-enemy-dy! enemy dy) + (set-vec2-y! (enemy-velocity enemy) dy)) + + (define (enemy-damage! enemy damage) + (match enemy + (#('enemy type health _ _ _ _ _ _ _ _ _) + (set-enemy-health! enemy (- health damage))))) + + (define (enemy-dead? enemy) + (<= (enemy-health enemy) 0)) + + (define (enemy-out-of-bounds? enemy) + (match enemy + (#('enemy _ _ position size _ _ _ _ _ _ _) + (out-of-bounds? (vec2-x position) (vec2-y position) + (vec2-x size) (vec2-y size))))) + + (define (enemy-within-rect? enemy x y w h) + (match enemy + (#('enemy _ _ position size _ _ _ _ _ _ _) + (let* ((w* (vec2-x size)) + (h* (vec2-y size)) + (x* (- (vec2-x position) (/ w* 2.0))) + (y* (- (vec2-y position) (/ h* 2.0)))) + (rect-within? x y w h x* y* w* h*))))) + + (define (enemy-start! enemy) + (let ((proc (enemy-script enemy))) + (when (procedure? proc) + (set-enemy-script! enemy (run-script (lambda () (proc enemy))))))) + + (define (enemy-stop! enemy) + (let ((script (enemy-script enemy))) + (when (script? script) + (script-cancel! script)))) + + (define (enemy-update! enemy dscroll) + (match enemy + (#('enemy _ _ position size velocity _ _ _ _ _ _) + (set-vec2-x! position (+ (vec2-x position) (vec2-x velocity))) + (set-vec2-y! position (+ (vec2-y position) + (+ (vec2-y velocity) dscroll)))))) + + (define (draw-enemy context enemy time) + (let ((frame-duration 0.25)) + (match enemy + (#('enemy type _ position size _ _ _ spawn-time animation + image image-size) + (let* ((tx (vector-ref animation + (modulo (exact + (truncate + (/ (- time spawn-time) + frame-duration))) + (vector-length animation)))) + (x (vec2-x position)) + (y (vec2-y position)) + (hbw (vec2-x size)) + (hbh (vec2-y size)) + (w (vec2-x image-size)) + (h (vec2-y image-size))) + (draw-image context image tx 0.0 w h + (- x (/ w 2.0)) (- y (/ h 2.0)) w h) + ;; (when *debug?* + ;; (set-fill-color! context "#ff00ff80") + ;; (fill-rect context + ;; (- x (/ hbw 2.0)) + ;; (- y (/ hbh 2.0)) + ;; hbw hbh)) + ))))) + + (define-type enemy-pool + %make-enemy-pool + enemy-pool? + (length enemy-pool-length set-enemy-pool-length!) + (capacity enemy-pool-capacity set-enemy-pool-capacity!) + (enemies enemy-pool-enemies set-enemy-pool-enemies!)) + + (define (make-enemy-pool capacity) + (%make-enemy-pool 0 capacity (make-vector capacity #f))) + + (define (enemy-pool-add! pool enemy) + (match pool + (#('enemy-pool length capacity enemies) + (unless (= length capacity) + (vector-set! enemies length enemy) + (set-enemy-pool-length! pool (+ length 1)) + (enemy-start! enemy))))) + + (define (enemy-pool-remove! pool i) + (match pool + (#('enemy-pool length capacity enemies) + (when (and (>= i 0) (< i length)) + (let ((j (- length 1)) + (enemy (vector-ref enemies i))) + (vector-set! enemies i (vector-ref enemies j)) + (vector-set! enemies j #f) + (enemy-stop! enemy) + (set-enemy-pool-length! pool j)))))) + + (define (enemy-pool-reset! pool) + (match pool + (#('enemy-pool length capacity enemies) + (do ((i 0 (+ i 1))) + ((= i length)) + (enemy-stop! (vector-ref enemies i)) + (vector-set! enemies i #f)) + (set-enemy-pool-length! pool 0)))) + + (define (enemy-pool-update! pool dscroll particles on-kill) + (match pool + (#('enemy-pool length capacity enemies) + (let ((padding 16.0)) + (let loop ((i 0) (k length)) + (unless (= i k) + (let ((enemy (vector-ref enemies i))) + (enemy-update! enemy dscroll) + (cond + ((or (enemy-dead? enemy) + (enemy-out-of-bounds? enemy)) + (when (enemy-dead? enemy) + (on-kill enemy)) + (enemy-pool-remove! pool i) + (loop i (- k 1))) + (else + (loop (+ i 1) k)))))))))) + + (define (draw-enemies context pool time) + (match pool + (#('enemy-pool length capacity enemies) + (do ((i 0 (+ i 1))) + ((= i length)) + (draw-enemy context (vector-ref enemies i) time))))) + + (define (find-enemy pool x y w h) + (match pool + (#('enemy-pool length capacity enemies) + (let loop ((i 0)) + (and (< i length) + (let ((enemy (vector-ref enemies i))) + (if (enemy-within-rect? enemy x y w h) + enemy + (loop (+ i 1)))))))))) |