56 lines
1.7 KiB
Scheme
56 lines
1.7 KiB
Scheme
;; 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)
|
|
#: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
|
|
))
|
|
|
|
|
|
(define-immutable-record-type <hero>
|
|
(%make-hero x y state bloat)
|
|
hero?
|
|
(x hero-x hero-with-x)
|
|
(y hero-y hero-with-y)
|
|
(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-x 320)
|
|
(define default-y 32)
|
|
(define default-state 'stationary)
|
|
(define default-bloat 1.0)
|
|
|
|
(define (hero-load)
|
|
(%make-hero default-x default-y default-state default-bloat))
|
|
|
|
(define (hero-position hero)
|
|
(vec2 (hero-x hero) (hero-y hero)))
|
|
|
|
;; Tests
|
|
[test-begin "hero model"]
|
|
(test-assert (hero? (hero-load)))
|
|
(test-equal default-x (hero-x (hero-load)))
|
|
(test-equal default-y (hero-y (hero-load)))
|
|
(test-equal default-state (hero-state (hero-load)))
|
|
(test-equal default-bloat (hero-bloat (hero-load)))
|
|
|
|
(let ((hero (hero-load)))
|
|
(test-equal 10 (hero-x (hero-with-x hero 10)))
|
|
(test-equal default-x (hero-x hero))
|
|
(test-equal 20 (hero-y (hero-with-y hero 20)))
|
|
(test-equal default-y (hero-y hero))
|
|
(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 (vec2 default-x default-y) (hero-position (hero-load)))
|
|
|
|
(test-end "hero model")
|