From 2f1022f1d65b148524dc8f0c824aaca6e9392996 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 24 Oct 2023 07:53:57 -0400
Subject: Add basic HUD; prevent default key event handler.

---
 boot.js  |  9 +++++++++
 game.scm | 55 ++++++++++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 53 insertions(+), 11 deletions(-)

diff --git a/boot.js b/boot.js
index b9e8fe1..b30e95b 100644
--- a/boot.js
+++ b/boot.js
@@ -78,6 +78,9 @@ async function load() {
       }
     },
     event: {
+      preventDefault(event) {
+        event.preventDefault();
+      },
       keyboardCode(event) {
         return event.code;
       }
@@ -89,12 +92,18 @@ async function load() {
       setFillColor(context, color) {
         context.fillStyle = color;
       },
+      setFont(context, font) {
+        context.font = font;
+      },
       clearRect(context, x, y, w, h) {
         context.clearRect(x, y, w, h);
       },
       fillRect(context, x, y, w, h) {
         context.fillRect(x, y, w, h);
       },
+      fillText(context, text, x, y) {
+        context.fillText(text, x, y);
+      },
       drawImage(context, image, sx, sy, sWidth, sHeight, dx, dy, dWidth, dHeight) {
         context.drawImage(image, sx, sy, sWidth, sHeight, dx, dy, dWidth, dHeight);
       },
diff --git a/game.scm b/game.scm
index 5f6c3e9..6c7343a 100644
--- a/game.scm
+++ b/game.scm
@@ -69,6 +69,9 @@
     "element" "clone"
     (ref extern) -> (ref extern))
 
+  (define-foreign prevent-default!
+    "event" "preventDefault"
+    (ref extern) -> none)
   (define-foreign keyboard-event-code
     "event" "keyboardCode"
     (ref extern) -> (ref string))
@@ -79,12 +82,18 @@
   (define-foreign set-fill-color!
     "canvas" "setFillColor"
     (ref extern) (ref string) -> none)
+  (define-foreign set-font!
+    "canvas" "setFont"
+    (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 fill-text
+    "canvas" "fillText"
+    (ref extern) (ref string) f64 f64 -> none)
   (define-foreign draw-image
     "canvas" "drawImage"
     (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
@@ -931,6 +940,18 @@
                   0.0 (- game-height scroll) game-width scroll
                   0.0 0.0 game-width scroll)))
 
+  (define (draw-hud)
+    (let ((y (- game-height 8.0)))
+      ;; TODO: Don't strings every frame when the UI values rarely
+      ;; change.
+      (set-fill-color! context "#ffffff")
+      (set-font! context "bold 8px monospace")
+      (fill-text context (string-append "x" (number->string *player-lives*))
+                 (- game-width 16.0) y)
+      ;; TODO: Add scoring.
+      (fill-text context (string-append "score " (number->string 0))
+                 4.0 y)))
+
   (define (draw time)
     (clear-screen)
     (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
@@ -943,6 +964,7 @@
     (draw-enemies enemies)
     (draw-player)
     (draw-enemy-bullets)
+    (draw-hud)
     (request-animation-frame draw))
 
   (define (reset!)
@@ -963,31 +985,42 @@
     (let ((code (keyboard-event-code event)))
       (cond
        ((string-=? code "ArrowLeft")
-        (set-left! #t))
+        (set-left! #t)
+        (prevent-default! event))
        ((string-=? code "ArrowRight")
-        (set-right! #t))
+        (set-right! #t)
+        (prevent-default! event))
        ((string-=? code "ArrowDown")
-        (set-down! #t))
+        (set-down! #t)
+        (prevent-default! event))
        ((string-=? code "ArrowUp")
-        (set-up! #t))
+        (set-up! #t)
+        (prevent-default! event))
        ((string-=? code "KeyZ")
-        (set-firing! #t))
+        (set-firing! #t)
+        (prevent-default! event))
        ((string-=? code "KeyR")
-        (reset!)))))
+        (reset!)
+        (prevent-default! event)))))
 
   (define (on-key-up event)
     (let ((code (keyboard-event-code event)))
       (cond
        ((string-=? code "ArrowLeft")
-        (set-left! #f))
+        (set-left! #f)
+        (prevent-default! event))
        ((string-=? code "ArrowRight")
-        (set-right! #f))
+        (set-right! #f)
+        (prevent-default! event))
        ((string-=? code "ArrowDown")
-        (set-down! #f))
+        (set-down! #f)
+        (prevent-default! event))
        ((string-=? code "ArrowUp")
-        (set-up! #f))
+        (set-up! #f)
+        (prevent-default! event))
        ((string-=? code "KeyZ")
-        (set-firing! #f)))))
+        (set-firing! #f)
+        (prevent-default! event)))))
 
   (define (out-of-bounds? x y w h)
     (let ((padding 32.0))
-- 
cgit v1.2.3