From e7e5413460331efc103dc3d63d04ad7c16aa88f7 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 19 May 2024 06:15:27 -0400 Subject: [PATCH] Add exit actor that doesn't really work yet. --- game.scm | 14 ++++++++++++-- modules/game/actors.scm | 30 ++++++++++++++++++++++-------- 2 files changed, 34 insertions(+), 10 deletions(-) diff --git a/game.scm b/game.scm index b916074..8389e61 100644 --- a/game.scm +++ b/game.scm @@ -46,11 +46,13 @@ (define *canvas-width* 0) (define *canvas-height* 0) +;; Assets (define tileset (make-tileset (make-image "assets/images/cirkoban.png") 320 240 (inexact->exact tile-width) (inexact->exact tile-height))) +(define audio:bump (make-audio "assets/sounds/bump.wav")) ;; Game state (define *actormap* (make-whactormap)) @@ -89,7 +91,9 @@ (define (move-player dir) (save-snapshot!) (with-goblins - ($ *level* 'move-player dir) + (match ($ *level* 'move-player dir) + (#f (media-play audio:bump)) + (_ #f)) (update-grid!))) (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz @@ -110,6 +114,9 @@ (define (draw-player 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) (match type ('brick @@ -142,6 +149,7 @@ (match obj (#f #f) (('player) (draw-player x y)) + (('exit) (draw-exit x y)) (('wall type) (draw-wall type x y)) (('block type) (draw-block type x y)) (('clock-emitter) (draw-clock-emitter x y)))))) @@ -187,7 +195,9 @@ (move-player 'down)) ((string=? key key:undo) (rollback-snapshot!) - (with-goblins (update-grid!)))))) + (with-goblins (update-grid!))) + ((string=? key key:confirm) + (reset-game!))))) (define (on-key-up event) (let ((key (keyboard-event-code event))) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 25c9951..490dd05 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -1,5 +1,4 @@ (define-module (game actors) - #:use-module (dom canvas) #:use-module (goblins core) #:use-module (ice-9 match) #:export (^cell @@ -11,6 +10,14 @@ ((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) (match-lambda* (('tick) #f) @@ -100,6 +107,7 @@ (occupant (match ($ occupant 'collide) ('stop #f) + ('goal (pk 'GOAL)) ('displace (let ((next-cell (grid-ref grid (wrap-x (+ x dx)) (wrap-y (+ y dy))))) (match ($ next-cell) @@ -107,7 +115,8 @@ ($ next-cell ($ cell)) ($ cell player) ($ old-cell #f) - ($ player-coords (vector x y))) + ($ player-coords (vector x y)) + 'displace) (_ #f))))))))))) (define (warp-player x y) ($ (grid-ref grid x y) player) @@ -166,6 +175,9 @@ ;; TODO: actually write levels (warp-player 10 8) + + ($ (grid-ref grid 3 7) (spawn ^exit)) + ($ (grid-ref grid 4 4) (spawn ^wall 'brick)) ($ (grid-ref grid 4 3) (spawn ^clock-emitter 3)) @@ -198,9 +210,11 @@ (refr ($ refr 'describe)))))) grid*)) (('move-player dir) - (match dir - ('up (move-player 0 -1)) - ('down (move-player 0 1)) - ('left (move-player -1 0)) - ('right (move-player 1 0))) - (tick)))) + (define result + (match dir + ('up (move-player 0 -1)) + ('down (move-player 0 1)) + ('left (move-player -1 0)) + ('right (move-player 1 0)))) + (tick) + result)))