diff options
-rw-r--r-- | boot.js | 9 | ||||
-rw-r--r-- | game.css | 11 | ||||
-rw-r--r-- | game.scm | 475 | ||||
-rw-r--r-- | index.html | 5 | ||||
-rw-r--r-- | web-server.scm | 4 |
5 files changed, 308 insertions, 196 deletions
@@ -16,6 +16,15 @@ async function load() { const mod = await SchemeModule.fetch_and_instantiate("game.wasm", {}, { window: { + get() { + return window; + }, + innerWidth() { + return window.innerWidth; + }, + innerHeight() { + return window.innerHeight; + }, requestAnimationFrame(proc) { window.requestAnimationFrame(wrapProc(proc)); }, diff --git a/game.css b/game.css new file mode 100644 index 0000000..d729dc9 --- /dev/null +++ b/game.css @@ -0,0 +1,11 @@ +body { + background-color: #3f2832; + margin: 0; + width: 100vw; + height: 100vh; +} + +canvas { + display: block; + margin: 0 auto; +} @@ -1,5 +1,14 @@ (let () ;; Host imports + (define-foreign current-window + "window" "get" + -> (ref extern)) + (define-foreign window-inner-width + "window" "innerWidth" + (ref extern) -> i32) + (define-foreign window-inner-height + "window" "innerHeight" + (ref extern) -> i32) (define-foreign request-animation-frame "window" "requestAnimationFrame" (ref eq) -> none) @@ -102,11 +111,13 @@ "audio" "setVolume" (ref extern) f64 -> none) + ;; TODO: Add basic fmod as inline wasm function + ;; Hoot's exact and inexact aren't working right. These next two ;; procedures are alternatives for now. (define (trunc x) ;; rational? is also borked so can't use that here. - (unless (inexact? x) + (unless (and (number? x) (inexact? x)) (error "expected inexact rational" x)) (%inline-wasm '(func (param $x (ref eq)) (result (ref eq)) @@ -115,7 +126,7 @@ (struct.get $flonum $val (ref.cast $flonum (local.get $x)))))) x)) (define (inexact x) - (unless (and (exact? x) (integer? x)) + (unless (exact-integer? x) (error "expected exact integer" x)) (%inline-wasm '(func (param $x (ref eq)) (result (ref eq)) @@ -233,9 +244,6 @@ ;; Screen size stuff (define game-width 240.0) (define game-height 320.0) - (define canvas-scale 3.0) - (define canvas-width (* game-width canvas-scale)) - (define canvas-height (* game-height canvas-scale)) ;; Elements (define canvas (get-element-by-id "canvas")) @@ -252,6 +260,31 @@ (define sound:enemy-shoot (load-sound-effect "audio/enemy-shoot.wav")) (define sound:bullet-hit (load-sound-effect "audio/bullet-hit.wav")) + (define-syntax-rule (define-type name + constructor + predicate + (field getter setter) ...) + (begin + (define (constructor field ...) + (vector 'name field ...)) + (define (predicate obj) + (match obj + (#('name field ...) #t) + (_ #f))) + (define (getter obj) + (match obj + (#('name field ...) + field))) + ... + (define setter + (let ((i (1+ (- (length '(field ...)) + (length (memq 'field '(field ...))))))) + (lambda (obj val) + (match obj + (#('name field ...) + (vector-set! obj i val)))))) + ...)) + ;; Scripting (define (make-scheduler max-tasks) (vector 0 0 max-tasks (make-vector max-tasks))) @@ -292,27 +325,42 @@ (vector-set! tasks i #f))))) (define *scheduler* (make-scheduler 100)) (define %script-tag (make-prompt-tag "script")) - (define (run-script thunk) - (define script (vector #f)) - (define (cancelled?) - (vector-ref script 0)) + (define-type script + %make-script + script? + (state script-state set-script-state!) + (cont script-cont set-script-cont!)) + (define (make-script thunk) + (%make-script 'pending thunk)) + (define (script-pending? script) + (eq? (script-state script) 'pending)) + (define (script-running? script) + (eq? (script-state script) 'running)) + (define (script-cancelled? script) + (eq? (script-state script) 'cancelled)) + (define (script-cancel! script) + (set-script-state! script 'cancelled)) + (define (script-run! script) (define (run thunk) - (unless (cancelled?) + (unless (script-cancelled? script) (call-with-prompt %script-tag thunk handler))) (define (handler k delay) (when delay (scheduler-add! *scheduler* (lambda () (run k)) delay))) - (run - (lambda () - (thunk) - ;; Nasty hack: For some reason, falling through the prompt - ;; thunk messes up the Scheme stack, resulting in an invalid - ;; ref.cast somewhere. So, we *never* fall through. Instead, - ;; we create a continuation that gets thrown away. - (abort-to-prompt %script-tag #f))) - script) - (define (cancel! script) - (vector-set! script 0 #t)) + (when (script-pending? script) + (run + (lambda () + (set-script-state! script 'running) + ((script-cont script)) + ;; Nasty hack: For some reason, falling through the prompt + ;; thunk messes up the Scheme stack, resulting in an invalid + ;; ref.cast somewhere. So, we *never* fall through. Instead, + ;; we create a continuation that gets thrown away. + (abort-to-prompt %script-tag #f))))) + (define (run-script thunk) + (let ((script (make-script thunk))) + (script-run! script) + script)) (define (wait delay) (abort-to-prompt %script-tag delay)) @@ -385,10 +433,9 @@ ;; Scrolling level: (define *scroll* 0.0) (define *scroll-speed* 0.5) - (define (update-scroll!) - (set! *scroll* (+ *scroll* *scroll-speed*))) - ;; sprite sheet offset, x, y - (define %tile-size (+ 8 8 8)) + (define *last-row-scanned* 0) + ;; action id, sprite sheet offset, x, y + (define %tile-size (+ 4 8 8 8)) (define tile-width 16.0) (define tile-height 16.0) (define level-width 15) @@ -407,20 +454,27 @@ (match tiles ((t . rest) (let ((n (match t - ('_ -1.0) ('X 0.0) ('\ 1.0) - ('/ 2.0))) + ('/ 2.0) + (_ -1.0))) + (action (match t + ('A 1) + (_ 0))) (offset (* (+ x (* y level-width)) %tile-size))) - (f64-set! bv offset n) - (f64-set! bv (+ offset 8) + (s32-set! bv offset action) + (f64-set! bv (+ offset 4) n) + (f64-set! bv (+ offset 12) (* (inexact x) tile-width)) - (f64-set! bv (+ offset 16) + (f64-set! bv (+ offset 20) (* (inexact y) tile-height))) (x-loop rest (+ x 1)))) tiles)) (+ y 1))))) (vector (/ k level-width) bv)))) + (define (level-height level) + (match level + (#(height tiles) height))) (define-syntax-rule (define-level name tile ...) (define name (make-level '(tile ...)))) (define-level level @@ -438,23 +492,23 @@ X X _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ X X - X X X _ _ _ _ _ _ _ _ _ X X X + X X X A _ _ _ _ _ _ _ _ X X X X X _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ X X - X X X _ _ _ _ _ _ _ _ _ X X X + X X X _ _ _ _ _ _ _ _ A X X X X X _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ X X - X X X _ _ _ _ _ _ _ _ _ X X X + X X X A _ _ _ _ _ _ _ _ X X X X X _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ X X - X X X _ _ _ _ _ _ _ _ _ X X X + X X X _ _ _ _ _ _ _ _ A X X X X X _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ X X - X X X _ _ _ _ _ _ _ _ _ X X X + X X X A _ _ _ _ _ _ _ _ X X X X X _ _ _ _ _ _ _ _ _ _ _ X X X _ _ _ _ _ _ _ _ _ _ _ _ _ X X _ _ _ _ _ _ _ _ _ _ _ _ _ X @@ -498,7 +552,7 @@ (define (occupied? x y) (and (>= x 0) (< x level-width) (>= y 0) (< x height) - (>= (f64-ref tiles (level-offset x y)) 0.0))) + (>= (f64-ref tiles (+ (level-offset x y) 4)) 0.0))) (or (occupied? tx0 ty0) (occupied? tx1 ty0) (occupied? tx1 ty1) @@ -516,174 +570,189 @@ ((= y y-end)) (do ((x 0 (+ x 1))) ((= 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)))) + (let* ((offset (level-offset x y)) + (t (f64-ref tiles (+ offset 4))) + (tx (f64-ref tiles (+ offset 12))) + (ty (f64-ref tiles (+ offset 20)))) (draw-image context image:map (* t tw) 0.0 tw th tx (- ty pixel-y-offset) tw th)))))))) - - ;; Enemy pool: - ;; length, capacity, enemies, scripts - ;; enemy: type, health, x, y, w, h, dx, dy - (define %enemy-size (+ 4 4 8 8 8 8 8 8)) + (define max-scroll (- (* (vector-ref level 0) tile-height) game-height)) + (define (level-update! level) + (match level + (#(height tiles) + (let ((scroll (min (+ *scroll* *scroll-speed*) max-scroll))) + (set! *scroll* scroll) + (let ((row (max (- (trunc + (/ (- (* height tile-height) + game-height scroll) + tile-height)) 2) + 0))) + (do ((y row (+ y 1))) + ((= y *last-row-scanned*)) + (do ((x 0 (+ x 1))) + ((= x level-width)) + (case (s32-ref tiles (level-offset x y)) + ((0) + #t) + ((1) + (spawn-enemy-a (* x tile-width) (* (- row y) tile-height)))))) + (set! *last-row-scanned* row)))))) + + ;; Enemies + (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!)) + (define (enemy-x enemy) + (vec2-x (enemy-position enemy))) + (define (enemy-y enemy) + (vec2-y (enemy-position enemy))) + (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 (enemy-damage! enemy damage) + (match enemy + (#('enemy type health position size velocity script) + (set-enemy-health! enemy (- health damage))))) + (define (enemy-dead? enemy) + (<= (enemy-health enemy) 0)) + (define (enemy-out-of-bounds? enemy) + (match enemy + (#('enemy type health position size velocity script) + (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 type health position size velocity script) + (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) + (match enemy + (#('enemy type health position size velocity script) + (set-vec2-x! position (+ (vec2-x position) (vec2-x velocity))) + (set-vec2-y! position (+ (vec2-y position) (vec2-y velocity)))))) + (define (enemy-draw enemy) + (match enemy + (#('enemy type health position size velocity script) + (let* ((t 0.0) + (x (vec2-x position)) + (y (vec2-y position)) + (hbw (vec2-x size)) + (hbh (vec2-y size)) + (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) + (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) - (let ((enemies (make-bytevector (* capacity %enemy-size)))) - (vector 0 capacity enemies (make-vector capacity)))) - (define (enemy-pool-offset i) - (* i %enemy-size)) - (define (enemy-pool-add! pool type hp x y w h dx dy script) + (%make-enemy-pool 0 capacity (make-vector capacity #f))) + (define (enemy-pool-add! pool enemy) (match pool - (#(length capacity enemies scripts) + (#('enemy-pool length capacity enemies) (unless (= length capacity) - (let ((offset (enemy-pool-offset length))) - (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! scripts length - (and script - (run-script - (lambda () - (script length))))) - (vector-set! pool 0 (+ length 1))))))) + (vector-set! enemies length enemy) + (set-enemy-pool-length! pool (+ length 1)) + (enemy-start! enemy))))) (define (enemy-pool-remove! pool i) (match pool - (#(length capacity enemies scripts) + (#('enemy-pool length capacity enemies) (when (and (>= i 0) (< i length)) - (let* ((j (- length 1)) - (at (enemy-pool-offset i)) - (start (enemy-pool-offset j))) - (bytevector-copy! enemies at enemies start (+ start %enemy-size)) - (let ((script (vector-ref scripts i))) - (and script (cancel! script))) - (vector-set! scripts i (vector-ref scripts j)) - (vector-set! scripts j #f) - (vector-set! pool 0 j)))))) - (define (enemy-x pool i) - (match pool - (#(length capacity enemies scripts) - (let ((offset (enemy-pool-offset i))) - (f64-ref enemies (+ offset 8)))))) - (define (enemy-y pool i) - (match pool - (#(length capacity enemies scripts) - (let ((offset (enemy-pool-offset i))) - (f64-ref enemies (+ offset 16)))))) - (define (enemy-dx pool i) - (match pool - (#(length capacity enemies scripts) - (let ((offset (enemy-pool-offset i))) - (f64-ref enemies (+ offset 40)))))) - (define (enemy-dy pool i) - (match pool - (#(length capacity enemies scripts) - (let ((offset (enemy-pool-offset i))) - (f64-ref enemies (+ offset 48)))))) - (define (set-enemy-velocity! pool i dx dy) - (match pool - (#(length capacity enemies scripts) - (let ((offset (enemy-pool-offset i))) - (f64-set! enemies (+ offset 40) dx) - (f64-set! enemies (+ offset 48) dy))))) + (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 - (#(length capacity enemies scripts) + (#('enemy-pool length capacity enemies) (do ((i 0 (+ i 1))) ((= i length)) - (let ((script (vector-ref scripts i))) - (and script (cancel! script)) - (vector-set! scripts i #f))) - (vector-set! pool 0 0)))) + (enemy-stop! (vector-ref enemies i)) + (vector-set! enemies i #f)) + (set-enemy-pool-length! pool 0)))) (define (enemy-pool-update! pool collide) (match pool - (#(length capacity enemies scripts) + (#('enemy-pool length capacity enemies) (let ((padding 16.0)) (let loop ((i 0) (k length)) (unless (= i k) - (let* ((offset (enemy-pool-offset i)) - (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))) - (cond - ((or (<= hp 0) - (out-of-bounds? x* y* w h)) - (sound-effect-play sound:explosion) - (enemy-pool-remove! pool i) - (loop i (- k 1))) - (else - (s32-set! enemies (+ offset 4) new-hp) - (f64-set! enemies (+ offset 8) x*) - (f64-set! enemies (+ offset 16) y*) - (loop (+ i 1) k))))))))))) + (let ((enemy (vector-ref enemies i))) + (enemy-update! enemy) + (cond + ((or (enemy-dead? enemy) + (enemy-out-of-bounds? enemy)) + (sound-effect-play sound:explosion) + (enemy-pool-remove! pool i) + (loop i (- k 1))) + (else + (loop (+ i 1) k)))))))))) (define (draw-enemies pool) (match pool - (#(length capacity enemies scripts) + (#('enemy-pool length capacity enemies) (do ((i 0 (+ i 1))) ((= i length)) - (let* ((offset (enemy-pool-offset i)) - (t (s32-ref enemies offset)) - (x (f64-ref enemies (+ offset 8))) - (y (f64-ref enemies (+ offset 16))) - (hbw (f64-ref enemies (+ offset 24))) - (hbh (f64-ref enemies (+ offset 32))) - (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) - (set-fill-color! context "#ff00ff80") - (fill-rect context - (- x (/ hbw 2.0)) - (- y (/ hbh 2.0)) - hbw hbh)))))) + (enemy-draw (vector-ref enemies i)))))) (define (find-enemy pool x y w h) (match pool - (#(length capacity enemies scripts) + (#('enemy-pool length capacity enemies) (let loop ((i 0)) (and (< i length) - (let* ((offset (enemy-pool-offset i)) - (w* (f64-ref enemies (+ offset 24))) - (h* (f64-ref enemies (+ offset 32))) - (x* (- (f64-ref enemies (+ offset 8)) - (/ w* 2.0))) - (y* (- (f64-ref enemies (+ offset 16)) - (/ h* 2.0)))) - (if (rect-within? x y w h x* y* w* h*) - i + (let ((enemy (vector-ref enemies i))) + (if (enemy-within-rect? enemy x y w h) + enemy (loop (+ i 1))))))))) - (define (damage-enemy! pool i damage) - (match pool - (#(length capacity enemies scripts) - (when (and (>= i 0) (< i length)) - (let* ((offset (enemy-pool-offset i)) - (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 - (lambda (id) - (let ((speed 2.0)) - (let loop ((theta 0.0)) - (let ((dx (* (cos theta) speed)) - (dy (* (sin theta) speed))) - (bullet-pool-add! enemy-bullets 0 - (enemy-x enemies id) - (enemy-y enemies id) - dx dy)) - (wait 2) - (loop (+ theta 0.2)))))) + + (define (spawn-enemy-a x y) + (define (script enemy) + (let ((speed 2.0)) + (let loop ((theta 0.0)) + (let ((dx (* (cos theta) speed)) + (dy (* (sin theta) speed))) + (bullet-pool-add! enemy-bullets 0 + (enemy-x enemy) + (enemy-y enemy) + dx dy)) + (wait 2) + (loop (+ theta 0.2))))) + (let ((enemy (make-enemy 'foo 20 (vec2 x y) (vec2 16.0 16.0) + (vec2 0.0 1.0) script))) + (enemy-pool-add! enemies enemy))) ;; Player state: (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0))) @@ -797,8 +866,28 @@ player-hitbox-width player-hitbox-height)) + (define *canvas-scale* 0.0) + (define *canvas-width* 0) + (define *canvas-height* 0) + + (define (resize-canvas) + (let* ((win (current-window)) + (w (window-inner-width win)) + (h (window-inner-height win)) + (gw (trunc game-width)) + (gh (trunc game-height)) + (scale (max (min (quotient w gw) (quotient h gh)) 1)) + (cw (* gw scale)) + (ch (* gh scale))) + (set-element-width! canvas cw) + (set-element-height! canvas ch) + (set-image-smoothing-enabled! context 0) + (set! *canvas-scale* (inexact scale)) + (set! *canvas-width* (* game-width *canvas-scale*)) + (set! *canvas-height* (* game-height *canvas-scale*)))) + (define (clear-screen) - (clear-rect context 0.0 0.0 canvas-width canvas-height)) + (clear-rect context 0.0 0.0 *canvas-width* *canvas-height*)) (define (draw-player-bullets) (draw-bullets player-bullets image:player-bullet 8.0 8.0)) @@ -815,18 +904,16 @@ ;; Top (draw-image context image:background 0.0 (- game-height scroll) game-width scroll - 0.0 0.0 game-width scroll) - )) + 0.0 0.0 game-width scroll))) (define (draw time) (clear-screen) (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0) - (set-scale! context canvas-scale canvas-scale) + (set-scale! context *canvas-scale* *canvas-scale*) (set-fill-color! context "#3f2832") (fill-rect context 0.0 0.0 game-width game-height) (draw-background image:background 0.75) (draw-tiles level) - ;; (draw-tiles level 0.0) (draw-player-bullets) (draw-enemies enemies) (draw-player) @@ -836,6 +923,7 @@ (define (reset!) (scheduler-reset! *scheduler*) (set! *scroll* 0.0) + (set! *last-row-scanned* (level-height level)) (bullet-pool-reset! player-bullets) (bullet-pool-reset! enemy-bullets) (enemy-pool-reset! enemies) @@ -877,7 +965,7 @@ (set-firing! #f))))) (define (out-of-bounds? x y w h) - (let ((padding 16.0)) + (let ((padding 32.0)) (not (rect-within? x y w h (- padding) (- padding) (+ game-width padding) (+ game-height padding))))) @@ -886,21 +974,22 @@ (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 + (let ((enemy (find-enemy enemies x y w h))) + (and enemy (begin - (damage-enemy! enemies enemy-id 1) + (enemy-damage! enemy 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) - (if (rect-collides-with-level? level x* y* w h) - (begin - (sound-effect-play sound:bullet-hit 0.1) - #t) - #f) + (rect-collides-with-level? level x* y* w h) + ;; (if (rect-collides-with-level? level x* y* w h) + ;; (begin + ;; (sound-effect-play sound:bullet-hit 0.1) + ;; #t) + ;; #f) (if (rect-within? x y w h (vec2-x player-hitbox-position) (vec2-y player-hitbox-position) @@ -917,17 +1006,17 @@ (define dt (/ 1000.0 60.0)) (define (update) (scheduler-tick! *scheduler*) - (update-scroll!) + (level-update! level) (player-update!) (bullet-pool-update! player-bullets player-bullet-collide) (bullet-pool-update! enemy-bullets enemy-bullet-collide) (enemy-pool-update! enemies enemy-collide) (timeout update dt)) - (set-element-width! canvas (trunc canvas-width)) - (set-element-height! canvas (trunc canvas-height)) + (add-event-listener! (current-window) "resize" (lambda (_) (resize-canvas))) (add-event-listener! (current-document) "keydown" on-key-down) (add-event-listener! (current-document) "keyup" on-key-up) - (set-image-smoothing-enabled! context 0) + (resize-canvas) + (reset!) (request-animation-frame draw) (timeout update dt)) @@ -1,8 +1,9 @@ <!DOCTYPE html> <html> <head> - <script type="text/javascript" src="/js-runtime/reflect.js"></script> - <script type="text/javascript" src="/boot.js"></script> + <script type="text/javascript" src="js-runtime/reflect.js"></script> + <script type="text/javascript" src="boot.js"></script> + <link rel="stylesheet" href="game.css" /> </head> <body> <canvas id="canvas"></canvas> diff --git a/web-server.scm b/web-server.scm index 86015dc..86a6902 100644 --- a/web-server.scm +++ b/web-server.scm @@ -18,8 +18,10 @@ (alist->hash-table '(("js" . application/javascript) ("html" . text/html) + ("css" . text/css) ("wasm" . application/wasm) - ("png" . image/png)))) + ("png" . image/png) + ("wav" . audio/wav)))) (define (file-extension file) "Return the extension of FILE or #f if there is none." |