132 lines
4.3 KiB
Scheme
132 lines
4.3 KiB
Scheme
;; Game state and logic for the hero entity
|
|
(define-module (game model hero)
|
|
#:use-module (ice-9 pretty-print)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (srfi srfi-9 gnu)
|
|
#:use-module (srfi srfi-64)
|
|
#:use-module (chickadee math vector)
|
|
#:use-module (game util pipe)
|
|
#:use-module (game model level)
|
|
#:use-module (game model runner)
|
|
#:export (hero-load
|
|
hero-state
|
|
hero-exercise
|
|
hero-position
|
|
hero-x
|
|
hero-y
|
|
hero-update
|
|
hero-bloat
|
|
hero-collides?
|
|
))
|
|
|
|
|
|
(define-immutable-record-type <hero>
|
|
(%make-hero runner exercise eaten)
|
|
hero?
|
|
(runner hero-runner hero-with-runner)
|
|
(exercise hero-exercise hero-with-exercise) ;; calories-burned
|
|
(eaten hero-eaten hero-with-eaten) ;; calories-eaten
|
|
)
|
|
|
|
(define default-state 'fall)
|
|
(define default-exercise 0)
|
|
(define default-eaten 0)
|
|
|
|
(define (hero-load level)
|
|
"Create a hero at the position in the level map"
|
|
(let ((runner (runner-load (level-find-hero level))))
|
|
(%make-hero runner default-exercise default-eaten)))
|
|
|
|
(define (hero-x hero)
|
|
"return the x coordinate as an integer"
|
|
(runner-x (hero-runner hero)))
|
|
|
|
(define (hero-y hero)
|
|
"return the y coordinate as an integer"
|
|
(runner-y (hero-runner hero))
|
|
)
|
|
|
|
(define (hero-state hero)
|
|
"return the current state of the hero"
|
|
(runner-state (hero-runner hero)))
|
|
|
|
(define (hero-position hero)
|
|
"return the current position of the hero"
|
|
(runner-position (hero-runner hero)))
|
|
|
|
(define (hero-bloat hero)
|
|
"return the current bloat of the hero clamped to 0.5 and 2.0"
|
|
(let* ((calories (- (hero-eaten hero) (hero-exercise hero)))
|
|
(raw-bloat (+ 1.0 (/ calories 2000.0)))
|
|
)
|
|
(cond
|
|
((< calories -1000) 0.5)
|
|
((> calories 1000) 2.0)
|
|
(else raw-bloat)
|
|
)))
|
|
|
|
(define (collides? a b)
|
|
"return true if the position collides with the given position"
|
|
(< (vec2-magnitude (vec2- a b)) level-cell-size))
|
|
|
|
(define (blocked-by-door? level keys position bloat)
|
|
"return true if the hero is blocked by a door"
|
|
(let ((door-position (level-find-goal level)))
|
|
(and (collides? position door-position)
|
|
(not
|
|
(and
|
|
(< 0.5 bloat 1.5) ;; healthy
|
|
(null? keys)))))) ;; all keys collected
|
|
|
|
(define climbing-exercise 0.5)
|
|
(define moving-exercise 0.2)
|
|
|
|
(define (calculate-exercise hero new-position)
|
|
(let ((movement (vec2- new-position (hero-position hero))))
|
|
(+
|
|
(if (> (vec2-y movement) 0) climbing-exercise 0)
|
|
(if (not (zero? (vec2-x movement))) moving-exercise 0))))
|
|
|
|
|
|
(define (hero-update hero level inputs keys calories-eaten dt)
|
|
(let* ((new-runner (runner-update (hero-runner hero) level inputs dt))
|
|
(new-runner (if (blocked-by-door? level keys
|
|
(runner-position new-runner)
|
|
(hero-bloat hero))
|
|
(hero-runner hero)
|
|
new-runner
|
|
))
|
|
(exercise (calculate-exercise hero (runner-position new-runner))))
|
|
(-> hero
|
|
(hero-with-runner new-runner)
|
|
(hero-with-exercise (+ (hero-exercise hero) exercise))
|
|
(hero-with-eaten calories-eaten))))
|
|
|
|
(define (hero-collides? hero position)
|
|
"return true if the hero collides with the given position"
|
|
(collides? (hero-position hero) position))
|
|
|
|
;; Tests
|
|
(test-begin "hero-model")
|
|
|
|
|
|
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n"))
|
|
(hero (hero-load level))
|
|
(default-position (level-find-hero level)))
|
|
(test-assert (hero? hero))
|
|
(test-equal default-exercise (hero-exercise hero))
|
|
|
|
(test-equal 1.5 (hero-exercise (hero-with-exercise hero 1.5)))
|
|
(test-equal default-exercise (hero-exercise hero)))
|
|
|
|
(let* ((level (level-parse "WWGWW\nW.H.W\nW.P.W\nWWWWW\n"))
|
|
(hero (hero-load level))
|
|
(goal-position (level-find-goal level)))
|
|
(test-assert (blocked-by-door? level '(dummy-key) goal-position))
|
|
(test-assert (not (blocked-by-door? level '() goal-position)))
|
|
(test-assert (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -15))))
|
|
(test-assert (not (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -16))))))
|
|
|
|
(test-end "hero-model")
|
|
|