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

Add exit actor that doesn't really work yet.

Browse source
This commit is contained in:
David Thompson 2024-05-19 06:15:27 -04:00
parent a01fdd8983
commit e7e5413460
2 changed files with 34 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
game.scm
View file

@ -46,11 +46,13 @@
(define *canvas-width* 0) (define *canvas-width* 0)
(define *canvas-height* 0) (define *canvas-height* 0)
;; Assets
(define tileset (define tileset
(make-tileset (make-image "assets/images/cirkoban.png") (make-tileset (make-image "assets/images/cirkoban.png")
320 240 320 240
(inexact->exact tile-width) (inexact->exact tile-width)
(inexact->exact tile-height))) (inexact->exact tile-height)))
(define audio:bump (make-audio "assets/sounds/bump.wav"))
;; Game state ;; Game state
(define *actormap* (make-whactormap)) (define *actormap* (make-whactormap))
@ -89,7 +91,9 @@
(define (move-player dir) (define (move-player dir)
(save-snapshot!) (save-snapshot!)
(with-goblins (with-goblins
($ *level* 'move-player dir) (match ($ *level* 'move-player dir)
(#f (media-play audio:bump))
(_ #f))
(update-grid!))) (update-grid!)))
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
@ -110,6 +114,9 @@
(define (draw-player x y) (define (draw-player x y)
(draw-tile context tileset 0 x y)) (draw-tile context tileset 0 x y))
(define (draw-exit x y)
(draw-tile context tileset 27 x y))
(define (draw-wall type x y) (define (draw-wall type x y)
(match type (match type
('brick ('brick
@ -142,6 +149,7 @@
(match obj (match obj
(#f #f) (#f #f)
(('player) (draw-player x y)) (('player) (draw-player x y))
(('exit) (draw-exit x y))
(('wall type) (draw-wall type x y)) (('wall type) (draw-wall type x y))
(('block type) (draw-block type x y)) (('block type) (draw-block type x y))
(('clock-emitter) (draw-clock-emitter x y)))))) (('clock-emitter) (draw-clock-emitter x y))))))
@ -187,7 +195,9 @@
(move-player 'down)) (move-player 'down))
((string=? key key:undo) ((string=? key key:undo)
(rollback-snapshot!) (rollback-snapshot!)
(with-goblins (update-grid!)))))) (with-goblins (update-grid!)))
((string=? key key:confirm)
(reset-game!)))))
(define (on-key-up event) (define (on-key-up event)
(let ((key (keyboard-event-code event))) (let ((key (keyboard-event-code event)))

22
modules/game/actors.scm
View file

@ -1,5 +1,4 @@
(define-module (game actors) (define-module (game actors)
#:use-module (dom canvas)
#:use-module (goblins core) #:use-module (goblins core)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (^cell #:export (^cell
@ -11,6 +10,14 @@
((new-val) ((new-val)
(bcom (^cell bcom new-val))))) (bcom (^cell bcom new-val)))))
(define (^exit bcom)
(match-lambda*
(('tick) #f)
(('wire-state) #f)
(('set-wire-state) #f)
(('describe) '(exit))
(('collide) 'goal)))
(define (^wall bcom type) (define (^wall bcom type)
(match-lambda* (match-lambda*
(('tick) #f) (('tick) #f)
@ -100,6 +107,7 @@
(occupant (occupant
(match ($ occupant 'collide) (match ($ occupant 'collide)
('stop #f) ('stop #f)
('goal (pk 'GOAL))
('displace ('displace
(let ((next-cell (grid-ref grid (wrap-x (+ x dx)) (wrap-y (+ y dy))))) (let ((next-cell (grid-ref grid (wrap-x (+ x dx)) (wrap-y (+ y dy)))))
(match ($ next-cell) (match ($ next-cell)
@ -107,7 +115,8 @@
($ next-cell ($ cell)) ($ next-cell ($ cell))
($ cell player) ($ cell player)
($ old-cell #f) ($ old-cell #f)
($ player-coords (vector x y))) ($ player-coords (vector x y))
'displace)
(_ #f))))))))))) (_ #f)))))))))))
(define (warp-player x y) (define (warp-player x y)
($ (grid-ref grid x y) player) ($ (grid-ref grid x y) player)
@ -166,6 +175,9 @@
;; TODO: actually write levels ;; TODO: actually write levels
(warp-player 10 8) (warp-player 10 8)
($ (grid-ref grid 3 7) (spawn ^exit))
($ (grid-ref grid 4 4) (spawn ^wall 'brick)) ($ (grid-ref grid 4 4) (spawn ^wall 'brick))
($ (grid-ref grid 4 3) (spawn ^clock-emitter 3)) ($ (grid-ref grid 4 3) (spawn ^clock-emitter 3))
@ -198,9 +210,11 @@
(refr ($ refr 'describe)))))) (refr ($ refr 'describe))))))
grid*)) grid*))
(('move-player dir) (('move-player dir)
(define result
(match dir (match dir
('up (move-player 0 -1)) ('up (move-player 0 -1))
('down (move-player 0 1)) ('down (move-player 0 1))
('left (move-player -1 0)) ('left (move-player -1 0))
('right (move-player 1 0))) ('right (move-player 1 0))))
(tick)))) (tick)
result)))