diff --git a/game/main.scm b/game/main.scm index 0149b59..8501495 100644 --- a/game/main.scm +++ b/game/main.scm @@ -31,13 +31,11 @@ (define (update dt) (poll-coop-repl-server repl) (set! hero - (hero-with-position - hero - (set-vec2-x! - (hero-position hero) - (floor-remainder - (+ (vec2-x (hero-position hero)) - (* 50.0 dt)) 608.0))))) + (hero-with-x + hero + (floor-remainder + (+ (hero-x hero) (* 50.0 dt)) + 608.0)))) (define (draw _alpha) (render-level-draw level) diff --git a/game/model/hero.scm b/game/model/hero.scm index 61f8834..b382a92 100644 --- a/game/model/hero.scm +++ b/game/model/hero.scm @@ -6,11 +6,11 @@ #:use-module (chickadee math vector) #:use-module (game model level) #:export (hero-load - hero-x hero-with-x - hero-y hero-with-y hero-state hero-with-state hero-bloat hero-with-bloat hero-position hero-with-position + hero-x hero-with-x + hero-y hero-with-y )) @@ -29,6 +29,17 @@ (let ((initial-position (level-find-hero level))) (%make-hero initial-position default-state default-bloat))) +(define (hero-x hero) + (inexact->exact (floor (vec2-x (hero-position hero))))) +(define (hero-y hero) + (inexact->exact (floor (vec2-y (hero-position hero))))) + +(define (hero-with-x hero x) + (hero-with-position hero (vec2 x (hero-y hero)))) + +(define (hero-with-y hero y) + (hero-with-position hero (vec2 (hero-x hero) y))) + ;; Tests [test-begin "hero model"] @@ -45,6 +56,10 @@ (test-equal 'go-left (hero-state (hero-with-state hero 'go-left))) (test-equal default-state (hero-state hero)) (test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5))) - (test-equal default-bloat (hero-bloat hero))) + (test-equal default-bloat (hero-bloat hero)) + + (test-equal 16 (hero-x (hero-with-position hero (vec2 16.34 20.78)))) + (test-equal 20 (hero-y (hero-with-position hero (vec2 16.34 20.78)))) + ) (test-end "hero model") diff --git a/game/model/level.scm b/game/model/level.scm index 7a893c3..56b2823 100644 --- a/game/model/level.scm +++ b/game/model/level.scm @@ -127,6 +127,7 @@ (level-tiles (level-parse "--- ignore this line\nWWWWW\nWP GW - must be ignored\nWWWWW\n")) #(wall wall wall wall wall wall hero empty goal wall wall wall wall wall wall)) +;; regression test for character parsing (test-equal (parse-tile #\W) 'wall) (test-equal (parse-tile #\B) 'brick) (test-equal (parse-tile #\H) 'ladder)