summaryrefslogtreecommitdiff
path: root/game.scm
diff options
context:
space:
mode:
Diffstat (limited to 'game.scm')
-rw-r--r--game.scm55
1 files changed, 44 insertions, 11 deletions
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))