bloatrunner/game/model/hero.scm

72 lines
2.3 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 (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-64)
#:use-module (chickadee math vector)
2024-05-21 12:48:43 +02:00
#:use-module (game model level)
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-21 12:48:43 +02:00
hero-position hero-with-position
2024-05-21 13:36:48 +02:00
hero-x hero-with-x
hero-y hero-with-y
))
2024-05-20 16:52:29 +02:00
(define-immutable-record-type <hero>
2024-05-21 12:48:43 +02:00
(%make-hero position state bloat)
2024-05-20 16:52:29 +02:00
hero?
2024-05-21 12:48:43 +02:00
(position hero-position hero-with-position)
2024-05-20 16:52:29 +02:00
(state hero-state hero-with-state) ;; 'go-left 'go-right 'climb 'fall 'stationary
(bloat hero-bloat hero-with-bloat) ;; 0.0 to 2.0, how much the hero is inflated
)
(define default-state 'stationary)
(define default-bloat 1.0)
2024-05-21 12:48:43 +02:00
(define (hero-load level)
(let ((initial-position (level-find-hero level)))
(%make-hero initial-position default-state 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-21 13:36:48 +02:00
(inexact->exact (floor (vec2-x (hero-position 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-21 13:36:48 +02:00
(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)))
2024-05-21 14:18:47 +02:00
(define speed 50.0)
2024-05-20 16:52:29 +02:00
;; Tests
[test-begin "hero model"]
2024-05-21 12:48:43 +02:00
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW...W\nWWWWW\n"))
(hero (hero-load level))
(default-position (level-find-hero level)))
(test-assert (hero? hero))
(test-equal default-position (hero-position hero))
(test-equal default-state (hero-state hero))
(test-equal default-bloat (hero-bloat hero))
(test-equal (vec2 10 20) (hero-position (hero-with-position hero (vec2 10 20))))
(test-equal default-position (hero-position hero))
2024-05-20 16:52:29 +02:00
(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)))
2024-05-21 13:36:48 +02:00
(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))))
2024-05-21 14:18:47 +02:00
2024-05-21 13:36:48 +02:00
)
2024-05-20 16:52:29 +02:00
(test-end "hero model")