;; 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) #:use-module (game model level) #:export (hero-load hero-state hero-with-state hero-bloat hero-with-bloat hero-position hero-with-position hero-x hero-with-x hero-y hero-with-y )) (define-immutable-record-type (%make-hero position state bloat) hero? (position hero-position hero-with-position) (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) (define (hero-load level) (let ((initial-position (level-find-hero level))) (%make-hero initial-position default-state default-bloat))) (define (hero-x hero) (inexact->exact (floor (vec2-x (hero-position hero))))) (define (hero-y hero) (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))) ;; Tests [test-begin "hero model"] (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)) (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 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)))) ) (test-end "hero model")