SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for more objects to map editor.

Browse source
This commit is contained in:
David Thompson 2024-05-20 12:15:39 -04:00
parent 3f24b3bd89
commit 111f4d37f1
9 changed files with 151 additions and 107 deletions
Download patch file Download diff file Expand all files Collapse all files

27
game.scm
View file

@ -26,6 +26,7 @@
(dom media)
(dom window)
(game actors)
(game level)
(game levels level-1)
(game tileset)
(goblins core)
@ -54,7 +55,7 @@
320 240
(inexact->exact tile-width)
(inexact->exact tile-height)))
(define* (load-sound-effect name #:key (volume 0.5))
(define* (load-sound-effect name #:key (volume 0.25))
(let ((audio (make-audio (string-append "assets/sounds/" name ".wav"))))
(set-media-volume! audio volume)
audio))
@ -62,6 +63,7 @@
(define audio:push (load-sound-effect "push"))
(define audio:undo (load-sound-effect "undo"))
(define audio:no (load-sound-effect "no"))
(define audio:exit (load-sound-effect "exit"))
;; Game state
(define *actormap* (make-whactormap))
@ -73,8 +75,6 @@
(define *level* #f)
;; Latest representation of all actors in level
(define *grid* #f)
;; Background tile layer.
(define *background* #f)
(define *snapshots* '())
(define (clear-snapshots!)
@ -90,25 +90,23 @@
(media-play audio:undo))))
(define (update-grid!)
(set! *grid* ($ *level* 'describe)))
(set! *grid* ($ (level-actor *level*) 'describe)))
(define (reset-game!)
(set! *actormap* (make-whactormap))
(clear-snapshots!)
(with-goblins
(call-with-values load-level-1
(lambda (background level)
(set! *background* background)
(set! *level* level)))
(set! *level* (load-level-1))
(update-grid!)))
;; Update loop
(define (move-player dir)
(save-snapshot!)
(with-goblins
(match ($ *level* 'move-player dir)
(match ($ (level-actor *level*) 'move-player dir)
('bump (media-play audio:bump))
('push (media-play audio:push))
('exit (media-play audio:exit))
(_ #f))
(update-grid!)))
@ -156,7 +154,7 @@
(_ #f)))
(define (draw-clock-emitter x y)
(draw-tile context tileset 2 x y))
(draw-tile context tileset 48 x y))
(define (draw-object x y obj)
(and obj
@ -171,7 +169,7 @@
(('clock-emitter) (draw-clock-emitter x y))))))
(define (draw-background)
(let* ((bv *background*)
(let* ((bv (level-background *level*))
(len (bytevector-length bv)))
(let lp ((i 0))
(when (< i len)
@ -210,6 +208,7 @@
(define (on-key-down event)
(let ((key (keyboard-event-code event)))
(pk 'key-down key)
(cond
((string=? key key:left)
(move-player 'left))
@ -225,10 +224,6 @@
((string=? key key:confirm)
(reset-game!)))))
(define (on-key-up event)
(let ((key (keyboard-event-code event)))
(pk 'key-up key)))
;; Canvas and event loop setup
(define canvas (get-element-by-id "canvas"))
(define context (get-context canvas "2d"))
@ -256,8 +251,6 @@
(procedure->external (lambda (_) (resize-canvas))))
(add-event-listener! (current-document) "keydown"
(procedure->external on-key-down))
(add-event-listener! (current-document) "keyup"
(procedure->external on-key-up))
(resize-canvas)
(request-animation-frame draw-callback)
(timeout update-callback dt)