From 9cc06fcb9e4e2f57b4cfd132119cf1fb20afe6fc Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 23 Oct 2023 21:23:58 -0400
Subject: Resize canvas to fit window size, rewrite enemies.

---
 boot.js        |   9 ++
 game.css       |  11 ++
 game.scm       | 475 ++++++++++++++++++++++++++++++++++-----------------------
 index.html     |   5 +-
 web-server.scm |   4 +-
 5 files changed, 308 insertions(+), 196 deletions(-)
 create mode 100644 game.css

diff --git a/boot.js b/boot.js
index 0d88a1f..f834d62 100644
--- a/boot.js
+++ b/boot.js
@@ -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;
+}
diff --git a/game.scm b/game.scm
index 5a6f586..3eb10c5 100644
--- a/game.scm
+++ b/game.scm
@@ -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))
diff --git a/index.html b/index.html
index 162fc93..f0d59f1 100644
--- a/index.html
+++ b/index.html
@@ -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."
-- 
cgit v1.2.3