diff options
-rw-r--r-- | boot.js | 9 | ||||
-rw-r--r-- | game.scm | 55 |
2 files changed, 53 insertions, 11 deletions
@@ -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); }, @@ -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)) |