diff --git a/game/model/hero.scm b/game/model/hero.scm new file mode 100644 index 0000000..c8938fb --- /dev/null +++ b/game/model/hero.scm @@ -0,0 +1,46 @@ +;; 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) + #:export (hero-load + + ) + ) +(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 16) +(define default-state 'stationary) +(define default-bloat 1.0) + +(define (hero-load) + (%make-hero default-x default-y default-state default-bloat)) + + +;; 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-end "hero model")