Add basic undo with Z key.
This commit is contained in:
parent
de7078ef85
commit
9b6ed8ba71
5 changed files with 99 additions and 42 deletions
15
Makefile
15
Makefile
|
@ -7,9 +7,20 @@ modules = \
|
|||
modules/dom/media.scm \
|
||||
modules/dom/window.scm \
|
||||
modules/game/actors.scm \
|
||||
modules/game/tileset.scm \
|
||||
modules/goblins/abstract-types.scm \
|
||||
modules/goblins/core.scm \
|
||||
modules/goblins/core-types.scm \
|
||||
modules/goblins/ghash.scm \
|
||||
modules/guile/list.scm \
|
||||
modules/ice-9/control.scm \
|
||||
modules/ice-9/q.scm \
|
||||
modules/ice-9/vlist.scm \
|
||||
modules/math.scm \
|
||||
modules/math/rect.scm \
|
||||
modules/math/vector.scm
|
||||
modules/math/vector.scm \
|
||||
modules/srfi/srfi-9.scm \
|
||||
modules/srfi/srfi-11.scm
|
||||
|
||||
game.wasm: game.scm $(modules)
|
||||
guild compile-wasm -L modules -o $@ $<
|
||||
|
@ -19,7 +30,7 @@ serve: game.wasm
|
|||
|
||||
bundle: game.wasm
|
||||
rm game.zip || true
|
||||
zip game.zip -r assets/ js-runtime/ game.js game.css game.wasm index.html
|
||||
zip game.zip -r assets/ reflect.js game.js game.css reflect.wasm wtf8.wasm game.wasm index.html
|
||||
|
||||
clean:
|
||||
rm -f game.wasm game.zip
|
||||
|
|
Binary file not shown.
Before Width: | Height: | Size: 1.3 KiB After Width: | Height: | Size: 1.6 KiB |
79
game.scm
79
game.scm
|
@ -26,6 +26,7 @@
|
|||
(dom media)
|
||||
(dom window)
|
||||
(game actors)
|
||||
(game tileset)
|
||||
(goblins core)
|
||||
(hoot ffi)
|
||||
(hoot hashtables)
|
||||
|
@ -45,7 +46,11 @@
|
|||
(define *canvas-width* 0)
|
||||
(define *canvas-height* 0)
|
||||
|
||||
(define image:tiles (make-image "assets/images/cirkoban.png"))
|
||||
(define tileset
|
||||
(make-tileset (make-image "assets/images/cirkoban.png")
|
||||
320 240
|
||||
(inexact->exact tile-width)
|
||||
(inexact->exact tile-height)))
|
||||
|
||||
;; Game state
|
||||
(define *actormap* (make-whactormap))
|
||||
|
@ -63,6 +68,12 @@
|
|||
(set! *snapshots* '()))
|
||||
(define (save-snapshot!)
|
||||
(set! *snapshots* (cons (copy-whactormap *actormap*) *snapshots*)))
|
||||
(define (rollback-snapshot!)
|
||||
(match *snapshots*
|
||||
(() #f)
|
||||
((snapshot . older-snapshots)
|
||||
(set! *actormap* snapshot)
|
||||
(set! *snapshots* older-snapshots))))
|
||||
|
||||
(define (update-grid!)
|
||||
(set! *grid* ($ *level* 'describe)))
|
||||
|
@ -76,11 +87,10 @@
|
|||
|
||||
;; Update loop
|
||||
(define (move-player dir)
|
||||
(save-snapshot!)
|
||||
(with-goblins
|
||||
($ *level* 'move-player dir)
|
||||
(update-grid!))
|
||||
;; (save-snapshot!)
|
||||
)
|
||||
(update-grid!)))
|
||||
|
||||
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
|
||||
(define (update)
|
||||
|
@ -98,58 +108,43 @@
|
|||
str)))))
|
||||
|
||||
(define (draw-player x y)
|
||||
(draw-image context image:tiles
|
||||
0.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 0 x y))
|
||||
|
||||
(define (draw-wall type x y)
|
||||
(match type
|
||||
('brick
|
||||
(draw-image context image:tiles
|
||||
32.0 16.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 22 x y))
|
||||
(_
|
||||
(draw-image context image:tiles
|
||||
48.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height)))
|
||||
(draw-tile context tileset 2 x y)))
|
||||
(match type
|
||||
('electron-head
|
||||
(draw-image context image:tiles
|
||||
64.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 4 x y))
|
||||
('electron-tail
|
||||
(draw-image context image:tiles
|
||||
80.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 5 x y))
|
||||
(_ #f)))
|
||||
|
||||
(define (draw-block type x y)
|
||||
(draw-image context image:tiles
|
||||
32.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height)
|
||||
(draw-tile context tileset 3 x y)
|
||||
(match type
|
||||
('electron-head
|
||||
(draw-image context image:tiles
|
||||
64.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 4 x y))
|
||||
('electron-tail
|
||||
(draw-image context image:tiles
|
||||
80.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 5 x y))
|
||||
(_ #f)))
|
||||
|
||||
(define (draw-clock-emitter x y)
|
||||
(draw-image context image:tiles
|
||||
48.0 0.0 tile-width tile-height
|
||||
(* x tile-width) (* y tile-height) tile-width tile-height))
|
||||
(draw-tile context tileset 2 x y))
|
||||
|
||||
(define (draw-tile x y obj)
|
||||
(match obj
|
||||
(#f #f)
|
||||
(('player) (draw-player x y))
|
||||
(('wall type) (draw-wall type x y))
|
||||
(('block type) (draw-block type x y))
|
||||
(('clock-emitter) (draw-clock-emitter x y))))
|
||||
(define (draw-object x y obj)
|
||||
(and obj
|
||||
(let ((x (* x tile-width))
|
||||
(y (* y tile-height)))
|
||||
(match obj
|
||||
(#f #f)
|
||||
(('player) (draw-player x y))
|
||||
(('wall type) (draw-wall type x y))
|
||||
(('block type) (draw-block type x y))
|
||||
(('clock-emitter) (draw-clock-emitter x y))))))
|
||||
|
||||
(define (draw-level)
|
||||
(let ((grid *grid*))
|
||||
|
@ -157,7 +152,7 @@
|
|||
(when (< y level-height)
|
||||
(let x-loop ((x 0))
|
||||
(when (< x level-width)
|
||||
(draw-tile x y (vector-ref grid (+ (* y level-width) x)))
|
||||
(draw-object x y (vector-ref grid (+ (* y level-width) x)))
|
||||
(x-loop (1+ x))))
|
||||
(y-loop (1+ y))))))
|
||||
|
||||
|
@ -177,6 +172,7 @@
|
|||
(define key:down "ArrowDown")
|
||||
(define key:up "ArrowUp")
|
||||
(define key:confirm "Enter")
|
||||
(define key:undo "KeyZ")
|
||||
|
||||
(define (on-key-down event)
|
||||
(let ((key (keyboard-event-code event)))
|
||||
|
@ -188,7 +184,10 @@
|
|||
((string=? key key:up)
|
||||
(move-player 'up))
|
||||
((string=? key key:down)
|
||||
(move-player 'down)))))
|
||||
(move-player 'down))
|
||||
((string=? key key:undo)
|
||||
(rollback-snapshot!)
|
||||
(with-goblins (update-grid!))))))
|
||||
|
||||
(define (on-key-up event)
|
||||
(let ((key (keyboard-event-code event)))
|
||||
|
|
BIN
game.wasm
BIN
game.wasm
Binary file not shown.
47
modules/game/tileset.scm
Normal file
47
modules/game/tileset.scm
Normal file
|
@ -0,0 +1,47 @@
|
|||
(define-module (game tileset)
|
||||
#:use-module (dom canvas)
|
||||
#:use-module (dom image)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (math rect)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:export (make-tileset
|
||||
tileset?
|
||||
tileset-image
|
||||
tileset-tile-width
|
||||
tileset-tile-height
|
||||
draw-tile))
|
||||
|
||||
(define-record-type <tileset>
|
||||
(%make-tileset image tile-width tile-height tiles)
|
||||
tileset?
|
||||
(image tileset-image)
|
||||
(tile-width tileset-tile-width)
|
||||
(tile-height tileset-tile-height)
|
||||
(tiles tileset-tiles))
|
||||
|
||||
(define (make-tileset image width height tile-width tile-height)
|
||||
(let* ((w (quotient width tile-width))
|
||||
(h (quotient height tile-height))
|
||||
(tiles (make-vector (* w h))))
|
||||
(let y-loop ((y 0))
|
||||
(when (< y h)
|
||||
(let x-loop ((x 0))
|
||||
(when (< x w)
|
||||
(vector-set! tiles (+ (* y w) x)
|
||||
(make-rect (* x tile-width)
|
||||
(* y tile-height)
|
||||
tile-width
|
||||
tile-height))
|
||||
(x-loop (1+ x))))
|
||||
(y-loop (1+ y))))
|
||||
(%make-tileset image tile-width tile-height tiles)))
|
||||
|
||||
(define (draw-tile context tileset idx x y)
|
||||
(match tileset
|
||||
(($ <tileset> image _ _ tiles)
|
||||
(let* ((tile (vector-ref tiles idx))
|
||||
(sx (rect-x tile))
|
||||
(sy (rect-y tile))
|
||||
(w (rect-width tile))
|
||||
(h (rect-height tile)))
|
||||
(draw-image context image sx sy w h x y w h)))))
|
Loading…
Add table
Reference in a new issue