Initial port of macroknight to an engine

1 files changed, 174 insertions, 0 deletions

diff --git a/tests/input-test.scm b/tests/input-test.scm
new file mode 100644
index 0000000..822875e
--- /dev/null
+++ b/tests/input-test.scm
@@ -0,0 +1,174 @@
+;; Load dependencies first
+(import scheme
+        (chicken base)
+        (chicken format)
+        (only srfi-1 any filter fold alist-delete)
+        (only srfi-13 string-join)
+        (only srfi-197 chain)
+        (prefix sdl2 sdl2:)
+        simple-logger
+        srfi-64
+        defstruct)
+
+;; Load entity first (input imports it)
+(include "entity.scm")
+(import entity)
+
+;; Load the module source directly
+(include "input.scm")
+;; Now import it to access the exported functions
+(import input)
+
+;; Test suite for input module
+(test-begin "input-module")
+
+;; Test: create-input-state initializes correctly
+(test-group "create-input-state"
+  (let ((state (create-input-state *default-input-config*)))
+    (test-assert "returns an input-state record" (input-state? state))
+    (test-assert "has current field" (list? (input-state-current state)))
+    (test-assert "has previous field" (list? (input-state-previous state)))
+
+    ;; All actions should be initialized to #f
+    (test-equal "up action is false" #f (input-held? state 'up))
+    (test-equal "down action is false" #f (input-held? state 'down))
+    (test-equal "left action is false" #f (input-held? state 'left))
+    (test-equal "right action is false" #f (input-held? state 'right))
+    (test-equal "a action is false" #f (input-held? state 'a))
+    (test-equal "b action is false" #f (input-held? state 'b))
+    (test-equal "start action is false" #f (input-held? state 'start))
+    (test-equal "quit action is false" #f (input-held? state 'quit))))
+
+;; Test: input-held? query
+(test-group "input-held?"
+  (let ((state (create-input-state *default-input-config*)))
+    (test-equal "returns false for unheld action" #f (input-held? state 'up))
+    (test-equal "returns false for unknown action" #f (input-held? state 'unknown))))
+
+;; Test: input-pressed? detection
+(test-group "input-pressed?"
+  (let* ((state1 (create-input-state *default-input-config*))
+         ;; Simulate state transition: nothing -> up pressed
+         (state2 (make-input-state
+                  (cons (cons 'up #t) (input-state-current state1))
+                  (input-state-current state1))))
+
+    ;; In state1, up is not pressed
+    (test-equal "not pressed in initial state" #f (input-pressed? state1 'up))
+
+    ;; In state2, up is held but was not held before -> pressed
+    (test-assert "pressed when current=#t and previous=#f"
+                 (input-pressed? state2 'up))))
+
+;; Test: input-released? detection
+(test-group "input-released?"
+  (let* ((state1 (create-input-state *default-input-config*))
+         ;; State with up held
+         (state-held (make-input-state
+                      (cons (cons 'up #t) (input-state-current state1))
+                      (input-state-current state1)))
+         ;; State with up released (current=#f, previous=#t)
+         (state-released (make-input-state
+                          (cons (cons 'up #f) (input-state-current state1))
+                          (cons (cons 'up #t) (input-state-current state1)))))
+
+    (test-equal "not released when held" #f (input-released? state-held 'up))
+    (test-assert "released when current=#f and previous=#t"
+                 (input-released? state-released 'up))))
+
+;; Test: input-any-pressed?
+(test-group "input-any-pressed?"
+  (let ((state1 (create-input-state *default-input-config*)))
+    (test-equal "no actions pressed in initial state"
+                #f
+                (input-any-pressed? state1 *default-input-config*))))
+
+;; Test: input-state->string formatting
+(test-group "input-state->string"
+  (let* ((state (create-input-state *default-input-config*))
+         (str (input-state->string state *default-input-config*)))
+    (test-assert "returns a string" (string? str))
+    (test-assert "contains [Input:" (string-contains str "[Input:"))
+    (test-assert "empty state shows no actions"
+                 (or (string-contains str "[]")
+                     (string-contains str "[Input: ]")))))
+
+;; Test: state transitions
+(test-group "state-transitions"
+  (let* ((state1 (create-input-state *default-input-config*))
+         ;; Manually create state2 where 'up' is pressed
+         (state2 (make-input-state
+                  (cons (cons 'up #t)
+                        (filter (lambda (p) (not (eq? (car p) 'up)))
+                                (input-state-current state1)))
+                  (input-state-current state1))))
+
+    ;; Verify transition from not-held to held = pressed
+    (test-equal "up not held in state1" #f (input-held? state1 'up))
+    (test-assert "up held in state2" (input-held? state2 'up))
+    (test-assert "up pressed in state2" (input-pressed? state2 'up))
+
+    ;; Now create state3 where up is still held (not pressed anymore)
+    (let ((state3 (make-input-state
+                   (input-state-current state2)
+                   (input-state-current state2))))
+      (test-assert "up still held in state3" (input-held? state3 'up))
+      (test-equal "up not pressed in state3 (already was pressed)"
+                  #f
+                  (input-pressed? state3 'up)))))
+
+;; Test: apply-input-to-entity applies input to entity
+(test-group "apply-input-to-entity"
+  (test-group "no input-map: entity unchanged"
+    (let* ((e   '(#:type player #:x 5 #:y 10))
+           (out (apply-input-to-entity e (lambda (a) #f))))
+      (test-equal "entity returned as-is" e out)))
+
+  (test-group "no actions held: velocity is zero"
+    (let* ((e   (make-player-entity 0 0 16 16))
+           (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-player-entity 0 0 16 16))
+           (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-player-entity 0 0 16 16))
+           (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-player-entity 0 0 16 16))
+           (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-player-entity 0 0 16 16))
+           (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-player-entity 0 0 16 16) #: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)))))
+
+(test-group "custom-input-config"
+  (let* ((cfg (make-input-config
+                actions: '(jump shoot)
+                keyboard-map: '((space . jump) (f . shoot))
+                joy-button-map: '()
+                controller-button-map: '()
+                joy-axis-bindings: '()
+                controller-axis-bindings: '()
+                deadzone: 8000))
+         (state (create-input-state cfg)))
+    (test-assert "custom config creates valid state" (input-state? state))
+    (test-equal "jump is false" #f (input-held? state 'jump))
+    (test-equal "shoot is false" #f (input-held? state 'shoot))))
+
+(test-end "input-module")