summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-10-23 21:23:58 -0400
committerDavid Thompson <dthompson2@worcester.edu>2023-10-23 21:23:58 -0400
commit9cc06fcb9e4e2f57b4cfd132119cf1fb20afe6fc (patch)
treef931cc705519c30b433ce2db8a52c8bfdf8a1ef0
parentba705ff0d1de68d36be42330784ab3ab6812c8ea (diff)
Resize canvas to fit window size, rewrite enemies.
-rw-r--r--boot.js9
-rw-r--r--game.css11
-rw-r--r--game.scm475
-rw-r--r--index.html5
-rw-r--r--web-server.scm4
5 files changed, 308 insertions, 196 deletions
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."