2024-05-20 16:52:29 +02:00
|
|
|
;; Game state and logic for the hero entity
|
|
|
|
(define-module (game model hero)
|
2024-05-21 17:52:30 +02:00
|
|
|
#: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)
|
2024-05-20 19:49:32 +02:00
|
|
|
#:use-module (chickadee math vector)
|
2024-05-21 17:52:30 +02:00
|
|
|
#:use-module (game util pipe)
|
2024-05-21 12:48:43 +02:00
|
|
|
#:use-module (game model level)
|
2024-05-22 09:41:39 +02:00
|
|
|
#: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
|
2024-05-22 09:41:39 +02:00
|
|
|
hero-position
|
|
|
|
hero-x
|
|
|
|
hero-y
|
2024-05-21 17:52:30 +02:00
|
|
|
hero-update
|
2024-05-20 19:49:32 +02:00
|
|
|
))
|
|
|
|
|
|
|
|
|
2024-05-20 16:52:29 +02:00
|
|
|
(define-immutable-record-type <hero>
|
2024-05-22 09:41:39 +02:00
|
|
|
(%make-hero runner bloat)
|
2024-05-20 16:52:29 +02:00
|
|
|
hero?
|
2024-05-22 09:41:39 +02:00
|
|
|
(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)
|
2024-05-22 09:41:39 +02:00
|
|
|
"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"
|
2024-05-22 09:41:39 +02:00
|
|
|
(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"
|
2024-05-22 09:41:39 +02:00
|
|
|
(runner-y (hero-runner hero))
|
|
|
|
)
|
2024-05-21 17:52:30 +02:00
|
|
|
|
2024-05-22 09:41:39 +02:00
|
|
|
(define (hero-state hero)
|
|
|
|
"return the current state of the hero"
|
|
|
|
(runner-state (hero-runner hero)))
|
2024-05-21 17:52:30 +02:00
|
|
|
|
2024-05-22 09:41:39 +02:00
|
|
|
(define (hero-position hero)
|
|
|
|
"return the current position of the hero"
|
|
|
|
(runner-position (hero-runner hero)))
|
2024-05-21 17:52:30 +02:00
|
|
|
|
2024-05-21 14:18:47 +02:00
|
|
|
|
2024-05-21 17:52:30 +02:00
|
|
|
(define (hero-update hero level inputs dt)
|
2024-05-22 09:41:39 +02:00
|
|
|
(hero-with-runner hero (runner-update (hero-runner hero) level inputs dt)))
|
2024-05-21 17:52:30 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
2024-05-20 16:52:29 +02:00
|
|
|
;; Tests
|
2024-05-22 12:53:01 +02:00
|
|
|
(test-begin "hero-model")
|
2024-05-20 16:52:29 +02:00
|
|
|
|
2024-05-21 17:52:30 +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)))
|
2024-05-22 12:53:01 +02:00
|
|
|
(test-equal default-bloat (hero-bloat hero)))
|
|
|
|
|
|
|
|
(test-end "hero-model")
|
2024-05-20 16:52:29 +02:00
|
|
|
|