2024-05-17 13:08:43 -04:00
|
|
|
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
|
|
|
|
;;;
|
|
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
|
|
;;; you may not use this file except in compliance with the License.
|
|
|
|
;;; You may obtain a copy of the License at
|
|
|
|
;;;
|
|
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
;;;
|
|
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
|
|
;;; See the License for the specific language governing permissions and
|
|
|
|
;;; limitations under the License.
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
;;;
|
|
|
|
;;; Example game showing off several common game programming things.
|
|
|
|
;;;
|
|
|
|
;;; Code:
|
|
|
|
|
2024-05-17 17:49:43 -04:00
|
|
|
(use-modules (dom canvas)
|
|
|
|
(dom document)
|
|
|
|
(dom element)
|
|
|
|
(dom event)
|
|
|
|
(dom image)
|
|
|
|
(dom media)
|
|
|
|
(dom window)
|
2024-05-18 14:04:35 -04:00
|
|
|
(game actors)
|
2024-05-20 12:15:39 -04:00
|
|
|
(game level)
|
2024-05-19 17:30:36 -04:00
|
|
|
(game levels level-1)
|
2024-05-20 13:34:59 -04:00
|
|
|
(game levels level-2)
|
|
|
|
(game levels level-3)
|
2024-05-22 12:07:41 -04:00
|
|
|
(game levels level-4)
|
2024-05-18 18:51:45 -04:00
|
|
|
(game tileset)
|
2024-05-18 14:04:35 -04:00
|
|
|
(goblins core)
|
2024-05-19 17:30:36 -04:00
|
|
|
(hoot bytevectors)
|
2024-05-17 17:49:43 -04:00
|
|
|
(hoot ffi)
|
|
|
|
(hoot hashtables)
|
|
|
|
(ice-9 match)
|
2024-05-20 22:12:35 -04:00
|
|
|
(local-storage)
|
2024-05-17 17:49:43 -04:00
|
|
|
(math)
|
|
|
|
(math rect)
|
|
|
|
(math vector))
|
|
|
|
|
|
|
|
(define game-width 320.0)
|
|
|
|
(define game-height 240.0)
|
2024-05-18 14:04:35 -04:00
|
|
|
(define level-width (inexact->exact (floor (/ game-width tile-width))))
|
|
|
|
(define level-height (inexact->exact (floor (/ game-height tile-height))))
|
|
|
|
|
|
|
|
(define *canvas-scale* 0.0)
|
|
|
|
(define *canvas-width* 0)
|
|
|
|
(define *canvas-height* 0)
|
2024-05-17 17:58:43 -04:00
|
|
|
|
2024-05-19 06:15:27 -04:00
|
|
|
;; Assets
|
2024-05-18 18:51:45 -04:00
|
|
|
(define tileset
|
|
|
|
(make-tileset (make-image "assets/images/cirkoban.png")
|
|
|
|
320 240
|
|
|
|
(inexact->exact tile-width)
|
|
|
|
(inexact->exact tile-height)))
|
2024-05-20 12:15:39 -04:00
|
|
|
(define* (load-sound-effect name #:key (volume 0.25))
|
2024-05-19 17:30:36 -04:00
|
|
|
(let ((audio (make-audio (string-append "assets/sounds/" name ".wav"))))
|
|
|
|
(set-media-volume! audio volume)
|
|
|
|
audio))
|
|
|
|
(define audio:bump (load-sound-effect "bump"))
|
|
|
|
(define audio:push (load-sound-effect "push"))
|
|
|
|
(define audio:undo (load-sound-effect "undo"))
|
|
|
|
(define audio:no (load-sound-effect "no"))
|
2024-05-20 12:15:39 -04:00
|
|
|
(define audio:exit (load-sound-effect "exit"))
|
2024-05-21 14:10:57 -04:00
|
|
|
(define audio:pickup (load-sound-effect "pickup"))
|
2024-05-22 09:29:44 -04:00
|
|
|
(define audio:die (load-sound-effect "die"))
|
2024-05-17 13:08:43 -04:00
|
|
|
|
2024-05-18 14:04:35 -04:00
|
|
|
;; Game state
|
2024-05-20 13:34:59 -04:00
|
|
|
(define *state* #f)
|
|
|
|
|
2024-05-18 14:04:35 -04:00
|
|
|
(define *actormap* (make-whactormap))
|
|
|
|
(define (call-with-goblins thunk)
|
|
|
|
(actormap-churn-run! *actormap* thunk))
|
|
|
|
(define-syntax-rule (with-goblins body ...)
|
|
|
|
(call-with-goblins (lambda () body ...)))
|
|
|
|
|
2024-05-20 13:34:59 -04:00
|
|
|
(define levels
|
|
|
|
(vector
|
|
|
|
load-level-1
|
|
|
|
load-level-2
|
2024-05-22 12:07:41 -04:00
|
|
|
load-level-3
|
|
|
|
load-level-4))
|
2024-05-20 13:34:59 -04:00
|
|
|
(define *level-idx* #f)
|
2024-05-21 14:10:57 -04:00
|
|
|
(define *gems* #f)
|
2024-05-18 14:04:35 -04:00
|
|
|
(define *level* #f)
|
|
|
|
;; Latest representation of all actors in level
|
2024-05-20 22:12:35 -04:00
|
|
|
(define *objects* #f)
|
2024-05-18 14:04:35 -04:00
|
|
|
|
|
|
|
(define *snapshots* '())
|
|
|
|
(define (clear-snapshots!)
|
|
|
|
(set! *snapshots* '()))
|
|
|
|
(define (save-snapshot!)
|
|
|
|
(set! *snapshots* (cons (copy-whactormap *actormap*) *snapshots*)))
|
2024-05-18 18:51:45 -04:00
|
|
|
(define (rollback-snapshot!)
|
|
|
|
(match *snapshots*
|
2024-05-19 17:30:36 -04:00
|
|
|
(() (media-play audio:no))
|
2024-05-18 18:51:45 -04:00
|
|
|
((snapshot . older-snapshots)
|
|
|
|
(set! *actormap* snapshot)
|
2024-05-19 17:30:36 -04:00
|
|
|
(set! *snapshots* older-snapshots)
|
|
|
|
(media-play audio:undo))))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
2024-05-22 06:52:36 -04:00
|
|
|
(define (sort lst compare)
|
2024-05-21 17:28:57 -04:00
|
|
|
(match lst
|
|
|
|
(() '())
|
|
|
|
((_) lst)
|
2024-05-22 06:52:36 -04:00
|
|
|
(_
|
|
|
|
;; Insertion sort because I am lazy!
|
|
|
|
(let ((vec (list->vector lst)))
|
|
|
|
(let outer ((i 1))
|
|
|
|
(when (< i (vector-length vec))
|
|
|
|
(let inner ((j i))
|
|
|
|
(when (> j 0)
|
|
|
|
(let ((a (vector-ref vec j))
|
|
|
|
(b (vector-ref vec (1- j))))
|
|
|
|
(when (compare a b)
|
|
|
|
(vector-set! vec j b)
|
|
|
|
(vector-set! vec (1- j) a)
|
|
|
|
(inner (1- j))))))
|
|
|
|
(outer (1+ i))))
|
|
|
|
(vector->list vec)))))
|
2024-05-21 17:28:57 -04:00
|
|
|
|
|
|
|
(define (filter-map proc lst)
|
|
|
|
(let lp ((lst lst))
|
|
|
|
(match lst
|
|
|
|
(() '())
|
|
|
|
((head . tail)
|
|
|
|
(let ((head* (proc head)))
|
|
|
|
(if head*
|
|
|
|
(cons head* (lp tail))
|
|
|
|
(lp tail)))))))
|
|
|
|
|
2024-05-20 22:12:35 -04:00
|
|
|
(define (update-objects!)
|
|
|
|
(set! *objects*
|
2024-05-21 22:12:21 -04:00
|
|
|
;; z-sort the list so we render in the correct order. Then
|
|
|
|
;; convert tile positions to vec2s of pixel coordinates for
|
|
|
|
;; more efficient rendering.
|
2024-05-20 22:12:35 -04:00
|
|
|
(map (match-lambda
|
2024-05-21 17:28:57 -04:00
|
|
|
((type #(x y _) . properties)
|
2024-05-21 22:12:21 -04:00
|
|
|
`(,type ,(vec2 (* x tile-width) (* y tile-height)) ,@properties)))
|
|
|
|
(sort ($ (level-actor *level*) 'describe)
|
2024-05-21 17:28:57 -04:00
|
|
|
(lambda (a b)
|
|
|
|
(match a
|
|
|
|
((_ #(_ _ az) . _)
|
|
|
|
(match b
|
|
|
|
((_ #(_ _ bz) . _)
|
|
|
|
(<= az bz))))))))))
|
|
|
|
|
|
|
|
(define (collected-gem? idx)
|
|
|
|
(not (memq idx *gems*)))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
2024-05-20 22:12:35 -04:00
|
|
|
(define (load-level! idx)
|
|
|
|
(set! *state* 'play)
|
|
|
|
(set! *actormap* (make-whactormap))
|
2024-05-20 13:34:59 -04:00
|
|
|
(clear-snapshots!)
|
2024-05-20 22:12:35 -04:00
|
|
|
(with-goblins
|
2024-05-21 17:28:57 -04:00
|
|
|
(set! *level* ((vector-ref levels idx) (collected-gem? idx)))
|
2024-05-20 22:12:35 -04:00
|
|
|
(update-objects!)))
|
|
|
|
|
|
|
|
(define (next-level!)
|
2024-05-20 13:34:59 -04:00
|
|
|
(let ((idx (+ *level-idx* 1)))
|
2024-05-20 22:12:35 -04:00
|
|
|
(pk 'next-level idx)
|
2024-05-20 13:34:59 -04:00
|
|
|
(set! *level-idx* idx)
|
|
|
|
(if (< idx (vector-length levels))
|
2024-05-20 22:12:35 -04:00
|
|
|
(begin
|
|
|
|
(save-game!)
|
|
|
|
(load-level! idx))
|
2024-05-20 13:34:59 -04:00
|
|
|
(set! *state* 'win))))
|
|
|
|
|
2024-05-20 22:12:35 -04:00
|
|
|
;; Auto-save/load to local storage.
|
|
|
|
(define (save-game!)
|
|
|
|
(pk 'save)
|
2024-05-21 14:10:57 -04:00
|
|
|
(local-storage-set! "cirkoban-save"
|
|
|
|
(call-with-output-string
|
|
|
|
(lambda (port)
|
|
|
|
(write (list *level-idx* *gems*) port)))))
|
2024-05-20 22:12:35 -04:00
|
|
|
|
|
|
|
(define (load-game!)
|
2024-05-21 14:10:57 -04:00
|
|
|
(let ((saved
|
|
|
|
(match (local-storage-ref "cirkoban-save")
|
|
|
|
("" '(0 ())) ; initial save state
|
|
|
|
(str (call-with-input-string str read)))))
|
|
|
|
(match saved
|
|
|
|
((idx gems)
|
|
|
|
(set! *level-idx* idx)
|
|
|
|
(set! *gems* gems)
|
|
|
|
(pk 'load *level-idx*)
|
|
|
|
(load-level! *level-idx*)))))
|
2024-05-20 22:12:35 -04:00
|
|
|
|
2024-05-18 14:04:35 -04:00
|
|
|
(define (reset-game!)
|
2024-05-20 22:12:35 -04:00
|
|
|
(set! *level-idx* 0)
|
|
|
|
(save-game!)
|
|
|
|
(load-level! 0))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
|
|
|
;; Update loop
|
|
|
|
(define (move-player dir)
|
2024-05-20 22:12:35 -04:00
|
|
|
(define (do-move)
|
|
|
|
(with-goblins
|
2024-05-22 09:29:44 -04:00
|
|
|
(let ((player (level-player *level*)))
|
|
|
|
(if ($ player 'alive?)
|
|
|
|
(begin
|
|
|
|
($ player 'move dir)
|
|
|
|
($ (level-actor *level*) 'tick)
|
|
|
|
;; TODO: Need a better way to receive events to play sounds
|
|
|
|
;; and emit particles and stuff so any actor can trigger
|
|
|
|
;; events.
|
|
|
|
(let ((result
|
|
|
|
(match ($ player 'event)
|
|
|
|
(('bump)
|
|
|
|
(media-play audio:bump)
|
|
|
|
#f)
|
|
|
|
(('push)
|
|
|
|
(media-play audio:push)
|
|
|
|
#f)
|
|
|
|
(('exit)
|
|
|
|
(media-play audio:exit)
|
|
|
|
'next-level)
|
|
|
|
(('die)
|
|
|
|
(media-play audio:die)
|
|
|
|
#f)
|
|
|
|
(('gem)
|
|
|
|
(media-play audio:pickup)
|
|
|
|
;; TODO: Maybe show a little achievement popup when all gems
|
|
|
|
;; are collected?
|
|
|
|
(set! *gems* (cons *level-idx* *gems*))
|
|
|
|
#f)
|
|
|
|
(_ #f))))
|
|
|
|
(update-objects!)
|
|
|
|
(save-snapshot!)
|
|
|
|
result))
|
|
|
|
(begin
|
|
|
|
(media-play audio:no)
|
|
|
|
#f)))))
|
2024-05-20 22:12:35 -04:00
|
|
|
(when (eq? (do-move) 'next-level)
|
|
|
|
(next-level!)))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
2024-05-17 13:08:43 -04:00
|
|
|
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
|
|
|
|
(define (update)
|
2024-05-18 14:04:35 -04:00
|
|
|
;; TODO: what kind of work do we need to do each frame?
|
2024-05-17 13:08:43 -04:00
|
|
|
(timeout update-callback dt))
|
|
|
|
(define update-callback (procedure->external update))
|
|
|
|
|
2024-05-18 14:04:35 -04:00
|
|
|
;; Render loop
|
2024-05-17 13:08:43 -04:00
|
|
|
(define number->string*
|
|
|
|
(let ((cache (make-eq-hashtable))) ; assuming fixnums only
|
|
|
|
(lambda (x)
|
|
|
|
(or (hashtable-ref cache x)
|
|
|
|
(let ((str (number->string x)))
|
|
|
|
(hashtable-set! cache x str)
|
|
|
|
str)))))
|
|
|
|
|
2024-05-20 22:12:35 -04:00
|
|
|
(define (draw-player pos)
|
|
|
|
(draw-tile context tileset 0 (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
|
|
|
(define (draw-exit pos)
|
|
|
|
(draw-tile context tileset 27 (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
2024-05-22 14:42:27 -04:00
|
|
|
(define (draw-wire-state pos state)
|
2024-05-20 22:12:35 -04:00
|
|
|
(let ((x (vec2-x pos))
|
|
|
|
(y (vec2-y pos)))
|
2024-05-22 14:42:27 -04:00
|
|
|
(match state
|
2024-05-20 22:12:35 -04:00
|
|
|
('electron-head
|
|
|
|
(draw-tile context tileset 4 x y))
|
|
|
|
('electron-tail
|
|
|
|
(draw-tile context tileset 5 x y))
|
|
|
|
(_ #f))))
|
|
|
|
|
2024-05-22 14:42:27 -04:00
|
|
|
(define (draw-wall pos type)
|
|
|
|
(draw-wire-state pos type))
|
|
|
|
|
2024-05-21 22:12:21 -04:00
|
|
|
(define (draw-block pos type)
|
2024-05-20 22:12:35 -04:00
|
|
|
(let ((x (vec2-x pos))
|
|
|
|
(y (vec2-y pos)))
|
|
|
|
(match type
|
|
|
|
('crate (draw-tile context tileset 29 x y))
|
|
|
|
(_ (draw-tile context tileset 3 x y)))
|
2024-05-22 14:42:27 -04:00
|
|
|
(draw-wire-state pos type)))
|
2024-05-20 22:12:35 -04:00
|
|
|
|
|
|
|
(define (draw-clock-emitter pos)
|
|
|
|
(draw-tile context tileset 48 (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
2024-05-21 14:10:57 -04:00
|
|
|
(define (draw-floor-switch pos on?)
|
|
|
|
(draw-tile context tileset (if on? 25 24) (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
|
|
|
(define (draw-gem pos)
|
|
|
|
(draw-tile context tileset 28 (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
2024-05-21 17:28:57 -04:00
|
|
|
(define (draw-gate pos open?)
|
|
|
|
(draw-tile context tileset (if open? 46 45) (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
2024-05-22 14:42:27 -04:00
|
|
|
(define (draw-logic-gate pos state id)
|
|
|
|
(let ((x (vec2-x pos))
|
|
|
|
(y (vec2-y pos)))
|
|
|
|
(draw-tile context tileset 2 x y)
|
|
|
|
(draw-tile context tileset id x y)
|
|
|
|
(draw-wire-state pos state)))
|
2024-05-22 12:07:41 -04:00
|
|
|
|
2024-05-22 08:00:39 -04:00
|
|
|
(define (draw-electric-switch pos on?)
|
|
|
|
(draw-tile context tileset (if on? 7 6) (vec2-x pos) (vec2-y pos)))
|
|
|
|
|
2024-05-22 12:35:56 -04:00
|
|
|
(define (draw-electron-warp pos state)
|
|
|
|
(draw-tile context tileset 71 (vec2-x pos) (vec2-y pos))
|
|
|
|
(draw-wire-state pos state))
|
|
|
|
|
2024-05-20 22:12:35 -04:00
|
|
|
(define (draw-object obj)
|
|
|
|
(match obj
|
|
|
|
(#f #f)
|
|
|
|
(('player pos) (draw-player pos))
|
2024-05-22 08:00:39 -04:00
|
|
|
(('exit pos) #t) ; drawn via background
|
2024-05-21 22:12:21 -04:00
|
|
|
(('wall pos type) (draw-wall pos type))
|
|
|
|
(('block pos type) (draw-block pos type))
|
2024-05-22 08:00:39 -04:00
|
|
|
(('clock-emitter pos) #t) ; drawn via background
|
2024-05-21 14:10:57 -04:00
|
|
|
(('floor-switch pos on?) (draw-floor-switch pos on?))
|
2024-05-21 17:28:57 -04:00
|
|
|
(('gem pos) (draw-gem pos))
|
2024-05-22 08:00:39 -04:00
|
|
|
(('gate pos open?) (draw-gate pos open?))
|
2024-05-22 14:42:27 -04:00
|
|
|
(('and-gate pos state) (draw-logic-gate pos state 42))
|
|
|
|
(('or-gate pos state) (draw-logic-gate pos state 43))
|
|
|
|
(('xor-gate pos state) (draw-logic-gate pos state 44))
|
2024-05-22 12:35:56 -04:00
|
|
|
(('electric-switch pos on?) (draw-electric-switch pos on?))
|
|
|
|
(('electron-warp pos state) (draw-electron-warp pos state))))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
2024-05-19 17:30:36 -04:00
|
|
|
(define (draw-background)
|
2024-05-22 14:22:27 -04:00
|
|
|
(let ((bg (level-background *level*))
|
|
|
|
(k (* level-width level-height)))
|
|
|
|
(do ((i 0 (1+ i)))
|
|
|
|
((= i k))
|
|
|
|
(let* ((tile (vector-ref bg i))
|
|
|
|
(pos (level-tile-position tile))
|
|
|
|
(id (level-tile-id tile)))
|
|
|
|
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
|
2024-05-19 17:30:36 -04:00
|
|
|
|
2024-05-18 14:04:35 -04:00
|
|
|
(define (draw-level)
|
2024-05-19 17:30:36 -04:00
|
|
|
(draw-background)
|
2024-05-20 22:12:35 -04:00
|
|
|
(for-each draw-object *objects*))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
2024-05-20 13:34:59 -04:00
|
|
|
(define (draw-win)
|
|
|
|
(set-fill-color! context "#x000000")
|
|
|
|
(fill-text context "OMG YOU DID IT WOW CONGRATS" 32.0 120.0))
|
|
|
|
|
2024-05-18 14:04:35 -04:00
|
|
|
(define (draw prev-time)
|
|
|
|
(clear-rect context 0.0 0.0 *canvas-width* *canvas-height*)
|
|
|
|
(set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
|
|
|
|
(set-scale! context *canvas-scale* *canvas-scale*)
|
2024-05-20 13:34:59 -04:00
|
|
|
(match *state*
|
|
|
|
('play (draw-level))
|
|
|
|
('win (draw-win)))
|
2024-05-17 13:08:43 -04:00
|
|
|
(request-animation-frame draw-callback))
|
|
|
|
(define draw-callback (procedure->external draw))
|
|
|
|
|
|
|
|
;; Input
|
|
|
|
(define key:left "ArrowLeft")
|
|
|
|
(define key:right "ArrowRight")
|
2024-05-18 14:04:35 -04:00
|
|
|
(define key:down "ArrowDown")
|
|
|
|
(define key:up "ArrowUp")
|
2024-05-17 13:08:43 -04:00
|
|
|
(define key:confirm "Enter")
|
2024-05-18 18:51:45 -04:00
|
|
|
(define key:undo "KeyZ")
|
2024-05-17 13:08:43 -04:00
|
|
|
|
|
|
|
(define (on-key-down event)
|
|
|
|
(let ((key (keyboard-event-code event)))
|
2024-05-20 12:15:39 -04:00
|
|
|
(pk 'key-down key)
|
2024-05-20 13:34:59 -04:00
|
|
|
(match *state*
|
|
|
|
('play
|
|
|
|
(cond
|
|
|
|
((string=? key key:left)
|
|
|
|
(move-player 'left))
|
|
|
|
((string=? key key:right)
|
|
|
|
(move-player 'right))
|
|
|
|
((string=? key key:up)
|
|
|
|
(move-player 'up))
|
|
|
|
((string=? key key:down)
|
|
|
|
(move-player 'down))
|
|
|
|
((string=? key key:undo)
|
|
|
|
(rollback-snapshot!)
|
2024-05-21 14:10:57 -04:00
|
|
|
(with-goblins (update-objects!)))
|
|
|
|
;; REMOVE BEFORE RELEASE!!!!
|
|
|
|
((string=? key key:confirm)
|
|
|
|
(next-level!))))
|
2024-05-20 13:34:59 -04:00
|
|
|
('win
|
|
|
|
(cond
|
|
|
|
((string=? key key:confirm)
|
|
|
|
(reset-game!)))))))
|
2024-05-17 13:08:43 -04:00
|
|
|
|
|
|
|
;; Canvas and event loop setup
|
|
|
|
(define canvas (get-element-by-id "canvas"))
|
|
|
|
(define context (get-context canvas "2d"))
|
2024-05-18 14:04:35 -04:00
|
|
|
|
|
|
|
(define (resize-canvas)
|
|
|
|
(let* ((win (current-window))
|
|
|
|
(w (window-inner-width win))
|
|
|
|
(h (window-inner-height win))
|
|
|
|
(gw (inexact->exact game-width))
|
|
|
|
(gh (inexact->exact 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* (exact->inexact scale))
|
|
|
|
(set! *canvas-width* (* game-width *canvas-scale*))
|
|
|
|
(set! *canvas-height* (* game-height *canvas-scale*))
|
|
|
|
(pk 'resize-canvas *canvas-scale* *canvas-width* *canvas-height*)))
|
|
|
|
|
2024-05-17 17:49:43 -04:00
|
|
|
(set-element-width! canvas (inexact->exact game-width))
|
|
|
|
(set-element-height! canvas (inexact->exact game-height))
|
2024-05-18 14:04:35 -04:00
|
|
|
(add-event-listener! (current-window) "resize"
|
|
|
|
(procedure->external (lambda (_) (resize-canvas))))
|
2024-05-17 13:08:43 -04:00
|
|
|
(add-event-listener! (current-document) "keydown"
|
|
|
|
(procedure->external on-key-down))
|
2024-05-18 14:04:35 -04:00
|
|
|
(resize-canvas)
|
2024-05-17 13:08:43 -04:00
|
|
|
(request-animation-frame draw-callback)
|
|
|
|
(timeout update-callback dt)
|
2024-05-20 22:12:35 -04:00
|
|
|
(load-game!)
|