add x/y accessors to hero

This commit is contained in:
Peter Tillemans 2024-05-21 13:36:48 +02:00
parent 8dcf58661b
commit ca177bd570
3 changed files with 24 additions and 10 deletions

View file

@ -31,13 +31,11 @@
(define (update dt)
(poll-coop-repl-server repl)
(set! hero
(hero-with-position
(hero-with-x
hero
(set-vec2-x!
(hero-position hero)
(floor-remainder
(+ (vec2-x (hero-position hero))
(* 50.0 dt)) 608.0)))))
(floor-remainder
(+ (hero-x hero) (* 50.0 dt))
608.0))))
(define (draw _alpha)
(render-level-draw level)

View file

@ -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")

View file

@ -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)