diff --git a/Makefile b/Makefile index 8a546b9..31f1b94 100644 --- a/Makefile +++ b/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 diff --git a/assets/images/cirkoban.png b/assets/images/cirkoban.png index 9405282..d1037b6 100644 Binary files a/assets/images/cirkoban.png and b/assets/images/cirkoban.png differ diff --git a/game.scm b/game.scm index cc79d02..b916074 100644 --- a/game.scm +++ b/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))) diff --git a/game.wasm b/game.wasm deleted file mode 100644 index 0e4ad3a..0000000 Binary files a/game.wasm and /dev/null differ diff --git a/modules/game/tileset.scm b/modules/game/tileset.scm new file mode 100644 index 0000000..8061446 --- /dev/null +++ b/modules/game/tileset.scm @@ -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 + (%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 + (($ 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)))))