;; 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 (%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")