Day 1 progress.

17 files changed, 1372 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..907c4d7
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+/game.wasm
diff --git a/boot.js b/boot.js
new file mode 100644
index 0000000..161a4d9
--- /dev/null
+++ b/boot.js
@@ -0,0 +1,103 @@
+async function load() {
+  const procMap = new WeakMap();
+
+  function wrapProc(obj) {
+    function makeWrapper() {
+      const proc = scheme.to_js(obj);
+      function wrapper (...args) {
+        return proc.call(...args);
+      }
+      procMap.set(obj, wrapper);
+      return wrapper;
+    }
+
+    return procMap.get(obj) || makeWrapper();
+  }
+
+  const mod = await SchemeModule.fetch_and_instantiate("game.wasm", {}, {
+    window: {
+      requestAnimationFrame(proc) {
+        window.requestAnimationFrame(wrapProc(proc));
+      },
+      setTimeout(proc, delay) {
+        window.setTimeout(wrapProc(proc), delay);
+      }
+    },
+    document: {
+      get() { return document; },
+      body() { return document.body; },
+      getElementById: Document.prototype.getElementById.bind(document),
+      createTextNode: Document.prototype.createTextNode.bind(document),
+      createElement: Document.prototype.createElement.bind(document)
+    },
+    element: {
+      value(elem) {
+        return elem.value;
+      },
+      setValue(elem, value) {
+        elem.value = value;
+      },
+      setWidth(elem, width) {
+        elem.width = width;
+      },
+      setHeight(elem, height) {
+        elem.height = height;
+      },
+      appendChild(parent, child) {
+        return parent.appendChild(child);
+      },
+      setAttribute(elem, name, value) {
+        elem.setAttribute(name, value);
+      },
+      removeAttribute(elem, name) {
+        elem.removeAttribute(name);
+      },
+      remove(elem) {
+        elem.remove();
+      },
+      replaceWith(oldElem, newElem) {
+        oldElem.replaceWith(newElem);
+      },
+      addEventListener(elem, name, proc) {
+        elem.addEventListener(name, wrapProc(proc));
+      },
+      removeEventListener(elem, name, proc) {
+        elem.removeEventListener(name, wrapProc(proc));
+      }
+    },
+    event: {
+      keyboardCode(event) {
+        return event.code;
+      }
+    },
+    canvas: {
+      getContext(elem, type) {
+        return elem.getContext(type);
+      },
+      setFillColor(context, color) {
+        context.fillStyle = color;
+      },
+      clearRect(context, x, y, w, h) {
+        context.clearRect(x, y, w, h);
+      },
+      fillRect(context, x, y, w, h) {
+        context.fillRect(x, y, w, h);
+      },
+      drawImage(context, image, sx, sy, sWidth, sHeight, dx, dy, dWidth, dHeight) {
+        context.drawImage(image, sx, sy, sWidth, sHeight, dx, dy, dWidth, dHeight);
+      },
+      setScale(context, sx, sy) {
+        context.scale(sx, sy);
+      },
+      setTransform(context, a, b, c, d, e, f) {
+        context.setTransform(a, b, c, d, e, f);
+      },
+      setImageSmoothingEnabled(context, enabled) {
+        context.imageSmoothingEnabled = (enabled == 1);
+      }
+    }
+  });
+  const scheme = await mod.reflect();
+  scheme.init_module(mod);
+}
+window.addEventListener("load", load);
diff --git a/game.scm b/game.scm
new file mode 100644
index 0000000..d84cdfa
--- /dev/null
+++ b/game.scm
@@ -0,0 +1,527 @@
+(let ()
+  (define-foreign request-animation-frame
+    "window" "requestAnimationFrame"
+    (ref eq) -> none)
+
+  (define-foreign timeout
+    "window" "setTimeout"
+    (ref eq) f64 -> i32)
+
+  (define-foreign current-document
+    "document" "get"
+    -> (ref extern))
+
+  (define-foreign document-body
+    "document" "body"
+    -> (ref extern))
+
+  (define-foreign get-element-by-id
+    "document" "getElementById"
+    (ref string) -> (ref null extern))
+
+  (define-foreign make-text-node
+    "document" "createTextNode"
+    (ref string) -> (ref extern))
+
+  (define-foreign make-element
+    "document" "createElement"
+    (ref string) -> (ref extern))
+
+  (define-foreign element-value
+    "element" "value"
+    (ref extern) -> (ref string))
+
+  (define-foreign set-element-value!
+    "element" "setValue"
+    (ref extern) (ref string) -> none)
+
+  (define-foreign set-element-width!
+    "element" "setWidth"
+    (ref extern) i32 -> none)
+
+  (define-foreign set-element-height!
+    "element" "setHeight"
+    (ref extern) i32 -> none)
+
+  (define-foreign append-child!
+    "element" "appendChild"
+    (ref extern) (ref extern) -> (ref extern))
+
+  (define-foreign remove!
+    "element" "remove"
+    (ref extern) -> none)
+
+  (define-foreign replace-with!
+    "element" "replaceWith"
+    (ref extern) (ref extern) -> none)
+
+  (define-foreign set-attribute!
+    "element" "setAttribute"
+    (ref extern) (ref string) (ref string) -> none)
+
+  (define-foreign remove-attribute!
+    "element" "removeAttribute"
+    (ref extern) (ref string) -> none)
+
+  (define-foreign add-event-listener!
+    "element" "addEventListener"
+    (ref extern) (ref string) (ref eq) -> none)
+
+  (define-foreign remove-event-listener!
+    "element" "removeEventListener"
+    (ref extern) (ref string) (ref eq) -> none)
+
+  (define-foreign keyboard-event-code
+    "event" "keyboardCode"
+    (ref extern) -> (ref string))
+
+  (define-foreign get-context
+    "canvas" "getContext"
+    (ref extern) (ref string) -> (ref extern))
+
+  (define-foreign set-fill-color!
+    "canvas" "setFillColor"
+    (ref extern) (ref string) -> none)
+
+  (define-foreign clear-rect
+    "canvas" "clearRect"
+    (ref extern) f64 f64 f64 f64 -> none)
+
+  (define-foreign fill-rect
+    "canvas" "fillRect"
+    (ref extern) f64 f64 f64 f64 -> none)
+
+  (define-foreign draw-image
+    "canvas" "drawImage"
+    (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
+
+  (define-foreign set-scale!
+    "canvas" "setScale"
+    (ref extern) f64 f64 -> none)
+
+  (define-foreign set-transform!
+    "canvas" "setTransform"
+    (ref extern) f64 f64 f64 f64 f64 f64 -> none)
+
+  (define-foreign set-image-smoothing-enabled!
+    "canvas" "setImageSmoothingEnabled"
+    (ref extern) i32 -> none)
+
+  ;; 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)
+      (error "expected inexact rational" x))
+    (%inline-wasm
+     '(func (param $x (ref eq)) (result (ref eq))
+            (call $s64->scm
+                  (i64.trunc_f64_s
+                   (struct.get $flonum $val (ref.cast $flonum (local.get $x))))))
+     x))
+  (define (inexact x)
+    (unless (and (exact? x) (integer? x))
+      (error "expected exact integer" x))
+    (%inline-wasm
+     '(func (param $x (ref eq)) (result (ref eq))
+            (if (ref eq)
+                (call $fixnum? (local.get $x))
+                (then
+                 (struct.new $flonum
+                             (i32.const 0)
+                             (f64.convert_i32_s
+                              (call $fixnum->i32 (ref.cast i31 (local.get $x))))))
+                (else
+                 (struct.new $flonum
+                             (i32.const 0)
+                             (f64.convert_i64_s
+                              (call $bignum-get-i64
+                                    (struct.get $bignum $val
+                                                (ref.cast $bignum (local.get $x)))))))))
+     x))
+
+  (define pi (* 4.0 (atan 1.0)))
+  (define pi/2 (/ pi 2.0))
+  (define tau (* pi 2.0))
+
+  (define (clamp x min max)
+    (cond ((< x min) min)
+          ((> x max) max)
+          (else x)))
+
+  (define (vec2 x y)
+    (let ((v (make-bytevector 16)))
+      (set-vec2-x! v x)
+      (set-vec2-y! v y)
+      v))
+  (define (vec2-x v)
+    (bytevector-ieee-double-native-ref v 0))
+  (define (vec2-y v)
+    (bytevector-ieee-double-native-ref v 8))
+  (define (set-vec2-x! v x)
+    (bytevector-ieee-double-native-set! v 0 x))
+  (define (set-vec2-y! v y)
+    (bytevector-ieee-double-native-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))))
+  (define (vec2-mul-scalar! v x)
+    (set-vec2-x! v (* (vec2-x v) x))
+    (set-vec2-y! v (* (vec2-y v) x)))
+  (define (vec2-magnitude v)
+    (sqrt (+ (* (vec2-x v) (vec2-x v)) (* (vec2-y v) (vec2-y v)))))
+  (define (vec2-normalize! v)
+    (unless (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
+      (let ((m (vec2-magnitude v)))
+        (set-vec2-x! v (/ (vec2-x v) m))
+        (set-vec2-y! v (/ (vec2-y v) m)))))
+  (define (vec2-clamp! v xmin ymin xmax ymax)
+    (set-vec2-x! v (clamp (vec2-x v) xmin xmax))
+    (set-vec2-y! v (clamp (vec2-y v) ymin ymax)))
+
+  (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)
+      r))
+  (define (rect-x r)
+    (bytevector-ieee-double-native-ref r 0))
+  (define (rect-y r)
+    (bytevector-ieee-double-native-ref r 8))
+  (define (rect-w r)
+    (bytevector-ieee-double-native-ref r 16))
+  (define (rect-h r)
+    (bytevector-ieee-double-native-ref r 24))
+
+  (define (within? x y rx ry rw rh)
+    (and (>= x rx)
+         (>= 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 demichrome0 "#211e20")
+  (define demichrome1 "#555568")
+  (define demichrome2 "#a0a08b")
+  (define demichrome3 "#e9efec")
+
+  (define game-width 240.0)
+  (define game-height 320.0)
+  (define canvas-scale 2.0)
+  (define canvas-width (* game-width canvas-scale))
+  (define canvas-height (* game-height canvas-scale))
+  (define canvas (get-element-by-id "canvas"))
+  (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:map (get-element-by-id "image-map"))
+
+  ;; 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 (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))
+  (define (bullet-pool-offset i)
+    (+ %bullet-pool-header-size (* i %bullet-pool-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))))
+  (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)))))))
+  (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)))))
+
+  (define player-bullets (make-bullet-pool 100))
+  (define enemy-bullets (make-bullet-pool 200))
+
+  (define *scroll* game-width)
+
+  ;; Map:
+  ;; sprite sheet offset, x, y
+  (define %tile-size (+ 8 8 8))
+  (define tile-width 16.0)
+  (define tile-height 16.0)
+  (define (make-level tiles)
+    (let ((k (length tiles)))
+      (unless (= (modulo k 15) 0)
+        (error "incomplete level data"))
+      (let ((bv (make-bytevector (* k %tile-size))))
+        (let y-loop ((tiles tiles) (y 0))
+          (match tiles
+            (() #t)
+            (tiles
+             (y-loop
+              (let x-loop ((tiles tiles) (x 0))
+                (if (< x 15)
+                    (match tiles
+                      ((t . rest)
+                       (let ((n (match t
+                                  ('_ -1.0)
+                                  ('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)))
+                       (x-loop rest (+ x 1))))
+                    tiles))
+              (+ y 1)))))
+        (list 15 (/ k 15) 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 _ _ _ _ _ _ _ _ _ _ _ _ _ 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 X X X X X X X X X X X X)
+  (define (level-offset x y)
+    (* (+ (* 15 y) x) %tile-size))
+  (define (point-collides-with-level? level x y)
+    (match level
+      ((width height tiles)
+       (let ((tx (trunc (/ x tile-width)))
+             (ty (trunc (/ y tile-height))))
+         (and (>= tx 0) (< tx 15)
+              (>= ty 0) (< tx height)
+              (>= (bytevector-ieee-double-native-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))))
+         (define (occupied? x y)
+           (and (>= x 0) (< x 15)
+                (>= y 0) (< x height)
+                (>= (bytevector-ieee-double-native-ref tiles (level-offset x y)) 0)))
+         (or (occupied? tx0 ty0)
+             (occupied? tx1 ty0)
+             (occupied? tx1 ty1)
+             (occupied? tx0 ty1))))))
+  (define (draw-tiles level)
+    (match level
+      ((width height tiles)
+       (let* ((tw tile-width)
+              (th tile-height)
+              (y-end height)
+              (y-start (- y-end 20)))
+         (do ((y 0 (+ y 1)))
+             ((= y 20))
+           (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))))
+               (draw-image context image:map
+                           (* t tw) 0.0 tw th
+                           tx ty tw th))))))))
+
+  ;; Player state:
+  (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0)))
+  (define player-velocity (vec2 0.0 0.0))
+  (define player-speed 4.0)
+  (define player-bullet-speed 12.0)
+  (define player-width 24.0)
+  (define player-height 24.0)
+  (define *player-fire-counter* 0)
+  (define player-fire-interval 3)
+  ;; 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
+                    (+ (if left? -1.0 0.0)
+                       (if right? 1.0 0.0)))
+       (set-vec2-y! player-velocity
+                    (+ (if down? 1.0 0.0)
+                       (if up? -1.0 0.0)))
+       (vec2-normalize! player-velocity)
+       (vec2-mul-scalar! player-velocity player-speed))))
+  (define (set-left! pressed?)
+    (vector-set! key-state 0 pressed?)
+    (update-player-velocity!))
+  (define (set-right! pressed?)
+    (vector-set! key-state 1 pressed?)
+    (update-player-velocity!))
+  (define (set-down! pressed?)
+    (vector-set! key-state 2 pressed?)
+    (update-player-velocity!))
+  (define (set-up! pressed?)
+    (vector-set! key-state 3 pressed?)
+    (update-player-velocity!))
+  (define (set-firing! pressed?)
+    (let ((was-firing? (firing?)))
+      (vector-set! key-state 4 pressed?)
+      (when (and pressed? (not was-firing?))
+        (set! *player-fire-counter* 0))))
+  (define (firing?)
+    (vector-ref key-state 4))
+
+  (define (clear-screen)
+    (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))
+
+  (define (draw-player)
+    (draw-image context image:player
+                0.0 0.0 player-width player-height
+                (- (vec2-x player-position)
+                   (/ player-width 2.0))
+                (- (vec2-y player-position)
+                   (/ player-height 2.0))
+                player-width player-height))
+
+  (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-fill-color! context demichrome0)
+    (fill-rect context 0.0 0.0 game-width game-height)
+    (draw-tiles level)
+    (draw-player-bullets)
+    (draw-player)
+    (request-animation-frame draw))
+
+  (define (on-key-down event)
+    (let ((code (keyboard-event-code event)))
+      (cond
+       ((string-=? code "ArrowLeft")
+        (set-left! #t))
+       ((string-=? code "ArrowRight")
+        (set-right! #t))
+       ((string-=? code "ArrowDown")
+        (set-down! #t))
+       ((string-=? code "ArrowUp")
+        (set-up! #t))
+       ((string-=? code "KeyZ")
+        (set-firing! #t)))))
+
+  (define (on-key-up event)
+    (let ((code (keyboard-event-code event)))
+      (cond
+       ((string-=? code "ArrowLeft")
+        (set-left! #f))
+       ((string-=? code "ArrowRight")
+        (set-right! #f))
+       ((string-=? code "ArrowDown")
+        (set-down! #f))
+       ((string-=? code "ArrowUp")
+        (set-up! #f))
+       ((string-=? code "KeyZ")
+        (set-firing! #f)))))
+
+  (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)
+    (when (firing?)
+      (set! *player-fire-counter*
+            (modulo (+ *player-fire-counter* 1) player-fire-interval))
+      (when (= *player-fire-counter* 0)
+        (let ((xoff 4.0))
+          (bullet-pool-add! player-bullets 0
+                            (- (vec2-x player-position) xoff)
+                            (vec2-y player-position)
+                            0.0 (- player-bullet-speed))
+          (bullet-pool-add! player-bullets 0
+                            (+ (vec2-x player-position) xoff)
+                            (vec2-y player-position)
+                            0.0 (- player-bullet-speed)))
+        (set! *player-fire-counter* 0)))
+    (timeout update dt))
+
+  (set-element-width! canvas (trunc canvas-width))
+  (set-element-height! canvas (trunc canvas-height))
+  (add-event-listener! (current-document) "keydown" on-key-down)
+  (add-event-listener! (current-document) "keyup" on-key-up)
+  (set-image-smoothing-enabled! context 0)
+  (request-animation-frame draw)
+  (timeout update dt))
diff --git a/images/2bit-demichrome.gpl b/images/2bit-demichrome.gpl
new file mode 100644
index 0000000..ec858ca
--- /dev/null
+++ b/images/2bit-demichrome.gpl
@@ -0,0 +1,8 @@
+GIMP Palette

+#Palette Name: 2bit demichrome

+#Description: A 4 colour palette meant to look very robotic or mechanical, with a cold metallic dark grey and a warm dated plastic light grey balancing perfectly

+#Colors: 4

+33	30	32	211e20

+85	85	104	555568

+160	160	139	a0a08b

+233	239	236	e9efec

diff --git a/images/chickadee.png b/images/chickadee.png
new file mode 100644
index 0000000..17a35e0
--- /dev/null
+++ b/images/chickadee.png
diff --git a/images/endesga-16.gpl b/images/endesga-16.gpl
new file mode 100644
index 0000000..a4a84bf
--- /dev/null
+++ b/images/endesga-16.gpl
@@ -0,0 +1,20 @@
+GIMP Palette

+#Palette Name: Endesga 16

+#Description: 

+#Colors: 16

+228	166	114	e4a672

+184	111	80	b86f50

+116	63	57	743f39

+63	40	50	3f2832

+158	40	53	9e2835

+229	59	68	e53b44

+251	146	43	fb922b

+255	231	98	ffe762

+99	198	77	63c64d

+50	115	69	327345

+25	61	63	193d3f

+79	103	129	4f6781

+175	191	210	afbfd2

+255	255	255	ffffff

+44	232	244	2ce8f4

+4	132	209	0484d1

diff --git a/images/map.ase b/images/map.ase
new file mode 100644
index 0000000..4177dd5
--- /dev/null
+++ b/images/map.ase
diff --git a/images/map.png b/images/map.png
new file mode 100644
index 0000000..14da796
--- /dev/null
+++ b/images/map.png
diff --git a/images/player-bullet.ase b/images/player-bullet.ase
new file mode 100644
index 0000000..33cb8ba
--- /dev/null
+++ b/images/player-bullet.ase
diff --git a/images/player-bullet.png b/images/player-bullet.png
new file mode 100644
index 0000000..4693829
--- /dev/null
+++ b/images/player-bullet.png
diff --git a/images/player.ase b/images/player.ase
new file mode 100644
index 0000000..2c90a8f
--- /dev/null
+++ b/images/player.ase
diff --git a/images/player.png b/images/player.png
new file mode 100644
index 0000000..145655b
--- /dev/null
+++ b/images/player.png
diff --git a/index.html b/index.html
new file mode 100644
index 0000000..6bfeba4
--- /dev/null
+++ b/index.html
@@ -0,0 +1,15 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <script type="text/javascript" src="/js-runtime/reflect.js"></script>
+    <script type="text/javascript" src="/boot.js"></script>
+  </head>
+  <body>
+    <canvas id="canvas"></canvas>
+    <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-map" src="images/map.png" />
+    </div>
+  </body>
+</html>
diff --git a/js-runtime/reflect.js b/js-runtime/reflect.js
new file mode 100644
index 0000000..0662ea5
--- /dev/null
+++ b/js-runtime/reflect.js
@@ -0,0 +1,543 @@
+class Char {
+    constructor(codepoint) {
+        this.codepoint = codepoint;
+    }
+    toString() {
+        let ch = String.fromCodePoint(this.codepoint);
+        if (ch.match(/[a-zA-Z0-9$[\]().]/)) return `#\\${ch}`;
+        return `#\\x${this.codepoint.toString(16)}`;
+    }
+}
+class Eof { toString() { return "#<eof>"; } }
+class Nil { toString() { return "#nil"; } }
+class Null { toString() { return "()"; } }
+class Unspecified { toString() { return "#<unspecified>"; } }
+
+class Complex {
+    constructor(real, imag) {
+        this.real = real;
+        this.imag = imag;
+    }
+    toString() {
+        return `${flonum_to_string(this.real)}+${flonum_to_string(this.imag)}i`;
+    }
+}
+class Fraction {
+    constructor(num, denom) {
+        this.num = num;
+        this.denom = denom;
+    }
+    toString() {
+        return `${this.num}/${this.denom}`;
+    }
+}
+
+class HeapObject {
+    constructor(reflector, obj) {
+        this.reflector = reflector;
+        this.obj = obj;
+    }
+    repr() { return this.toString(); } // Default implementation.
+}
+
+class Pair extends HeapObject {
+    toString() { return "#<pair>"; }
+    repr() {
+        let car_repr = repr(this.reflector.car(this));
+        let cdr_repr = repr(this.reflector.cdr(this));
+        if (cdr_repr == '()')
+            return `(${car_repr})`;
+        if (cdr_repr.charAt(0) == '(')
+            return `(${car_repr} ${cdr_repr.substring(1)}`;
+        return `(${car_repr} . ${cdr_repr})`;
+    }
+}
+class MutablePair extends Pair { toString() { return "#<mutable-pair>"; } }
+
+class Vector extends HeapObject {
+    toString() { return "#<vector>"; }
+    repr() {
+        let len = this.reflector.vector_length(this);
+        let out = '#(';
+        for (let i = 0; i < len; i++) {
+            if (i) out += ' ';
+            out += repr(this.reflector.vector_ref(this, i));
+        }
+        out += ')';
+        return out;
+    }
+}
+class MutableVector extends Vector {
+    toString() { return "#<mutable-vector>"; }
+}
+
+class Bytevector extends HeapObject {
+    toString() { return "#<bytevector>"; }
+    repr() {
+        let len = this.reflector.bytevector_length(this);
+        let out = '#vu8(';
+        for (let i = 0; i < len; i++) {
+            if (i) out += ' ';
+            out += this.reflector.bytevector_ref(this, i);
+        }
+        out += ')';
+        return out;
+    }
+}
+class MutableBytevector extends Bytevector {
+    toString() { return "#<mutable-bytevector>"; }
+}
+
+class Bitvector extends HeapObject {
+    toString() { return "#<bitvector>"; }
+    repr() {
+        let len = this.reflector.bitvector_length(this);
+        let out = '#*';
+        for (let i = 0; i < len; i++) {
+            out += this.reflector.bitvector_ref(this, i) ? '1' : '0';
+        }
+        return out;
+    }
+}
+class MutableBitvector extends Bitvector {
+    toString() { return "#<mutable-bitvector>"; }
+}
+
+class MutableString extends HeapObject {
+    toString() { return "#<mutable-string>"; }
+    repr() { return this.reflector.string_value(this); }
+}
+
+class Procedure extends HeapObject {
+    toString() { return "#<procedure>"; }
+    call(...arg) {
+        return this.reflector.call(this, ...arg);
+    }
+}
+
+class Sym extends HeapObject {
+    toString() { return "#<symbol>"; }
+    repr() { return this.reflector.symbol_name(this); }
+}
+
+class Keyword extends HeapObject {
+    toString() { return "#<keyword>"; }
+    repr() { return `#:${this.reflector.keyword_name(this)}`; }
+}
+
+class Variable extends HeapObject { toString() { return "#<variable>"; } }
+class AtomicBox extends HeapObject { toString() { return "#<atomic-box>"; } }
+class HashTable extends HeapObject { toString() { return "#<hash-table>"; } }
+class WeakTable extends HeapObject { toString() { return "#<weak-table>"; } }
+class Fluid extends HeapObject { toString() { return "#<fluid>"; } }
+class DynamicState extends HeapObject { toString() { return "#<dynamic-state>"; } }
+class Syntax extends HeapObject { toString() { return "#<syntax>"; } }
+class Port extends HeapObject { toString() { return "#<port>"; } }
+class Struct extends HeapObject { toString() { return "#<struct>"; } }
+
+function instantiate_streaming(path, imports) {
+    if (typeof fetch !== 'undefined')
+        return WebAssembly.instantiateStreaming(fetch(path), imports);
+    let bytes;
+    if (typeof read !== 'undefined') {
+        bytes = read(path, 'binary');
+    } else if (typeof readFile !== 'undefined') {
+        bytes = readFile(path);
+    } else {
+        let fs = require('fs');
+        bytes = fs.readFileSync(path);
+    }
+    return WebAssembly.instantiate(bytes, imports);
+}
+
+class Scheme {
+    #instance;
+    #abi;
+    constructor(instance, abi) {
+        this.#instance = instance;
+        this.#abi = abi;
+    }
+
+    static async reflect(abi) {
+        let { module, instance } =
+            await instantiate_streaming('js-runtime/reflect.wasm', {
+              abi,
+              rt: {
+                  wtf8_to_string(wtf8) { return wtf8_to_string(wtf8); },
+                  string_to_wtf8(str) { return string_to_wtf8(str); },
+              }
+            });
+        return new Scheme(instance, abi);
+    }
+
+    init_module(mod) {
+        mod.set_debug_handler({
+            debug_str(x) { console.log(`debug: ${x}`); },
+            debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
+            debug_str_scm: (x, y) => {
+                console.log(`debug: ${x}: ${repr(this.to_js(y))}`);
+            },
+        });
+        let proc = new Procedure(this, mod.get_export('$load').value)
+        return proc.call();
+    }
+    static async load_main(path, abi, user_imports = {}) {
+        let mod = await SchemeModule.fetch_and_instantiate(path, abi, user_imports);
+        let reflect = await mod.reflect();
+        return reflect.init_module(mod);
+    }
+    async load_extension(path) {
+        let mod = await SchemeModule.fetch_and_instantiate(path, this.#abi);
+        return this.init_module(mod);
+    }
+
+    #to_scm(js) {
+        let api = this.#instance.exports;
+        if (typeof(js) == 'number') {
+            return api.scm_from_f64(js);
+        } else if (typeof(js) == 'bigint') {
+            if (BigInt(api.scm_most_negative_fixnum()) <= js
+                && js <= BigInt(api.scm_most_positive_fixnum()))
+                return api.scm_from_fixnum(Number(js));
+            return api.scm_from_bignum(js);
+        } else if (typeof(js) == 'boolean') {
+            return js ? api.scm_true() : api.scm_false();
+        } else if (typeof(js) == 'string') {
+            return api.scm_from_string(js);
+        } else if (typeof(js) == 'object') {
+            if (js instanceof Eof) return api.scm_eof();
+            if (js instanceof Nil) return api.scm_nil();
+            if (js instanceof Null) return api.scm_null();
+            if (js instanceof Unspecified) return api.scm_unspecified();
+            if (js instanceof Char) return api.scm_from_char(js.codepoint);
+            if (js instanceof HeapObject) return js.obj;
+            if (js instanceof Fraction)
+                return api.scm_from_fraction(this.#to_scm(js.num),
+                                             this.#to_scm(js.denom));
+            if (js instanceof Complex)
+                return api.scm_from_complex(js.real, js.imag);
+            return api.scm_from_extern(js);
+        } else {
+            throw new Error(`unexpected; ${typeof(js)}`);
+        }
+    }
+
+    to_js(scm) {
+        let api = this.#instance.exports;
+        let descr = api.describe(scm);
+        let handlers = {
+            fixnum: () => BigInt(api.fixnum_value(scm)),
+            char: () => new Char(api.char_value(scm)),
+            true: () => true,
+            false: () => false,
+            eof: () => new Eof,
+            nil: () => new Nil,
+            null: () => new Null,
+            unspecified: () => new Unspecified,
+            flonum: () => api.flonum_value(scm),
+            bignum: () => api.bignum_value(scm),
+            complex: () => new Complex(api.complex_real(scm),
+                                       api.complex_imag(scm)),
+            fraction: () => new Fraction(this.to_js(api.fraction_num(scm)),
+                                         this.to_js(api.fraction_denom(scm))),
+            pair: () => new Pair(this, scm),
+            'mutable-pair': () => new MutablePair(this, scm),
+            vector: () => new Vector(this, scm),
+            'mutable-vector': () => new MutableVector(this, scm),
+            bytevector: () => new Bytevector(this, scm),
+            'mutable-bytevector': () => new MutableBytevector(this, scm),
+            bitvector: () => new Bitvector(this, scm),
+            'mutable-bitvector': () => new MutableBitvector(this, scm),
+            string: () => api.string_value(scm),
+            'mutable-string': () => new MutableString(this, scm),
+            procedure: () => new Procedure(this, scm),
+            symbol: () => new Sym(this, scm),
+            keyword: () => new Keyword(this, scm),
+            variable: () => new Variable(this, scm),
+            'atomic-box': () => new AtomicBox(this, scm),
+            'hash-table': () => new HashTable(this, scm),
+            'weak-table': () => new WeakTable(this, scm),
+            fluid: () => new Fluid(this, scm),
+            'dynamic-state': () => new DynamicState(this, scm),
+            syntax: () => new Syntax(this, scm),
+            port: () => new Port(this, scm),
+            struct: () => new Struct(this, scm),
+            'extern-ref': () => api.extern_value(scm)
+        };
+        let handler = handlers[descr];
+        return handler ? handler() : scm;
+    }
+
+    call(func, ...args) {
+        let api = this.#instance.exports;
+        let argv = api.make_vector(args.length + 1, api.scm_false());
+        func = this.#to_scm(func);
+        api.vector_set(argv, 0, func);
+        for (let [idx, arg] of args.entries())
+            api.vector_set(argv, idx + 1, this.#to_scm(arg));
+        argv = api.call(func, argv);
+        let results = [];
+        for (let idx = 0; idx < api.vector_length(argv); idx++)
+            results.push(this.to_js(api.vector_ref(argv, idx)))
+        return results;
+    }
+
+    car(x) { return this.to_js(this.#instance.exports.car(x.obj)); }
+    cdr(x) { return this.to_js(this.#instance.exports.cdr(x.obj)); }
+
+    vector_length(x) { return this.#instance.exports.vector_length(x.obj); }
+    vector_ref(x, i) {
+        return this.to_js(this.#instance.exports.vector_ref(x.obj, i));
+    }
+
+    bytevector_length(x) {
+        return this.#instance.exports.bytevector_length(x.obj);
+    }
+    bytevector_ref(x, i) {
+        return this.#instance.exports.bytevector_ref(x.obj, i);
+    }
+
+    bitvector_length(x) {
+        return this.#instance.exports.bitvector_length(x.obj);
+    }
+    bitvector_ref(x, i) {
+        return this.#instance.exports.bitvector_ref(x.obj, i) == 1;
+    }
+
+    string_value(x) { return this.#instance.exports.string_value(x.obj); }
+    symbol_name(x) { return this.#instance.exports.symbol_name(x.obj); }
+    keyword_name(x) { return this.#instance.exports.keyword_name(x.obj); }
+}
+
+class SchemeTrapError extends Error {
+    constructor(tag, data) { super(); this.tag = tag; this.data = data; }
+    // FIXME: data is raw Scheme object; would need to be reflected to
+    // have a toString.
+    toString() { return `SchemeTrap(${this.tag}, <data>)`; }
+}
+
+function flonum_to_string(f64) {
+    if (Object.is(f64, -0)) {
+        return '-0.0';
+    } else if (Number.isFinite(f64)) {
+        let repr = f64 + '';
+        return /^-?[0-9]+$/.test(repr) ? repr + '.0' : repr;
+    } else if (Number.isNaN(f64)) {
+        return '+nan.0';
+    } else {
+        return f64 < 0 ? '-inf.0' : '+inf.0';
+    }
+}
+
+let wtf8_helper;
+
+function wtf8_to_string(wtf8) {
+    let { as_iter, iter_next } = wtf8_helper.exports;
+    let codepoints = [];
+    let iter = as_iter(wtf8);
+    for (let cp = iter_next(iter); cp != -1; cp = iter_next(iter))
+        codepoints.push(cp);
+    return String.fromCodePoint(...codepoints);
+}
+
+function string_to_wtf8(str) {
+    let { string_builder, builder_push_codepoint, finish_builder } =
+        wtf8_helper.exports;
+    let builder = string_builder()
+    for (let cp of str)
+        builder_push_codepoint(builder, cp.codePointAt(0));
+    return finish_builder(builder);
+}
+
+async function load_wtf8_helper_module() {
+    if (wtf8_helper) return;
+    let { module, instance } = await instantiate_streaming("js-runtime/wtf8.wasm");
+    wtf8_helper = instance;
+}
+
+class SchemeModule {
+    #instance;
+    #io_handler;
+    #debug_handler;
+    static #rt = {
+        bignum_from_i32(n) { return BigInt(n); },
+        bignum_from_i64(n) { return n; },
+        bignum_from_u64(n) { return n < 0n ? 0xffff_ffff_ffff_ffffn + (n + 1n) : n; },
+        bignum_is_i64(n) {
+            return -0x8000_0000_0000_0000n <= n && n <= 0x7FFF_FFFF_FFFF_FFFFn;
+        },
+        bignum_is_u64(n) {
+            return 0n <= n && n <= 0xFFFF_FFFF_FFFF_FFFFn;
+        },
+        // This truncates; see https://tc39.es/ecma262/#sec-tobigint64.
+        bignum_get_i64(n) { return n; },
+
+        bignum_add(a, b) { return BigInt(a) + BigInt(b) },
+        bignum_sub(a, b) { return BigInt(a) - BigInt(b) },
+        bignum_mul(a, b) { return BigInt(a) * BigInt(b) },
+        bignum_lsh(a, b) { return BigInt(a) << BigInt(b) },
+        bignum_rsh(a, b) { return BigInt(a) >> BigInt(b) },
+        bignum_quo(a, b) { return BigInt(a) / BigInt(b) },
+        bignum_rem(a, b) { return BigInt(a) % BigInt(b) },
+        bignum_mod(a, b) {
+            let r = BigInt(a) % BigInt(b);
+            if ((b > 0n && r < 0n) || (b < 0n && r > 0n)) {
+                return b + r;
+            } else {
+                return r;
+            }
+        },
+        bignum_gcd(a, b) {
+            a = BigInt(a);
+            b = BigInt(b);
+            if (a < 0n) { a = -a; }
+            if (b < 0n) { b = -b; }
+            if (a == 0n) { return b; }
+            if (b == 0n) { return a; }
+
+            let r;
+            while (b != 0n) {
+                r = a % b;
+                a = b;
+                b = r;
+            }
+            return a;
+        },
+
+        bignum_logand(a, b) { return BigInt(a) & BigInt(b); },
+        bignum_logior(a, b) { return BigInt(a) | BigInt(b); },
+        bignum_logxor(a, b) { return BigInt(a) ^ BigInt(b); },
+        bignum_logsub(a, b) { return BigInt(a) & (~ BigInt(b)); },
+
+        bignum_lt(a, b) { return a < b; },
+        bignum_le(a, b) { return a <= b; },
+        bignum_eq(a, b) { return a == b; },
+
+        bignum_to_f64(n) { return Number(n); },
+
+        f64_is_nan(n) { return Number.isNaN(n); },
+        f64_is_infinite(n) { return !Number.isFinite(n); },
+
+        flonum_to_string,
+
+        string_upcase: Function.call.bind(String.prototype.toUpperCase),
+        string_downcase: Function.call.bind(String.prototype.toLowerCase),
+
+        make_weak_map() { return new WeakMap; },
+        weak_map_get(map, k) { return map.get(k); },
+        weak_map_set(map, k, v) { return map.set(k, v); },
+        weak_map_delete(map, k) { return map.delete(k); },
+
+        fsqrt: Math.sqrt,
+        fsin: Math.sin,
+        fcos: Math.cos,
+        ftan: Math.tan,
+        fasin: Math.asin,
+        facos: Math.acos,
+        fatan: Math.atan,
+        fatan2: Math.atan2,
+        flog: Math.log,
+        fexp: Math.exp,
+
+        jiffies_per_second() { return 1000; },
+        current_jiffy() { return BigInt(Math.floor(performance.now())); },
+        current_second() { return Date.now() / 1000; },
+
+        // Wrap in functions to allow for lazy loading of the wtf8
+        // module.
+        wtf8_to_string(wtf8) { return wtf8_to_string(wtf8); },
+        string_to_wtf8(str) { return string_to_wtf8(str); },
+
+        die(tag, data) { throw new SchemeTrapError(tag, data); }
+    };
+
+    constructor(instance) {
+        this.#instance = instance;
+        let read_stdin = () => '';
+        if (typeof printErr === 'function') {
+            // On the console, try to use 'write' (v8) or 'putstr' (sm),
+            // as these don't add an extraneous newline.  Unfortunately
+            // JSC doesn't have a printer that doesn't add a newline.
+            let write_no_newline =
+                typeof write === 'function' ? write
+                : typeof putstr === 'function' ? putstr : print;
+            this.#io_handler = {
+                write_stdout: write_no_newline,
+                write_stderr: printErr,
+                read_stdin
+            };
+        } else {
+            this.#io_handler = {
+                write_stdout: console.log,
+                write_stderr: console.error,
+                read_stdin
+            }
+        }
+        this.#debug_handler = {
+            debug_str(x) { console.log(`debug: ${x}`); },
+            debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
+            debug_str_scm(x, y) { console.log(`debug: ${x}: #<scm>`); },
+        }
+    }
+    static async fetch_and_instantiate(path, imported_abi, user_imports = {}) {
+        await load_wtf8_helper_module();
+        let io = {
+            write_stdout(str) { mod.#io_handler.write_stdout(str); },
+            write_stderr(str) { mod.#io_handler.write_stderr(str); },
+            read_stdin() { return mod.#io_handler.read_stdin(); },
+        }
+        let debug = {
+            debug_str(x) { mod.#debug_handler.debug_str(x); },
+            debug_str_i32(x, y) { mod.#debug_handler.debug_str_i32(x, y); },
+            debug_str_scm(x, y) { mod.#debug_handler.debug_str_scm(x, y); },
+        }
+        let imports = {
+          rt: SchemeModule.#rt,
+          abi: imported_abi,
+          debug, io, ...user_imports
+        };
+        let { module, instance } = await instantiate_streaming(path, imports);
+        let mod = new SchemeModule(instance);
+        return mod;
+    }
+    set_io_handler(h) { this.#io_handler = h; }
+    set_debug_handler(h) { this.#debug_handler = h; }
+    all_exports() { return this.#instance.exports; }
+    exported_abi() {
+        let abi = {}
+        for (let [k, v] of Object.entries(this.all_exports())) {
+            if (k.startsWith("$"))
+                abi[k] = v;
+        }
+        return abi;
+    }
+    exports() {
+        let ret = {}
+        for (let [k, v] of Object.entries(this.all_exports())) {
+            if (!k.startsWith("$"))
+                ret[k] = v;
+        }
+        return ret;
+    }
+    get_export(name) {
+        if (name in this.all_exports())
+            return this.all_exports()[name];
+        throw new Error(`unknown export: ${name}`)
+    }
+    async reflect() {
+        return await Scheme.reflect(this.exported_abi());
+    }
+}
+
+function repr(obj) {
+    if (obj instanceof HeapObject)
+        return obj.repr();
+    if (typeof obj === 'boolean')
+        return obj ? '#t' : '#f';
+    if (typeof obj === 'number')
+        return flonum_to_string(obj);
+    if (typeof obj === 'string')
+        // FIXME: Improve to match Scheme.
+        return '"' + obj.replace(/(["\\])/g, '\\$1') + '"';
+    return obj + '';
+}
diff --git a/js-runtime/reflect.wasm b/js-runtime/reflect.wasm
new file mode 100644
index 0000000..d2b10d7
--- /dev/null
+++ b/js-runtime/reflect.wasm
diff --git a/js-runtime/wtf8.wasm b/js-runtime/wtf8.wasm
new file mode 100644
index 0000000..ca1079d
--- /dev/null
+++ b/js-runtime/wtf8.wasm
diff --git a/web-server.scm b/web-server.scm
new file mode 100644
index 0000000..86015dc
--- /dev/null
+++ b/web-server.scm
@@ -0,0 +1,155 @@
+(use-modules (ice-9 format)
+             (ice-9 ftw)
+             (ice-9 hash-table)
+             (ice-9 match)
+             (ice-9 popen)
+             (ice-9 rdelim)
+             (ice-9 regex)
+             (ice-9 binary-ports)
+             (srfi srfi-1)
+             (srfi srfi-26)
+             (sxml simple)
+             (web server)
+             (web request)
+             (web response)
+             (web uri))
+
+(define %mime-types
+  (alist->hash-table
+   '(("js" . application/javascript)
+     ("html" . text/html)
+     ("wasm" . application/wasm)
+     ("png" . image/png))))
+
+(define (file-extension file)
+  "Return the extension of FILE or #f if there is none."
+  (let ((dot (string-rindex file #\.)))
+    (and dot (substring file (+ 1 dot) (string-length file)))))
+
+(define (mime-type file-name)
+  "Guess the MIME type for FILE-NAME based upon its file extension."
+  (or (hash-ref %mime-types (file-extension file-name))
+      'text/plain))
+
+(define (stat:directory? stat)
+  "Return #t if STAT is a directory."
+  (eq? (stat:type stat) 'directory))
+
+(define (directory? file-name)
+  "Return #t if FILE-NAME is a directory."
+  (stat:directory? (stat file-name)))
+
+(define (directory-contents dir)
+  "Return a list of the files contained within DIR."
+  (define name+directory?
+    (match-lambda
+     ((name stat)
+      (list name (stat:directory? stat)))))
+
+  (define (same-dir? other stat)
+    (string=? dir other))
+
+  (match (file-system-tree dir same-dir?)
+    ;; We are not interested in the parent directory, only the
+    ;; children.
+    ((_ _ children ...)
+     (map name+directory? children))))
+
+(define (work-dir+path->file-name work-dir path)
+  "Convert the URI PATH to an absolute file name relative to the
+directory WORK-DIR."
+  (string-append work-dir path))
+
+(define (request-path-components request)
+  "Split the URI path of REQUEST into a list of component strings.  For
+example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
+  (split-and-decode-uri-path (uri-path (request-uri request))))
+
+(define (request-file-name request)
+  "Return the relative file name corresponding to the REQUEST URI."
+  (let ((components (request-path-components request)))
+    (if (null? components)
+        "/"
+        (string-join components "/" 'prefix))))
+
+(define (resolve-file-name file-name)
+  "If FILE-NAME is a directory with an 'index.html' file,
+return that file name.  If FILE-NAME does not exist, return #f.
+Otherwise, return FILE-NAME as-is."
+  (let ((index-file-name (string-append file-name "/index.html")))
+    (cond
+     ((file-exists? index-file-name) index-file-name)
+     ((file-exists? file-name) file-name)
+     (else #f))))
+
+(define (render-file file-name)
+  "Return a 200 OK HTTP response that renders the contents of
+FILE-NAME."
+  (values `((content-type . (,(mime-type file-name))))
+          (call-with-input-file file-name get-bytevector-all)))
+
+(define (render-directory path dir)
+  "Render the contents of DIR represented by the URI PATH."
+  (define (concat+uri-encode . file-names)
+    "Concatenate FILE-NAMES, preserving the correct file separators."
+    (string-join (map uri-encode
+                      (remove string-null?
+                              (append-map (cut string-split <> #\/) file-names)))
+                 "/" 'prefix))
+
+  (define render-child
+    (match-lambda
+     ((file-name directory?)
+      `(li
+        (a (@ (href ,(concat+uri-encode path file-name)))
+           ,(if directory?
+                (string-append file-name "/")
+                file-name))))))
+
+  (define file-name<
+    (match-lambda*
+     (((name-a _) (name-b _))
+      (string< name-a name-b))))
+
+  (let* ((children (sort (directory-contents dir) file-name<))
+         (title (string-append "Directory listing for " path))
+         (view `(html
+                (head
+                 (title ,title))
+                (body
+                 (h1 ,title)
+                 (ul ,@(map render-child children))))))
+    (values '((content-type . (text/html)))
+            (lambda (port)
+              (display "<!DOCTYPE html>" port)
+              (sxml->xml view port)))))
+
+(define (not-found path)
+  "Return a 404 not found HTTP response for PATH."
+  (values (build-response #:code 404)
+          (string-append "Resource not found: " path)))
+
+(define (serve-file work-dir path)
+  "Return an HTTP response for the file represented by PATH."
+  (match (resolve-file-name
+          (work-dir+path->file-name work-dir path))
+    (#f (not-found path))
+    ((? directory? dir)
+     (render-directory path dir))
+    (file-name
+     (render-file file-name))))
+
+(define (make-handler work-dir)
+  (lambda (request body)
+    "Serve the file asked for in REQUEST."
+    (format #t "~a ~a~%"
+            (request-method request)
+            (uri-path (request-uri request)))
+    (serve-file work-dir (request-file-name request))))
+
+(define* (serve work-dir #:key (open-params '()))
+  "Run a simple HTTP server that serves files in WORK-DIR."
+  (run-server (make-handler work-dir) 'http open-params))
+
+(when (batch-mode?)
+  (serve (getcwd) #:open-params `(#:port 8088 #:addr ,INADDR_ANY)))