(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 s32-ref bytevector-s32-native-ref) (define s32-set! bytevector-s32-native-set!) (define f64-ref bytevector-ieee-double-native-ref) (define f64-set! bytevector-ieee-double-native-set!) (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) (f64-ref v 0)) (define (vec2-y v) (f64-ref v 8)) (define (set-vec2-x! v x) (f64-set! v 0 x)) (define (set-vec2-y! v y) (f64-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)))) (f64-set! r 0 x) (f64-set! r 8 y) (f64-set! r 16 w) (f64-set! r 24 h) r)) (define (rect-x r) (f64-ref r 0)) (define (rect-y r) (f64-ref r 8)) (define (rect-w r) (f64-ref r 16)) (define (rect-h r) (f64-ref r 24)) (define (within? x y rx ry rw rh) (and (>= x rx) (>= y ry) (<= x (+ rx rw)) (<= y (+ ry rh)))) (define (rect-within? ax ay aw ah bx by bw bh) (let ((ax* (+ ax aw)) (ay* (+ ay ah))) (or (within? ax ay bx by bw bh) (within? ax* ay bx by bw bh) (within? ax* ay* bx by bw bh) (within? ax ay* bx by bw bh)))) (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:enemy-bullets (get-element-by-id "image-enemy-bullets")) (define image:map (get-element-by-id "image-map")) (define image:enemies (get-element-by-id "image-enemies")) ;; Scripting (define (make-scheduler max-tasks) (vector 0 0 max-tasks (make-vector max-tasks))) (define (scheduler-add! scheduler thunk delay) (match scheduler (#(ticks num-tasks max-tasks tasks) (unless (= num-tasks max-tasks) (vector-set! tasks num-tasks (cons (+ ticks delay) thunk)) (vector-set! scheduler 1 (+ num-tasks 1)))))) (define (scheduler-tick! scheduler) (define (run-thunks thunks) (for-each (lambda (thunk) (thunk)) thunks)) (run-thunks (match scheduler (#(ticks num-tasks max-tasks tasks) (let ((t (+ ticks 1))) (let loop ((i 0) (k num-tasks) (to-run '())) (if (< i k) (match (vector-ref tasks i) ((t* . thunk) (if (<= t* t) (let ((k* (- k 1))) (vector-set! tasks i (vector-ref tasks k*)) (vector-set! tasks k* #f) (loop i k* (cons thunk to-run))) (loop (+ i 1) k to-run)))) (begin (vector-set! scheduler 0 t) (vector-set! scheduler 1 k) to-run)))))))) (define *scheduler* (make-scheduler 100)) (define %script-tag (make-prompt-tag "script")) (define (run-script thunk) (define (run thunk) (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)))) (define (wait delay) (abort-to-prompt %script-tag delay)) ;; Bullets: ;; per bullet: type, x, y, dx, dy (define %bullet-size (+ 4 8 8 8 8)) (define (make-bullet-pool capacity) (let ((pool (make-bytevector (* capacity %bullet-size)))) (vector 0 capacity pool))) (define (bullet-pool-offset i) (* i %bullet-size)) (define (bullet-pool-add! pool type x y dx dy) (match pool (#(length capacity bullets) (let ((offset (bullet-pool-offset length))) (s32-set! bullets offset type) (f64-set! bullets (+ offset 4) x) (f64-set! bullets (+ offset 12) y) (f64-set! bullets (+ offset 20) dx) (f64-set! bullets (+ offset 28) dy) (vector-set! pool 0 (+ length 1)))))) (define (bullet-pool-remove! pool i) (match pool (#(length capacity bullets) (when (and (>= i 0) (< i length)) (let ((at (bullet-pool-offset i)) (start (bullet-pool-offset (- length 1)))) (bytevector-copy! bullets at bullets start (+ start %bullet-size)) (vector-set! pool 0 (- length 1))))))) (define (bullet-pool-update! pool collide) (match pool (#(length capacity bullets) (let loop ((i 0) (k length)) (when (< i k) (let* ((offset (bullet-pool-offset i)) (x (f64-ref bullets (+ offset 4))) (y (f64-ref bullets (+ offset 12))) (dx (f64-ref bullets (+ offset 20))) (dy (f64-ref bullets (+ offset 28))) (x* (+ x dx)) (y* (+ y dy))) (cond ;; TODO: different bullet hitbox sizes. ((collide x y 2.0 2.0) (bullet-pool-remove! pool i) (loop i (- k 1))) (else (f64-set! bullets (+ offset 4) x*) (f64-set! bullets (+ offset 12) y*) (loop (+ i 1) k))))))))) (define (draw-bullets pool image w h) (match pool (#(length capacity bullets) (do ((i 0 (+ i 1))) ((= i length)) (let* ((offset (bullet-pool-offset i)) (type (s32-ref bullets offset)) (x (f64-ref bullets (+ offset 4))) (y (f64-ref bullets (+ 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 200)) (define enemy-bullets (make-bullet-pool 400)) ;; Scrolling level: (define *scroll* 0.0) (define *scroll-speed* 1.0) (define (update-scroll!) (set! *scroll* (+ *scroll* *scroll-speed*))) ;; sprite sheet offset, x, y (define %tile-size (+ 8 8 8)) (define tile-width 16.0) (define tile-height 16.0) (define level-width 15) (define (make-level tiles) (let ((k (length tiles))) (unless (= (modulo k level-width) 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 level-width) (match tiles ((t . rest) (let ((n (match t ('_ -1.0) ('X 0.0) ('\ 1.0) ('/ 2.0))) (offset (* (+ x (* y level-width)) %tile-size))) (f64-set! bv offset n) (f64-set! bv (+ offset 8) (* (inexact x) tile-width)) (f64-set! bv (+ offset 16) (* (inexact y) tile-height))) (x-loop rest (+ x 1)))) tiles)) (+ y 1))))) (vector (/ k level-width) 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 X \ _ _ _ _ _ _ _ _ _ / X X X X X \ _ _ _ _ _ _ _ / X X X) (define (level-offset x y) (* (+ (* level-width y) x) %tile-size)) (define (point-collides-with-level? level x y) (match level (#(height tiles) (let ((tx (trunc (/ x tile-width))) (ty (trunc (/ y tile-height)))) (and (>= tx 0) (< tx level-width) (>= ty 0) (< tx height) (>= (f64-ref tiles (level-offset tx ty)) 0)))))) (define (rect-collides-with-level? level x y w h) (match level (#(height tiles) (let* ((y (+ y (- (* height tile-height) game-height *scroll*))) (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 level-width) (>= y 0) (< x height) (>= (f64-ref tiles (level-offset x y)) 0.0))) (or (occupied? tx0 ty0) (occupied? tx1 ty0) (occupied? tx1 ty1) (occupied? tx0 ty1)))))) (define (draw-tiles level) (match level (#(height tiles) (let* ((tw tile-width) (th tile-height) (pixel-y-offset (- (* height th) *scroll* game-height)) (scroll-y-offset (- height (trunc (/ *scroll* tile-height)))) (y-start (clamp (- scroll-y-offset 21) 0 height)) (y-end (clamp scroll-y-offset 0 height))) (do ((y y-start (+ y 1))) ((= 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)))) (draw-image context image:map (* t tw) 0.0 tw th tx (- ty pixel-y-offset) tw th)))))))) ;; Enemies: ;; length, capacity, pool ;; enemy: type, health, x, y, w, h, dx, dy (define %enemy-size (+ 4 4 8 8 8 8 8 8)) (define (make-enemy-pool capacity) (let ((enemies (make-bytevector (* capacity %enemy-size)))) (vector 0 capacity enemies))) (define (enemy-pool-offset i) (* i %enemy-size)) (define (enemy-pool-add! pool type hp x y w h dx dy) (match 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! pool 0 (+ length 1))))))) (define (enemy-pool-remove! pool i) (match pool (#(length capacity enemies) (when (and (>= i 0) (< i length)) (let ((at (enemy-pool-offset i)) (start (enemy-pool-offset (- length 1)))) (bytevector-copy! enemies at enemies start (+ start %enemy-size)) (vector-set! pool 0 (- length 1))))))) (define (enemy-pool-update! pool collide) (match 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)) (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))))))))))) (define (draw-enemies pool) (match 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))) (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)))))) (define (find-enemy pool x y w h) (match pool (#(length capacity enemies) (let loop ((i 0)) (and (< i length) (let* ((offset (enemy-pool-offset i)) (x* (f64-ref enemies (+ offset 8))) (y* (f64-ref enemies (+ offset 16))) (w* (f64-ref enemies (+ offset 24))) (h* (f64-ref enemies (+ offset 32)))) (if (rect-within? x y w h x* y* w* h*) i (loop (+ i 1))))))))) (define (damage-enemy! pool i damage) (match pool (#(length capacity enemies) (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) ;; 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) (define player-hitbox-width 2.0) (define player-hitbox-height 2.0) (define %default-lives 3) (define *player-lives* %default-lives) (define *player-visible?* #t) (define *player-invincible?* #f) ;; left, right, down, up, fire (define key-state (vector #f #f #f #f #f)) (define (update-player-velocity!) (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 (player-die!) (set! *player-lives* (max (- *player-lives* 1) 0)) (run-script (lambda () (set! *player-invincible?* #t) (let ((t 5)) (let loop ((i 0)) (when (< i 10) (set! *player-visible?* #f) (wait t) (set! *player-visible?* #t) (wait t) (loop (+ i 1))))) (set! *player-invincible?* #f)))) (define (game-over?) (= *player-lives* 0)) (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-enemy-bullets) (draw-bullets enemy-bullets image:enemy-bullets 16.0 16.0)) (define (draw-player) (draw-image context image:player (if *player-visible?* 0.0 player-width) 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-tiles level 0.0) (draw-player-bullets) (draw-enemies enemies) (draw-player) (draw-enemy-bullets) (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 (out-of-bounds? x y w h) (let ((padding 16.0)) (not (rect-within? x y w h (- padding) (- padding) (+ game-width padding) (+ game-height padding))))) (define (player-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) (rect-collides-with-level? level x* y* w h) (let ((enemy-id (find-enemy enemies x y w h))) (and enemy-id (begin (damage-enemy! enemies enemy-id 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) (rect-collides-with-level? level x* y* w h)))) (define (enemy-collide x y w h hp) hp) (define dt (/ 1000.0 60.0)) (define (update) (scheduler-tick! *scheduler*) (update-scroll!) (vec2-add! player-position player-velocity) (vec2-clamp! player-position 0.0 0.0 game-width game-height) (when (and (not *player-invincible?*) (rect-collides-with-level? level (- (vec2-x player-position) (/ player-hitbox-width 2.0)) (- (vec2-y player-position) (/ player-hitbox-height 2.0)) player-hitbox-width player-hitbox-height)) (player-die!)) (bullet-pool-update! player-bullets player-bullet-collide) (bullet-pool-update! enemy-bullets enemy-bullet-collide) (enemy-pool-update! enemies enemy-collide) (when (firing?) (set! *player-fire-counter* (modulo (+ *player-fire-counter* 1) player-fire-interval)) (when (= *player-fire-counter* 0) (bullet-pool-add! player-bullets 0 (- (vec2-x player-position) 6.0) (vec2-y player-position) 0.0 (- player-bullet-speed)) (bullet-pool-add! player-bullets 0 (+ (vec2-x player-position) 8.0) (vec2-y player-position) 0.0 (- player-bullet-speed)) (set! *player-fire-counter* 0))) (timeout update dt)) ;; Temp hacky scripts (run-script (lambda () (let ((ox 70.0) (oy 100.0) (speed 2.0)) (let loop ((theta 0.0)) (let ((dx (* (cos theta) speed)) (dy (* (sin theta) speed))) (bullet-pool-add! enemy-bullets 0 ox oy dx dy)) (wait 2) (loop (+ theta 0.2)))))) (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))