basic hero model

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 <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 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")