Enrich entities pipelining to provide scene context to processors

1 files changed, 11 insertions, 6 deletions

diff --git a/tests/input-test.scm b/tests/input-test.scm
index 44af6e8..0d1e4b5 100644
--- a/tests/input-test.scm
+++ b/tests/input-test.scm
@@ -117,6 +117,11 @@
                   #f
                   (input-pressed? state3 'up)))))
 
+(define (make-physics-entity)
+  (entity-set-many (make-entity 0 0 16 16)
+		   '((#:vx 0) (#:vy 0)
+		     (#:input-map ((left . (-2 . 0)) (right . (2 . 0)))))))
+
 ;; Test: apply-input-to-entity applies input to entity
 (test-group "apply-input-to-entity"
   (test-group "no input-map: entity unchanged"
@@ -125,35 +130,35 @@
       (test-equal "entity returned as-is" e out)))
 
   (test-group "no actions held: velocity is zero"
-    (let* ((e   (make-entity 0 0 16 16))
+    (let* ((e   (make-physics-entity))
            (out (apply-input-to-entity e (lambda (a) #f))))
       (test-equal "vx is 0" 0 (entity-ref out #:vx))
       (test-equal "vy is 0" 0 (entity-ref out #:vy))))
 
   (test-group "right held: vx=2 vy=0"
-    (let* ((e   (make-entity 0 0 16 16))
+    (let* ((e   (make-physics-entity))
            (out (apply-input-to-entity e (lambda (a) (eq? a 'right)))))
       (test-equal "vx is 2" 2 (entity-ref out #:vx))
       (test-equal "vy is 0" 0 (entity-ref out #:vy))))
 
   (test-group "right+down held: vx=2 vy unchanged"
-    (let* ((e   (make-entity 0 0 16 16))
+    (let* ((e   (make-physics-entity))
            (out (apply-input-to-entity e (lambda (a) (memv a '(right down))))))
       (test-equal "vx is 2" 2 (entity-ref out #:vx))
       (test-equal "vy is unchanged (input handler does not set vy)" 0 (entity-ref out #:vy))))
 
   (test-group "right held: facing set to 1"
-    (let* ((e   (make-entity 0 0 16 16))
+    (let* ((e   (make-physics-entity))
            (out (apply-input-to-entity e (lambda (a) (eq? a 'right)))))
       (test-equal "facing is 1" 1 (entity-ref out #:facing 0))))
 
   (test-group "left held: facing set to -1"
-    (let* ((e   (make-entity 0 0 16 16))
+    (let* ((e   (make-physics-entity))
            (out (apply-input-to-entity e (lambda (a) (eq? a 'left)))))
       (test-equal "facing is -1" -1 (entity-ref out #:facing 0))))
 
   (test-group "no key held: facing retains previous value"
-    (let* ((e   (entity-set (make-entity 0 0 16 16) #:facing 1))
+    (let* ((e   (entity-set (make-physics-entity) #:facing 1))
            (out (apply-input-to-entity e (lambda (a) #f))))
       (test-equal "facing stays 1 when vx=0" 1 (entity-ref out #:facing 0)))))