diff options
-rw-r--r-- | game.scm | 254 | ||||
-rw-r--r-- | images/enemies.ase | bin | 0 -> 404 bytes | |||
-rw-r--r-- | images/enemies.png | bin | 0 -> 156 bytes | |||
-rw-r--r-- | index.html | 1 |
4 files changed, 183 insertions, 72 deletions
@@ -200,9 +200,13 @@ (>= y ry) (<= x (+ rx rw)) (<= y (+ ry rh)))) - (define (vec2-within-rect? v r) - (within? (vec2-x v) (vec2-y v) - (rect-x r) (rect-y r) (rect-w r) (rect-h r))) + (define (rect-within? ax ay aw ah bx by bw bh) + (let ((ax* (+ ax aw)) + (ay* (+ ay ah))) + (or (within? ax ay bx by bw bh) + (within? ax* ay bx by bw bh) + (within? ax* ay* bx by bw bh) + (within? ax ay* bx by bw bh)))) (define demichrome0 "#211e20") (define demichrome1 "#555568") @@ -219,80 +223,65 @@ (define image:player (get-element-by-id "image-player")) (define image:player-bullet (get-element-by-id "image-player-bullet")) (define image:map (get-element-by-id "image-map")) + (define image:enemies (get-element-by-id "image-enemies")) - ;; header: length, capacity - (define %bullet-pool-header-size (+ 4 4)) ;; per bullet: type, x, y, dx, dy - (define %bullet-pool-bullet-size (+ 4 8 8 8 8)) + (define %bullet-size (+ 4 8 8 8 8)) (define (make-bullet-pool capacity) - (let ((pool (make-bytevector (+ %bullet-pool-header-size - (* capacity %bullet-pool-bullet-size))))) - (bytevector-s32-native-set! pool 4 capacity) - pool)) - (define (bullet-pool-length pool) - (bytevector-s32-native-ref pool 0)) - (define (set-bullet-pool-length! pool length) - (bytevector-s32-native-set! pool 0 length)) - (define (bullet-pool-capacity pool) - (bytevector-s32-native-ref pool 4)) + (let ((pool (make-bytevector (* capacity %bullet-size)))) + (vector 0 capacity pool))) (define (bullet-pool-offset i) - (+ %bullet-pool-header-size (* i %bullet-pool-bullet-size))) + (* i %bullet-size)) (define (bullet-pool-add! pool type x y dx dy) - (let* ((k (bullet-pool-length pool)) - (offset (bullet-pool-offset k))) - (bytevector-s32-native-set! pool offset type) - (bytevector-ieee-double-native-set! pool (+ offset 4) x) - (bytevector-ieee-double-native-set! pool (+ offset 12) y) - (bytevector-ieee-double-native-set! pool (+ offset 20) dx) - (bytevector-ieee-double-native-set! pool (+ offset 28) dy) - (set-bullet-pool-length! pool (+ k 1)))) + (match pool + (#(length capacity bullets) + (let ((offset (bullet-pool-offset length))) + (bytevector-s32-native-set! bullets offset type) + (bytevector-ieee-double-native-set! bullets (+ offset 4) x) + (bytevector-ieee-double-native-set! bullets (+ offset 12) y) + (bytevector-ieee-double-native-set! bullets (+ offset 20) dx) + (bytevector-ieee-double-native-set! bullets (+ offset 28) dy) + (vector-set! pool 0 (+ length 1)))))) (define (bullet-pool-remove! pool i) - (let ((k (bullet-pool-length pool))) - (when (and (>= i 0) (< i k)) - (let ((at (bullet-pool-offset i)) - (start (bullet-pool-offset (- k 1)))) - (bytevector-copy! pool at pool start - (+ start %bullet-pool-bullet-size)) - (set-bullet-pool-length! pool (- k 1)))))) - (define (bullet-pool-ref pool i) - (let ((offset (bullet-pool-offset i))) - (values - (bytevector-s32-native-ref pool offset) - (bytevector-ieee-double-native-ref pool (+ offset 4)) - (bytevector-ieee-double-native-ref pool (+ offset 12)) - (bytevector-ieee-double-native-ref pool (+ offset 20)) - (bytevector-ieee-double-native-ref pool (+ offset 28))))) - (define (bullet-pool-update! pool) - (let ((padding 16.0)) - (let loop ((i 0) (k (bullet-pool-length player-bullets))) - (let* ((offset (bullet-pool-offset i)) - (x (bytevector-ieee-double-native-ref pool (+ offset 4))) - (y (bytevector-ieee-double-native-ref pool (+ offset 12))) - (dx (bytevector-ieee-double-native-ref pool (+ offset 20))) - (dy (bytevector-ieee-double-native-ref pool (+ offset 28))) - (x* (+ x dx)) - (y* (+ y dy))) - (cond - ((= i k) #t) - ((or (not (within? x* y* (- padding) (- padding) - (+ game-width padding) (+ game-height padding))) - (point-collides-with-level? level x* y*)) - (bullet-pool-remove! pool i) - (loop i (- k 1))) - (else - (bytevector-ieee-double-native-set! pool (+ offset 4) x*) - (bytevector-ieee-double-native-set! pool (+ offset 12) y*) - (loop (+ i 1) k))))))) + (match pool + (#(length capacity 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)) + (vector-set! pool 0 (- length 1))))))) + (define (bullet-pool-update! pool collide) + (match pool + (#(length capacity bullets) + (let loop ((i 0) (k length)) + (when (< i k) + (let* ((offset (bullet-pool-offset i)) + (x (bytevector-ieee-double-native-ref bullets (+ offset 4))) + (y (bytevector-ieee-double-native-ref bullets (+ offset 12))) + (dx (bytevector-ieee-double-native-ref bullets (+ offset 20))) + (dy (bytevector-ieee-double-native-ref bullets (+ offset 28))) + (x* (+ x dx)) + (y* (+ y dy))) + (cond + ;; TODO: different bullet hitbox sizes. + ((collide x y 2.0 2.0) + (bullet-pool-remove! pool i) + (loop i (- k 1))) + (else + (bytevector-ieee-double-native-set! bullets (+ offset 4) x*) + (bytevector-ieee-double-native-set! bullets (+ offset 12) y*) + (loop (+ i 1) k))))))))) (define (draw-bullets pool image w h) - (let ((k (bullet-pool-length player-bullets))) - (do ((i 0 (+ i 1))) - ((= i k)) - (let* ((offset (bullet-pool-offset i)) - (type (bytevector-s32-native-ref pool offset)) - (x (bytevector-ieee-double-native-ref pool (+ offset 4))) - (y (bytevector-ieee-double-native-ref pool (+ offset 12)))) - (draw-image context image (* type w) (* type h) w h - (- x (/ w 2.0)) (- y (/ w 2.0)) w h))))) + (match pool + (#(length capacity bullets) + (do ((i 0 (+ i 1))) + ((= i length)) + (let* ((offset (bullet-pool-offset i)) + (type (bytevector-s32-native-ref bullets offset)) + (x (bytevector-ieee-double-native-ref bullets (+ offset 4))) + (y (bytevector-ieee-double-native-ref bullets (+ offset 12)))) + (draw-image context image (* type w) (* type h) w h + (- x (/ w 2.0)) (- y (/ w 2.0)) w h)))))) (define player-bullets (make-bullet-pool 100)) (define enemy-bullets (make-bullet-pool 200)) @@ -400,6 +389,102 @@ (* t tw) 0.0 tw th tx ty tw th)))))))) + ;; Enemies: + ;; length, capacity, pool + ;; enemy: type, health, x, y, w, h, dx, dy + (define %enemy-size (+ 4 4 8 8 8 8 8 8)) + (define (make-enemy-pool capacity) + (let ((enemies (make-bytevector (* capacity %enemy-size)))) + (vector 0 capacity enemies))) + (define (enemy-pool-offset i) + (* i %enemy-size)) + (define (enemy-pool-add! pool type hp x y w h dx dy) + (match pool + (#(length capacity enemies) + (unless (= length capacity) + (let ((offset (enemy-pool-offset length))) + (bytevector-s32-native-set! enemies offset type) + (bytevector-s32-native-set! enemies (+ offset 4) hp) + (bytevector-ieee-double-native-set! enemies (+ offset 8) x) + (bytevector-ieee-double-native-set! enemies (+ offset 16) y) + (bytevector-ieee-double-native-set! enemies (+ offset 24) w) + (bytevector-ieee-double-native-set! enemies (+ offset 32) h) + (bytevector-ieee-double-native-set! enemies (+ offset 40) dx) + (bytevector-ieee-double-native-set! enemies (+ offset 48) dy) + (vector-set! pool 0 (+ length 1))))))) + (define (enemy-pool-remove! pool i) + (match pool + (#(length capacity enemies) + (when (and (>= i 0) (< i length)) + (let ((at (enemy-pool-offset i)) + (start (enemy-pool-offset (- length 1)))) + (bytevector-copy! enemies at enemies start (+ start %enemy-size)) + (vector-set! pool 0 (- length 1))))))) + (define (enemy-pool-update! pool collide) + (match pool + (#(length capacity enemies) + (let ((padding 16.0)) + (let loop ((i 0) (k length)) + (unless (= i k) + (let* ((offset (enemy-pool-offset i)) + (hp (bytevector-s32-native-ref enemies (+ offset 4))) + (x (bytevector-ieee-double-native-ref enemies (+ offset 8))) + (y (bytevector-ieee-double-native-ref enemies (+ offset 16))) + (w (bytevector-ieee-double-native-ref enemies (+ offset 24))) + (h (bytevector-ieee-double-native-ref enemies (+ offset 32))) + (dx (bytevector-ieee-double-native-ref enemies (+ offset 40))) + (dy (bytevector-ieee-double-native-ref enemies (+ offset 48))) + (x* (+ x dx)) + (y* (+ y dy))) + (let ((new-hp (collide x y w h hp))) + (cond + ((or (<= hp 0) + (out-of-bounds? x* y* w h)) + (enemy-pool-remove! pool i) + (loop i (- k 1))) + (else + (bytevector-s32-native-set! enemies (+ offset 4) new-hp) + (bytevector-ieee-double-native-set! enemies (+ offset 8) x*) + (bytevector-ieee-double-native-set! enemies (+ offset 16) y*) + (loop (+ i 1) k))))))))))) + (define (draw-enemies pool) + (match pool + (#(length capacity enemies) + (do ((i 0 (+ i 1))) + ((= i length)) + (let* ((offset (enemy-pool-offset i)) + (t (bytevector-s32-native-ref enemies offset)) + (x (bytevector-ieee-double-native-ref enemies (+ offset 8))) + (y (bytevector-ieee-double-native-ref enemies (+ offset 16))) + (w 64.0) + (h 64.0)) + (draw-image context image:enemies (* t w) (* t h) w h + (- x (/ w 2.0)) (- y (/ h 2.0)) w h)))))) + (define (find-enemy pool x y w h) + (match pool + (#(length capacity enemies) + (let loop ((i 0)) + (and (< i length) + (let* ((offset (enemy-pool-offset i)) + (x* (bytevector-ieee-double-native-ref enemies (+ offset 8))) + (y* (bytevector-ieee-double-native-ref enemies (+ offset 16))) + (w* (bytevector-ieee-double-native-ref enemies (+ offset 24))) + (h* (bytevector-ieee-double-native-ref enemies (+ offset 32)))) + (if (rect-within? x y w h x* y* w* h*) + i + (loop (+ i 1))))))))) + (define (damage-enemy! pool i damage) + (match pool + (#(length capacity enemies) + (when (and (>= i 0) (< i length)) + (let* ((offset (enemy-pool-offset i)) + (hp (bytevector-s32-native-ref enemies (+ offset 4)))) + (bytevector-s32-native-set! enemies (+ offset 4) + (- hp damage))))))) + + (define enemies (make-enemy-pool 64)) + (enemy-pool-add! enemies 0 20 70.0 100.0 16.0 16.0 0.0 0.0) + ;; Player state: (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0))) (define player-velocity (vec2 0.0 0.0)) @@ -412,7 +497,6 @@ ;; left, right, down, up, fire (define key-state (vector #f #f #f #f #f)) (define (update-player-velocity!) - ;; TODO: Normalize (match key-state (#(left? right? down? up? _) (set-vec2-x! player-velocity @@ -449,6 +533,10 @@ (define (draw-player-bullets) (draw-bullets player-bullets image:player-bullet 8.0 8.0)) + (define (draw-enemy-bullets) + ;;(draw-bullets enemy-bullets image:enemy-bullets 8.0 8.0) + #t) + (define (draw-player) (draw-image context image:player 0.0 0.0 player-width player-height @@ -466,7 +554,9 @@ (fill-rect context 0.0 0.0 game-width game-height) (draw-tiles level) (draw-player-bullets) + (draw-enemies enemies) (draw-player) + (draw-enemy-bullets) (request-animation-frame draw)) (define (on-key-down event) @@ -497,11 +587,31 @@ ((string-=? code "KeyZ") (set-firing! #f))))) + (define (out-of-bounds? x y w h) + (let ((padding 16.0)) + (not (rect-within? x y w h (- padding) (- padding) + (+ game-width padding) (+ game-height padding))))) + + (define (player-bullet-collide x y w h) + (let ((x* (- x (/ w 2.0))) + (y* (- y(/ h 2.0)))) + (or (out-of-bounds? x* y* w h) + (rect-collides-with-level? level x* y* w h) + (let ((enemy-id (find-enemy enemies x y w h))) + (and enemy-id + (begin + (damage-enemy! enemies enemy-id 1) + #t)))))) + + (define (enemy-collide x y w h hp) + hp) + (define dt (/ 1000.0 60.0)) (define (update) (vec2-add! player-position player-velocity) (vec2-clamp! player-position 0.0 0.0 game-width game-height) - (bullet-pool-update! player-bullets) + (bullet-pool-update! player-bullets player-bullet-collide) + (enemy-pool-update! enemies enemy-collide) (when (firing?) (set! *player-fire-counter* (modulo (+ *player-fire-counter* 1) player-fire-interval)) diff --git a/images/enemies.ase b/images/enemies.ase Binary files differnew file mode 100644 index 0000000..82c84ec --- /dev/null +++ b/images/enemies.ase diff --git a/images/enemies.png b/images/enemies.png Binary files differnew file mode 100644 index 0000000..ab4161d --- /dev/null +++ b/images/enemies.png @@ -10,6 +10,7 @@ <img id="image-player" src="images/player.png" /> <img id="image-player-bullet" src="images/player-bullet.png" /> <img id="image-map" src="images/map.png" /> + <img id="image-enemies" src="images/enemies.png" /> </div> </body> </html> |