diff options
| -rw-r--r-- | game.scm | 262 | ||||
| -rw-r--r-- | images/enemy-bullets.ase | bin | 0 -> 421 bytes | |||
| -rw-r--r-- | images/enemy-bullets.png | bin | 0 -> 126 bytes | |||
| -rw-r--r-- | index.html | 1 |
4 files changed, 171 insertions, 92 deletions
@@ -140,6 +140,11 @@ (ref.cast $bignum (local.get $x))))))))) x)) + (define s32-ref bytevector-s32-native-ref) + (define s32-set! bytevector-s32-native-set!) + (define f64-ref bytevector-ieee-double-native-ref) + (define f64-set! bytevector-ieee-double-native-set!) + (define pi (* 4.0 (atan 1.0))) (define pi/2 (/ pi 2.0)) (define tau (* pi 2.0)) @@ -155,13 +160,13 @@ (set-vec2-y! v y) v)) (define (vec2-x v) - (bytevector-ieee-double-native-ref v 0)) + (f64-ref v 0)) (define (vec2-y v) - (bytevector-ieee-double-native-ref v 8)) + (f64-ref v 8)) (define (set-vec2-x! v x) - (bytevector-ieee-double-native-set! v 0 x)) + (f64-set! v 0 x)) (define (set-vec2-y! v y) - (bytevector-ieee-double-native-set! v 8 y)) + (f64-set! v 8 y)) (define (vec2-add! v w) (set-vec2-x! v (+ (vec2-x v) (vec2-x w))) (set-vec2-y! v (+ (vec2-y v) (vec2-y w)))) @@ -181,19 +186,19 @@ (define (make-rect x y w h) (let ((r (make-bytevector (* 8 4)))) - (bytevector-ieee-double-native-set! r 0 x) - (bytevector-ieee-double-native-set! r 8 y) - (bytevector-ieee-double-native-set! r 16 w) - (bytevector-ieee-double-native-set! r 24 h) + (f64-set! r 0 x) + (f64-set! r 8 y) + (f64-set! r 16 w) + (f64-set! r 24 h) r)) (define (rect-x r) - (bytevector-ieee-double-native-ref r 0)) + (f64-ref r 0)) (define (rect-y r) - (bytevector-ieee-double-native-ref r 8)) + (f64-ref r 8)) (define (rect-w r) - (bytevector-ieee-double-native-ref r 16)) + (f64-ref r 16)) (define (rect-h r) - (bytevector-ieee-double-native-ref r 24)) + (f64-ref r 24)) (define (within? x y rx ry rw rh) (and (>= x rx) @@ -222,9 +227,50 @@ (define context (get-context canvas "2d")) (define image:player (get-element-by-id "image-player")) (define image:player-bullet (get-element-by-id "image-player-bullet")) + (define image:enemy-bullets (get-element-by-id "image-enemy-bullets")) (define image:map (get-element-by-id "image-map")) (define image:enemies (get-element-by-id "image-enemies")) + ;; Scripting + (define (make-scheduler max-tasks) + (vector 0 0 max-tasks (make-vector max-tasks))) + (define (scheduler-add! scheduler thunk delay) + (match scheduler + (#(ticks num-tasks max-tasks tasks) + (unless (= num-tasks max-tasks) + (vector-set! tasks num-tasks (cons (+ ticks delay) thunk)) + (vector-set! scheduler 1 (+ num-tasks 1)))))) + (define (scheduler-tick! scheduler) + (match scheduler + (#(ticks num-tasks max-tasks tasks) + (let ((t (+ ticks 1))) + (let loop ((i 0) (k num-tasks) (to-run '())) + (if (< i k) + (match (vector-ref tasks i) + ((t* . thunk) + (if (<= t* t) + (let ((k* (- k 1))) + (vector-set! tasks i (vector-ref tasks k*)) + (vector-set! tasks k* #f) + (loop i k* (cons thunk to-run))) + (loop (+ i 1) k to-run)))) + (begin + (vector-set! scheduler 0 t) + (vector-set! scheduler 1 k) + (for-each (lambda (thunk) (thunk)) to-run)))))))) + (define *scheduler* (make-scheduler 100)) + + (define %script-tag (make-prompt-tag 'script)) + (define (run-script thunk) + (define (run thunk) + (call-with-prompt %script-tag thunk handler)) + (define (handler k delay) + (scheduler-add! *scheduler* (lambda () (run k)) delay)) + (run thunk)) + (define (wait delay) + (abort-to-prompt %script-tag delay)) + + ;; Bullets: ;; per bullet: type, x, y, dx, dy (define %bullet-size (+ 4 8 8 8 8)) (define (make-bullet-pool capacity) @@ -236,11 +282,11 @@ (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) + (s32-set! bullets offset type) + (f64-set! bullets (+ offset 4) x) + (f64-set! bullets (+ offset 12) y) + (f64-set! bullets (+ offset 20) dx) + (f64-set! bullets (+ offset 28) dy) (vector-set! pool 0 (+ length 1)))))) (define (bullet-pool-remove! pool i) (match pool @@ -256,10 +302,10 @@ (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 (f64-ref bullets (+ offset 4))) + (y (f64-ref bullets (+ offset 12))) + (dx (f64-ref bullets (+ offset 20))) + (dy (f64-ref bullets (+ offset 28))) (x* (+ x dx)) (y* (+ y dy))) (cond @@ -268,8 +314,8 @@ (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*) + (f64-set! bullets (+ offset 4) x*) + (f64-set! bullets (+ offset 12) y*) (loop (+ i 1) k))))))))) (define (draw-bullets pool image w h) (match pool @@ -277,25 +323,28 @@ (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)))) + (type (s32-ref bullets offset)) + (x (f64-ref bullets (+ offset 4))) + (y (f64-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)) - - (define *scroll* game-width) + (define player-bullets (make-bullet-pool 200)) + (define enemy-bullets (make-bullet-pool 400)) - ;; Map: + ;; Scrolling level: + (define *scroll* 0.0) + (define *scroll-speed* 1.0) + (define (update-scroll!) + (set! *scroll* (+ *scroll* *scroll-speed*))) ;; sprite sheet offset, x, y (define %tile-size (+ 8 8 8)) (define tile-width 16.0) (define tile-height 16.0) + (define level-width 15) (define (make-level tiles) (let ((k (length tiles))) - (unless (= (modulo k 15) 0) + (unless (= (modulo k level-width) 0) (error "incomplete level data")) (let ((bv (make-bytevector (* k %tile-size)))) (let y-loop ((tiles tiles) (y 0)) @@ -304,7 +353,7 @@ (tiles (y-loop (let x-loop ((tiles tiles) (x 0)) - (if (< x 15) + (if (< x level-width) (match tiles ((t . rest) (let ((n (match t @@ -312,20 +361,25 @@ ('X 0.0) ('\ 1.0) ('/ 2.0))) - (offset (* (+ x (* y 15)) %tile-size))) - (bytevector-ieee-double-native-set! bv offset n) - (bytevector-ieee-double-native-set! bv (+ offset 8) - (* (inexact x) tile-width)) - (bytevector-ieee-double-native-set! bv (+ offset 16) - (* (inexact y) tile-height))) + (offset (* (+ x (* y level-width)) %tile-size))) + (f64-set! bv offset n) + (f64-set! bv (+ offset 8) + (* (inexact x) tile-width)) + (f64-set! bv (+ offset 16) + (* (inexact y) tile-height))) (x-loop rest (+ x 1)))) tiles)) (+ y 1))))) - (list 15 (/ k 15) bv)))) + (vector (/ k level-width) bv)))) (define-syntax-rule (define-level name tile ...) (define name (make-level '(tile ...)))) (define-level level X _ _ _ _ _ _ _ _ _ _ _ _ _ X + X X _ _ _ _ _ _ _ _ _ _ _ X X + X X X _ _ _ _ _ _ _ _ _ X X X + X X _ _ _ _ _ _ _ _ _ _ _ X X + X _ _ _ _ _ _ _ _ _ _ _ _ _ X + X _ _ _ _ _ _ _ _ _ _ _ _ _ X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X _ _ _ _ _ _ _ _ _ _ _ _ _ X @@ -346,48 +400,51 @@ X X \ _ _ _ _ _ _ _ _ _ / X X X X X X X X X X X X X X X X X) (define (level-offset x y) - (* (+ (* 15 y) x) %tile-size)) + (* (+ (* level-width y) x) %tile-size)) (define (point-collides-with-level? level x y) (match level - ((width height tiles) + (#(height tiles) (let ((tx (trunc (/ x tile-width))) (ty (trunc (/ y tile-height)))) - (and (>= tx 0) (< tx 15) + (and (>= tx 0) (< tx level-width) (>= ty 0) (< tx height) - (>= (bytevector-ieee-double-native-ref tiles (level-offset tx ty)) 0)))))) + (>= (f64-ref tiles (level-offset tx ty)) 0)))))) (define (rect-collides-with-level? level x y w h) (match level - ((width height tiles) - (let ((tx0 (trunc (/ x tile-width))) - (ty0 (trunc (/ y tile-height))) - (tx1 (trunc (/ (+ x w) tile-width))) - (ty1 (trunc (/ (+ y h) tile-height)))) + (#(height tiles) + (let* ((y (+ y (- (* height tile-height) game-height *scroll*))) + (tx0 (trunc (/ x tile-width))) + (ty0 (trunc (/ y tile-height))) + (tx1 (trunc (/ (+ x w) tile-width))) + (ty1 (trunc (/ (+ y h) tile-height)))) (define (occupied? x y) - (and (>= x 0) (< x 15) + (and (>= x 0) (< x level-width) (>= y 0) (< x height) - (>= (bytevector-ieee-double-native-ref tiles (level-offset x y)) 0))) + (>= (f64-ref tiles (level-offset x y)) 0.0))) (or (occupied? tx0 ty0) (occupied? tx1 ty0) (occupied? tx1 ty1) (occupied? tx0 ty1)))))) (define (draw-tiles level) (match level - ((width height tiles) + (#(height tiles) (let* ((tw tile-width) (th tile-height) - (y-end height) - (y-start (- y-end 20))) - (do ((y 0 (+ y 1))) - ((= y 20)) + (pixel-y-offset (- (* height th) *scroll* game-height)) + (scroll-y-offset (- height (trunc (/ *scroll* tile-height)))) + (y-start (clamp (- scroll-y-offset 21) 0 height)) + (y-end (clamp scroll-y-offset 0 height))) + (do ((y y-start (+ y 1))) + ((= y y-end)) (do ((x 0 (+ x 1))) - ((= x 15)) - (let* ((offset (* (+ (* 15 y) x) %tile-size)) - (t (bytevector-ieee-double-native-ref tiles offset)) - (tx (bytevector-ieee-double-native-ref tiles (+ offset 8))) - (ty (bytevector-ieee-double-native-ref tiles (+ offset 16)))) + ((= x level-width)) + (let* ((offset (* (+ (* level-width y) x) %tile-size)) + (t (f64-ref tiles offset)) + (tx (f64-ref tiles (+ offset 8))) + (ty (f64-ref tiles (+ offset 16)))) (draw-image context image:map (* t tw) 0.0 tw th - tx ty tw th)))))))) + tx (- ty pixel-y-offset) tw th)))))))) ;; Enemies: ;; length, capacity, pool @@ -403,14 +460,14 @@ (#(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) + (s32-set! enemies offset type) + (s32-set! enemies (+ offset 4) hp) + (f64-set! enemies (+ offset 8) x) + (f64-set! enemies (+ offset 16) y) + (f64-set! enemies (+ offset 24) w) + (f64-set! enemies (+ offset 32) h) + (f64-set! enemies (+ offset 40) dx) + (f64-set! enemies (+ offset 48) dy) (vector-set! pool 0 (+ length 1))))))) (define (enemy-pool-remove! pool i) (match pool @@ -427,13 +484,13 @@ (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))) + (hp (s32-ref enemies (+ offset 4))) + (x (f64-ref enemies (+ offset 8))) + (y (f64-ref enemies (+ offset 16))) + (w (f64-ref enemies (+ offset 24))) + (h (f64-ref enemies (+ offset 32))) + (dx (f64-ref enemies (+ offset 40))) + (dy (f64-ref enemies (+ offset 48))) (x* (+ x dx)) (y* (+ y dy))) (let ((new-hp (collide x y w h hp))) @@ -443,9 +500,9 @@ (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*) + (s32-set! enemies (+ offset 4) new-hp) + (f64-set! enemies (+ offset 8) x*) + (f64-set! enemies (+ offset 16) y*) (loop (+ i 1) k))))))))))) (define (draw-enemies pool) (match pool @@ -453,9 +510,9 @@ (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))) + (t (s32-ref enemies offset)) + (x (f64-ref enemies (+ offset 8))) + (y (f64-ref enemies (+ offset 16))) (w 64.0) (h 64.0)) (draw-image context image:enemies (* t w) (* t h) w h @@ -466,10 +523,10 @@ (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)))) + (x* (f64-ref enemies (+ offset 8))) + (y* (f64-ref enemies (+ offset 16))) + (w* (f64-ref enemies (+ offset 24))) + (h* (f64-ref enemies (+ offset 32)))) (if (rect-within? x y w h x* y* w* h*) i (loop (+ i 1))))))))) @@ -478,9 +535,8 @@ (#(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))))))) + (hp (s32-ref enemies (+ offset 4)))) + (s32-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) @@ -534,8 +590,7 @@ (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) + (draw-bullets enemy-bullets image:enemy-bullets 16.0 16.0)) (define (draw-player) (draw-image context image:player @@ -553,6 +608,7 @@ (set-fill-color! context demichrome0) (fill-rect context 0.0 0.0 game-width game-height) (draw-tiles level) + ;; (draw-tiles level 0.0) (draw-player-bullets) (draw-enemies enemies) (draw-player) @@ -603,14 +659,23 @@ (damage-enemy! enemies enemy-id 1) #t)))))) + (define (enemy-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)))) + (define (enemy-collide x y w h hp) hp) (define dt (/ 1000.0 60.0)) (define (update) + (scheduler-tick! *scheduler*) + (update-scroll!) (vec2-add! player-position player-velocity) (vec2-clamp! player-position 0.0 0.0 game-width game-height) (bullet-pool-update! player-bullets player-bullet-collide) + (bullet-pool-update! enemy-bullets enemy-bullet-collide) (enemy-pool-update! enemies enemy-collide) (when (firing?) (set! *player-fire-counter* @@ -628,6 +693,19 @@ (set! *player-fire-counter* 0))) (timeout update dt)) + ;; Temp hacky scripts + (run-script + (lambda () + (let ((ox 70.0) + (oy 100.0) + (speed 2.0)) + (let loop ((theta 0.0)) + (let ((dx (* (cos theta) speed)) + (dy (* (sin theta) speed))) + (bullet-pool-add! enemy-bullets 0 ox oy dx dy)) + (wait 2) + (loop (+ theta 0.2)))))) + (set-element-width! canvas (trunc canvas-width)) (set-element-height! canvas (trunc canvas-height)) (add-event-listener! (current-document) "keydown" on-key-down) diff --git a/images/enemy-bullets.ase b/images/enemy-bullets.ase Binary files differnew file mode 100644 index 0000000..d020498 --- /dev/null +++ b/images/enemy-bullets.ase diff --git a/images/enemy-bullets.png b/images/enemy-bullets.png Binary files differnew file mode 100644 index 0000000..c50da59 --- /dev/null +++ b/images/enemy-bullets.png @@ -9,6 +9,7 @@ <div style="display:none;"> <img id="image-player" src="images/player.png" /> <img id="image-player-bullet" src="images/player-bullet.png" /> + <img id="image-enemy-bullets" src="images/enemy-bullets.png" /> <img id="image-map" src="images/map.png" /> <img id="image-enemies" src="images/enemies.png" /> </div> |
