From 526e6cdcdf1025d5e29680bc99ab910c79789764 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Sun, 5 Apr 2026 14:17:51 +0100 Subject: Initial port of macroknight to an engine --- tests/input-test.scm | 174 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) create mode 100644 tests/input-test.scm (limited to 'tests/input-test.scm') 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") -- cgit v1.2.3