bloatrunner/game/model/hero.scm

95 lines
2.9 KiB
Scheme
Raw Normal View History

2024-05-20 16:52:29 +02:00
;; Game state and logic for the hero entity
(define-module (game model hero)
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1)
2024-05-20 16:52:29 +02:00
#: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)
2024-05-21 12:48:43 +02:00
#:use-module (game model level)
#:use-module (game model runner)
2024-05-20 16:52:29 +02:00
#:export (hero-load
2024-05-21 14:18:47 +02:00
hero-state
hero-bloat
hero-position
hero-x
hero-y
hero-update
))
2024-05-20 16:52:29 +02:00
(define-immutable-record-type <hero>
(%make-hero runner bloat)
2024-05-20 16:52:29 +02:00
hero?
(runner hero-runner hero-with-runner)
2024-05-20 16:52:29 +02:00
(bloat hero-bloat hero-with-bloat) ;; 0.0 to 2.0, how much the hero is inflated
)
2024-05-21 20:59:48 +02:00
(define default-state 'fall)
2024-05-20 16:52:29 +02:00
(define default-bloat 1.0)
2024-05-21 12:48:43 +02:00
(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-bloat)))
2024-05-20 16:52:29 +02:00
2024-05-21 13:36:48 +02:00
(define (hero-x hero)
2024-05-21 14:18:47 +02:00
"return the x coordinate as an integer"
(runner-x (hero-runner hero)))
2024-05-21 14:18:47 +02:00
2024-05-21 13:36:48 +02:00
(define (hero-y hero)
2024-05-21 14:18:47 +02:00
"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 (collides? a b)
"return true if the hero collides with the given position"
(< (vec2-magnitude (vec2- a b)) level-cell-size))
2024-05-21 14:18:47 +02:00
(define (blocked-by-door? level keys position)
"return true if the hero is blocked by a door"
(let ((door-position (level-find-goal level)))
(pk 'blocked-by-door? keys (null? keys) position
(and (collides? position door-position)
(not (null? keys))))))
(define (hero-update hero level inputs keys dt)
(let ((new-runner (runner-update (hero-runner hero) level inputs dt)))
(if (blocked-by-door? level keys (runner-position new-runner))
hero
(hero-with-runner hero new-runner)
)))
2024-05-20 16:52:29 +02:00
;; Tests
(test-begin "hero-model")
2024-05-20 16:52:29 +02:00
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n"))
2024-05-21 12:48:43 +02:00
(hero (hero-load level))
(default-position (level-find-hero level)))
(test-assert (hero? hero))
(test-equal default-bloat (hero-bloat hero))
2024-05-20 16:52:29 +02:00
(test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5)))
(test-equal default-bloat (hero-bloat 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")
2024-05-20 16:52:29 +02:00