aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorGene Pasquet <dev@etenil.net>2026-04-05 14:17:51 +0100
committerGene Pasquet <dev@etenil.net>2026-04-05 14:17:51 +0100
commit526e6cdcdf1025d5e29680bc99ab910c79789764 (patch)
tree2a91b3e96f2b97cfc81169627f222a5393982830 /tests
Initial port of macroknight to an engine
Diffstat (limited to 'tests')
-rw-r--r--tests/entity-test.scm116
-rw-r--r--tests/input-test.scm174
-rw-r--r--tests/physics-test.scm626
-rw-r--r--tests/renderer-test.scm92
-rw-r--r--tests/tilemap-test.scm204
-rw-r--r--tests/world-test.scm239
6 files changed, 1451 insertions, 0 deletions
diff --git a/tests/entity-test.scm b/tests/entity-test.scm
new file mode 100644
index 0000000..3e1f85e
--- /dev/null
+++ b/tests/entity-test.scm
@@ -0,0 +1,116 @@
+(import srfi-64)
+(include "entity.scm")
+(import entity)
+
+(test-begin "entity")
+
+;; Test: entity-ref retrieves values from entity plists
+(test-group "entity-ref"
+ (let ((entity '(#:type player #:x 100 #:y 200 #:width 16 #:height 16)))
+ (test-equal "retrieves type" 'player (entity-ref entity #:type))
+ (test-equal "retrieves x" 100 (entity-ref entity #:x))
+ (test-equal "retrieves y" 200 (entity-ref entity #:y))
+ (test-equal "retrieves width" 16 (entity-ref entity #:width))
+ (test-equal "retrieves height" 16 (entity-ref entity #:height)))
+
+ ;; Test with default value
+ (let ((entity '(#:type player)))
+ (test-equal "returns default for missing key"
+ 99
+ (entity-ref entity #:x 99))
+ (test-equal "returns #f as default if not specified"
+ #f
+ (entity-ref entity #:missing-key))))
+
+;; Test: entity-ref with procedure as default
+(test-group "entity-ref-with-procedure-default"
+ (let ((entity '(#:type player)))
+ (test-equal "calls procedure default when key missing"
+ 42
+ (entity-ref entity #:x (lambda () 42)))))
+
+;; Test: entity-type extracts type from entity
+(test-group "entity-type"
+ (let ((player '(#:type player #:x 100))
+ (enemy '(#:type enemy #:x 200)))
+ (test-equal "extracts player type" 'player (entity-type player))
+ (test-equal "extracts enemy type" 'enemy (entity-type enemy)))
+
+ (let ((no-type '(#:x 100 #:y 200)))
+ (test-equal "returns #f for entity without type"
+ #f
+ (entity-type no-type))))
+
+;; Test: make-player-entity creates valid player entity
+(test-group "make-player-entity"
+ (let ((player (make-player-entity 50 75 16 16)))
+ (test-assert "returns a list" (list? player))
+ (test-equal "has correct type" 'player (entity-ref player #:type))
+ (test-equal "has correct x" 50 (entity-ref player #:x))
+ (test-equal "has correct y" 75 (entity-ref player #:y))
+ (test-equal "has correct width" 16 (entity-ref player #:width))
+ (test-equal "has correct height" 16 (entity-ref player #:height))
+ (test-equal "has initial tile-id" 29 (entity-ref player #:tile-id))))
+
+;; Test: complex entity with multiple properties
+(test-group "complex-entity"
+ (let ((entity '(#:type enemy
+ #:x 100
+ #:y 200
+ #:width 16
+ #:height 16
+ #:health 50
+ #:speed 2.5
+ #:ai-state patrol)))
+ (test-equal "retrieves numeric property" 50 (entity-ref entity #:health))
+ (test-equal "retrieves float property" 2.5 (entity-ref entity #:speed))
+ (test-equal "retrieves symbol property" 'patrol (entity-ref entity #:ai-state))))
+
+;; Test: entity-set updates entity properties
+(test-group "entity-set"
+ (test-group "existing key is replaced"
+ (let ((e (entity-set '(#:x 10 #:y 20) #:x 15)))
+ (test-equal "value updated" 15 (entity-ref e #:x))
+ (test-equal "other key untouched" 20 (entity-ref e #:y))
+ ;; plist length should shrink from 4 to 4 (same — one pair removed, one added)
+ ;; stronger: verify the list length stays at 4, not 6
+ (test-equal "no duplicate key: list length unchanged" 4 (length e))))
+ (test-group "new key is added"
+ (let ((e (entity-set '(#:x 10) #:vx 3)))
+ (test-equal "new key present" 3 (entity-ref e #:vx))
+ (test-equal "existing key untouched" 10 (entity-ref e #:x))
+ (test-equal "list grows by one pair" 4 (length e)))))
+
+;; Test: entity-update applies transformations
+(test-group "entity-update"
+ (test-group "transform existing value"
+ (let ((e (entity-update '(#:x 10 #:y 20) #:x (lambda (v) (+ v 5)))))
+ (test-equal "#:x is 15" 15 (entity-ref e #:x))
+ (test-equal "#:y is 20" 20 (entity-ref e #:y))))
+
+ (test-group "missing key uses default"
+ (let ((e (entity-update '(#:x 10) #:health (lambda (v) (+ v 1)) 0)))
+ (test-equal "#:health is 1" 1 (entity-ref e #:health))))
+
+ (test-group "missing key without default"
+ (let ((e (entity-update '(#:x 10) #:z (lambda (v) v))))
+ (test-equal "#:z is #f" #f (entity-ref e #:z))))
+
+ (test-group "no duplicate keys"
+ (let ((e (entity-update '(#:x 10 #:y 20) #:x (lambda (v) (* v 2)))))
+ (test-equal "length is 4" 4 (length e)))))
+
+;; Test: make-player-entity velocity fields
+(test-group "make-player-entity-velocity-fields"
+ (let* ((p (make-player-entity 5 10 16 16))
+ (imap (entity-ref p #:input-map #f)))
+ (test-equal "vx defaults to 0" 0 (entity-ref p #:vx))
+ (test-equal "vy defaults to 0" 0 (entity-ref p #:vy))
+ (test-assert "input-map is present" imap)
+ ;; Each entry is (action . (dvx . dvy)); assq returns (action . (dvx . dvy))
+ (test-equal "left dvx" -2 (car (cdr (assq 'left imap))))
+ (test-equal "left dvy" 0 (cdr (cdr (assq 'left imap))))
+ (test-equal "right dvx" 2 (car (cdr (assq 'right imap))))
+ (test-equal "right dvy" 0 (cdr (cdr (assq 'right imap))))))
+
+(test-end "entity")
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")
diff --git a/tests/physics-test.scm b/tests/physics-test.scm
new file mode 100644
index 0000000..4c6d4a6
--- /dev/null
+++ b/tests/physics-test.scm
@@ -0,0 +1,626 @@
+;; Load dependencies first
+(import scheme
+ (chicken base)
+ (chicken keyword)
+ defstruct
+ srfi-64
+ (only srfi-1 every member make-list fold iota))
+
+;; Create a mock tilemap module to avoid SDL dependency
+(module tilemap *
+ (import scheme (chicken base) defstruct)
+
+ (defstruct tileset
+ tilewidth
+ tileheight
+ spacing
+ tilecount
+ columns
+ image-source
+ image)
+
+ (defstruct layer
+ name
+ width
+ height
+ map)
+
+ (defstruct tilemap
+ width
+ height
+ tilewidth
+ tileheight
+ tileset-source
+ tileset
+ layers
+ objects))
+
+(import tilemap)
+
+;; Load entity module first (since world now imports entity)
+(include "entity.scm")
+(import entity)
+
+;; Load world module first
+(include "world.scm")
+(import world)
+
+;; Load physics module
+(include "physics.scm")
+(import physics)
+
+;; Load physics module
+(include "input.scm")
+(import input)
+
+;; Test suite for physics module
+(test-begin "physics-module")
+
+;; Helper to reduce tilemap boilerplate in tests
+;; rows: list of lists of tile IDs, tiles are 16x16
+(define (make-test-tilemap rows)
+ (let* ((height (length rows))
+ (width (length (car rows)))
+ (layer (make-layer name: "test" width: width height: height map: rows)))
+ (make-tilemap width: width height: height
+ tilewidth: 16 tileheight: 16
+ tileset-source: "" tileset: #f
+ layers: (list layer) objects: '())))
+
+;; Integration helper: simulate one frame of physics
+(define (tick e tm held?)
+ (let* ((e (apply-input-to-entity e held?))
+ (e (apply-gravity e))
+ (e (apply-velocity-x e))
+ (e (resolve-tile-collisions-x e tm))
+ (e (apply-velocity-y e))
+ (e (resolve-tile-collisions-y e tm))
+ (e (detect-ground e tm)))
+ e))
+
+;; Test: apply-gravity
+(test-group "apply-gravity"
+ (test-group "gravity? true, vy starts at 0"
+ (let* ((e '(#:type rock #:x 0 #:y 0 #:vx 0 #:vy 0 #:gravity? #t))
+ (result (apply-gravity e)))
+ (test-equal "vy increased by gravity" *gravity* (entity-ref result #:vy))
+ (test-equal "x unchanged" 0 (entity-ref result #:x))
+ (test-equal "y unchanged" 0 (entity-ref result #:y))
+ (test-equal "vx unchanged" 0 (entity-ref result #:vx))))
+
+ (test-group "gravity? true, vy already has value"
+ (let* ((e '(#:type rock #:x 0 #:y 0 #:vx 0 #:vy 3 #:gravity? #t))
+ (result (apply-gravity e)))
+ (test-equal "vy increased by gravity" 4 (entity-ref result #:vy))))
+
+ (test-group "gravity? false"
+ (let* ((e '(#:type static #:x 0 #:y 0 #:vx 0 #:vy 0 #:gravity? #f))
+ (result (apply-gravity e)))
+ (test-equal "vy unchanged" 0 (entity-ref result #:vy))))
+
+ (test-group "no gravity? field at all"
+ (let* ((e '(#:type static #:x 5 #:y 5))
+ (result (apply-gravity e)))
+ (test-equal "entity unchanged" e result))))
+
+(test-group "apply-velocity-x"
+ (test-group "basic horizontal movement"
+ (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 5 #:vy -2))
+ (result (apply-velocity-x e)))
+ (test-equal "x moved by vx" 15 (entity-ref result #:x))
+ (test-equal "y unchanged" 20 (entity-ref result #:y))
+ (test-equal "vy unchanged" -2 (entity-ref result #:vy))))
+
+ (test-group "zero vx"
+ (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 0 #:vy 3))
+ (result (apply-velocity-x e)))
+ (test-equal "x unchanged" 10 (entity-ref result #:x))
+ (test-equal "y unchanged" 20 (entity-ref result #:y)))))
+
+(test-group "apply-velocity-y"
+ (test-group "basic vertical movement"
+ (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 3 #:vy -5))
+ (result (apply-velocity-y e)))
+ (test-equal "x unchanged" 10 (entity-ref result #:x))
+ (test-equal "y moved by vy" 15 (entity-ref result #:y))
+ (test-equal "vx unchanged" 3 (entity-ref result #:vx))))
+
+ (test-group "zero vy"
+ (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 3 #:vy 0))
+ (result (apply-velocity-y e)))
+ (test-equal "x unchanged" 10 (entity-ref result #:x))
+ (test-equal "y unchanged" 20 (entity-ref result #:y)))))
+
+(test-group "apply-velocity"
+ (test-group "basic movement"
+ (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 3 #:vy -2))
+ (result (apply-velocity e)))
+ (test-equal "x moved by vx" 13 (entity-ref result #:x))
+ (test-equal "y moved by vy" 18 (entity-ref result #:y))))
+
+ (test-group "zero velocity"
+ (let* ((e '(#:type rock #:x 10 #:y 20 #:vx 0 #:vy 0))
+ (result (apply-velocity e)))
+ (test-equal "x unchanged" 10 (entity-ref result #:x))
+ (test-equal "y unchanged" 20 (entity-ref result #:y))))
+
+ (test-group "no velocity fields (defaults to 0)"
+ (let* ((e '(#:type static #:x 5 #:y 5))
+ (result (apply-velocity e)))
+ (test-equal "x unchanged" 5 (entity-ref result #:x))
+ (test-equal "y unchanged" 5 (entity-ref result #:y)))))
+
+(test-group "build-cell-list"
+ (test-group "single cell"
+ (let ((cells (build-cell-list 5 5 3 3)))
+ (test-equal "one cell" 1 (length cells))
+ (test-equal "cell is pair" '(5 . 3) (car cells))))
+
+ (test-group "two columns one row"
+ (let ((cells (build-cell-list 11 12 22 22)))
+ (test-equal "two cells" 2 (length cells))
+ (test-assert "all cells are pairs" (every pair? cells))
+ (test-assert "contains (11 . 22)" (member '(11 . 22) cells))
+ (test-assert "contains (12 . 22)" (member '(12 . 22) cells))))
+
+ (test-group "one column two rows"
+ (let ((cells (build-cell-list 5 5 2 3)))
+ (test-equal "two cells" 2 (length cells))
+ (test-assert "all cells are pairs" (every pair? cells))
+ (test-assert "contains (5 . 2)" (member '(5 . 2) cells))
+ (test-assert "contains (5 . 3)" (member '(5 . 3) cells))))
+
+ (test-group "2x2 grid"
+ (let ((cells (build-cell-list 0 1 0 1)))
+ (test-equal "four cells" 4 (length cells))
+ (test-assert "all cells are pairs" (every pair? cells))
+ (test-assert "no #f in list" (not (member #f cells)))))
+
+ (test-group "empty when col-start > col-end"
+ (let ((cells (build-cell-list 5 4 0 0)))
+ (test-equal "empty list" '() cells)))
+
+ (test-group "player-like values (x=182 y=352 w=16 h=16 tw=16 th=16)"
+ (let* ((x 182) (y 352) (w 16) (h 16) (tw 16) (th 16)
+ (col-start (inexact->exact (floor (/ x tw))))
+ (col-end (inexact->exact (floor (/ (- (+ x w) 1) tw))))
+ (row-start (inexact->exact (floor (/ y th))))
+ (row-end (inexact->exact (floor (/ (- (+ y h) 1) th))))
+ (cells (build-cell-list col-start col-end row-start row-end)))
+ (test-equal "col-start" 11 col-start)
+ (test-equal "col-end" 12 col-end)
+ (test-equal "row-start" 22 row-start)
+ (test-equal "row-end" 22 row-end)
+ (test-equal "two cells" 2 (length cells))
+ (test-assert "all cells are pairs" (every pair? cells)))))
+
+(test-group "resolve-tile-collisions-x"
+ (test-group "no collision: entity unchanged"
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0))))
+ (e '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 2 #:vy 0)))
+ (let ((result (resolve-tile-collisions-x e tm)))
+ (test-equal "x unchanged" 0 (entity-ref result #:x))
+ (test-equal "vx unchanged" 2 (entity-ref result #:vx)))))
+
+ (test-group "zero vx: skipped entirely"
+ (let* ((tm (make-test-tilemap '((0 1 0) (0 0 0) (0 0 0))))
+ (e '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 0)))
+ (test-equal "entity eq? when vx=0" e (resolve-tile-collisions-x e tm))))
+
+ (test-group "collision moving right: push left"
+ ;; solid at col=1 (x=16..31); entity at x=20 overlaps it, vx>0
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
+ (e '(#:type player #:x 20 #:y 16 #:width 16 #:height 16 #:vx 5 #:vy 0)))
+ (let ((result (resolve-tile-collisions-x e tm)))
+ (test-equal "pushed left of solid tile" 0 (entity-ref result #:x))
+ (test-equal "vx zeroed" 0 (entity-ref result #:vx)))))
+
+ (test-group "collision moving left: push right"
+ ;; solid at col=1 (x=16..31); entity at x=16 overlaps it, vx<0
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
+ (e '(#:type player #:x 16 #:y 16 #:width 16 #:height 16 #:vx -5 #:vy 0)))
+ (let ((result (resolve-tile-collisions-x e tm)))
+ (test-equal "pushed right of solid tile" 32 (entity-ref result #:x))
+ (test-equal "vx zeroed" 0 (entity-ref result #:vx)))))
+
+ (test-group "floating-point x position"
+ ;; solid at col=1; entity at x=20.5 (float), vx>0
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
+ (e '(#:type player #:x 20.5 #:y 16 #:width 16 #:height 16 #:vx 2 #:vy 0)))
+ (let ((result (resolve-tile-collisions-x e tm)))
+ (test-equal "pushed left of solid tile" 0 (entity-ref result #:x))
+ (test-equal "vx zeroed" 0 (entity-ref result #:vx)))))
+
+ (test-group "entity spanning two columns: both checked"
+ ;; wall at col=3; 20px-wide entity at x=28 spans cols 1 and 2, no collision
+ (let* ((tm (make-test-tilemap '((0 0 0 1) (0 0 0 1) (0 0 0 1))))
+ (e '(#:type player #:x 28 #:y 0 #:width 20 #:height 16 #:vx 3 #:vy 0)))
+ (let ((result (resolve-tile-collisions-x e tm)))
+ (test-equal "no collision yet" 28 (entity-ref result #:x))))
+ ;; entity moved to x=34 now spans cols 2 and 3 (solid), pushed left
+ (let* ((tm (make-test-tilemap '((0 0 0 1) (0 0 0 1) (0 0 0 1))))
+ (e '(#:type player #:x 34 #:y 0 #:width 20 #:height 16 #:vx 3 #:vy 0)))
+ (let ((result (resolve-tile-collisions-x e tm)))
+ (test-equal "pushed left of wall" 28 (entity-ref result #:x))
+ (test-equal "vx zeroed" 0 (entity-ref result #:vx))))))
+
+(test-group "resolve-tile-collisions-y"
+ (test-group "no collision: entity unchanged"
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0))))
+ (e '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 2)))
+ (let ((result (resolve-tile-collisions-y e tm)))
+ (test-equal "y unchanged" 0 (entity-ref result #:y))
+ (test-equal "vy unchanged" 2 (entity-ref result #:vy)))))
+
+ (test-group "zero vy: skipped entirely"
+ (let* ((tm (make-test-tilemap '((1 0 0) (0 0 0) (0 0 0))))
+ (e '(#:type player #:x 0 #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 0)))
+ (test-equal "entity eq? when vy=0" e (resolve-tile-collisions-y e tm))))
+
+ (test-group "collision moving down: push up"
+ ;; solid at row=1 (y=16..31); entity at y=20 overlaps it, vy>0
+ (let* ((tm (make-test-tilemap '((0 0 0) (1 0 0) (0 0 0))))
+ (e '(#:type player #:x 0 #:y 20 #:width 16 #:height 16 #:vx 0 #:vy 5)))
+ (let ((result (resolve-tile-collisions-y e tm)))
+ (test-equal "pushed above solid tile" 0 (entity-ref result #:y))
+ (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
+
+ (test-group "collision moving up: push down"
+ ;; solid at row=1 (y=16..31); entity at y=16 overlaps it from below, vy<0
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 1 0) (0 0 0))))
+ (e '(#:type player #:x 16 #:y 16 #:width 16 #:height 16 #:vx 0 #:vy -5)))
+ (let ((result (resolve-tile-collisions-y e tm)))
+ (test-equal "pushed below solid tile" 32 (entity-ref result #:y))
+ (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
+
+ (test-group "floating-point y position"
+ ;; solid at row=1; entity at y=20.5 (float), vy>0
+ (let* ((tm (make-test-tilemap '((0 0 0) (1 0 0) (0 0 0))))
+ (e '(#:type player #:x 0 #:y 20.5 #:width 16 #:height 16 #:vx 0 #:vy 3)))
+ (let ((result (resolve-tile-collisions-y e tm)))
+ (test-equal "pushed above solid tile" 0 (entity-ref result #:y))
+ (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
+
+ (test-group "entity spanning two rows: both checked"
+ ;; floor at row=3; 20px-tall entity at y=28 spans rows 1 and 2, no collision
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0) (1 1 1))))
+ (e '(#:type player #:x 0 #:y 28 #:width 16 #:height 20 #:vx 0 #:vy 3)))
+ (let ((result (resolve-tile-collisions-y e tm)))
+ (test-equal "no collision yet" 28 (entity-ref result #:y))))
+ ;; entity at y=34 now spans rows 2 and 3 (solid), pushed up
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0) (1 1 1))))
+ (e '(#:type player #:x 0 #:y 34 #:width 16 #:height 20 #:vx 0 #:vy 3)))
+ (let ((result (resolve-tile-collisions-y e tm)))
+ (test-equal "pushed above floor" 28 (entity-ref result #:y))
+ (test-equal "vy zeroed" 0 (entity-ref result #:vy))))))
+
+;; Integration test: simulate the actual game physics loop
+(test-group "multi-frame physics simulation"
+ (test-group "player falls and lands on floor (10 frames)"
+ ;; 3x4 tilemap: air on rows 0-2, solid floor on row 3
+ ;; Player starts at y=0, 16px tall; floor is at y=48
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0) (1 1 1))))
+ (e0 '(#:type player #:x 0 #:y 0 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:gravity? #t #:input-map ())))
+ (let loop ((e e0) (n 10))
+ (if (= n 0)
+ (begin
+ (test-assert "player rests at or above floor" (<= (entity-ref e #:y) 32))
+ (test-assert "y is non-negative" (>= (entity-ref e #:y) 0)))
+ (loop (tick e tm (lambda (a) #f)) (- n 1))))))
+
+ (test-group "player stable on floor (10 frames of gravity jitter)"
+ ;; Player already on floor, should stay there
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 1 1))))
+ ;; Floor at row 2 (y=32); player at y=16, height=16: bottom at y=32
+ (e0 '(#:type player #:x 0 #:y 16 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:gravity? #t #:input-map ())))
+ (let loop ((e e0) (n 10))
+ (if (= n 0)
+ (test-assert "player stays on floor" (<= (entity-ref e #:y) 16))
+ (loop (tick e tm (lambda (a) #f)) (- n 1))))))
+
+ (test-group "player with real starting coordinates (x=182 y=350.5) falls 5 frames"
+ ;; Use a large enough tilemap: 15 cols x 25 rows, solid floor at row 24
+ (let* ((empty-row (make-list 15 0))
+ (solid-row (make-list 15 1))
+ (rows (append (make-list 24 empty-row) (list solid-row)))
+ (tm (make-test-tilemap rows))
+ (e0 (make-player-entity 182 350.5 16 16)))
+ ;; Should not crash
+ (let loop ((e e0) (n 5))
+ (if (= n 0)
+ (test-assert "player survived 5 frames" #t)
+ (loop (tick e tm (lambda (a) #f)) (- n 1)))))))
+
+(test-group "resolve-entity-collisions"
+ (define (make-solid x y w h)
+ (list #:type 'block #:x x #:y y #:width w #:height h #:solid? #t))
+
+ (test-group "no overlap: entities unchanged"
+ (let* ((a (make-solid 0 0 16 16))
+ (b (make-solid 100 0 16 16))
+ (result (resolve-entity-collisions (list a b))))
+ (test-equal "a x unchanged" 0 (entity-ref (list-ref result 0) #:x 0))
+ (test-equal "b x unchanged" 100 (entity-ref (list-ref result 1) #:x 0))))
+
+ (test-group "horizontal overlap: pushed apart on x"
+ ;; a at x=0, b at x=10, both 16x16 → overlap-x = (16+16)/2 - 10 = 6, overlap-y = (16+16)/2 - 0 = 16
+ ;; push on x (smaller), each by 3px
+ (let* ((a (make-solid 0 0 16 16))
+ (b (make-solid 10 0 16 16))
+ (result (resolve-entity-collisions (list a b)))
+ (ra (list-ref result 0))
+ (rb (list-ref result 1)))
+ (test-equal "a pushed left by 3" -3 (entity-ref ra #:x 0))
+ (test-equal "b pushed right by 3" 13 (entity-ref rb #:x 0))))
+
+ (test-group "vertical overlap: pushed apart on y"
+ ;; a at y=0, b at y=10, both 16x16 → overlap-x=16, overlap-y=6 → push on y
+ (let* ((a (make-solid 0 0 16 16))
+ (b (make-solid 0 10 16 16))
+ (result (resolve-entity-collisions (list a b)))
+ (ra (list-ref result 0))
+ (rb (list-ref result 1)))
+ (test-equal "a pushed up by 3" -3 (entity-ref ra #:y 0))
+ (test-equal "b pushed down by 3" 13 (entity-ref rb #:y 0))))
+
+ (test-group "non-solid entity ignored"
+ (let* ((a (make-solid 0 0 16 16))
+ (b (list #:type 'goal #:x 5 #:y 5 #:width 16 #:height 16))
+ (result (resolve-entity-collisions (list a b))))
+ (test-equal "a x unchanged" 0 (entity-ref (list-ref result 0) #:x 0))
+ (test-equal "b x unchanged" 5 (entity-ref (list-ref result 1) #:x 0)))))
+
+;; New tests for detect-ground and apply-jump
+(test-group "detect-ground"
+ (test-group "entity standing on solid tile"
+ ;; Tilemap: 3 rows, row 2 is solid (tile=1), rows 0-1 empty (tile=0)
+ ;; tilewidth=tileheight=16
+ ;; Entity standing: y=16, h=16 → bottom at y=32, probe at y=33 → row=2 → solid
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 1 1))))
+ (e (list #:type 'player #:x 0 #:y 16 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
+ (result (detect-ground e tm)))
+ (test-assert "on-ground? is #t" (entity-ref result #:on-ground? #f))))
+
+ (test-group "entity in mid-air"
+ ;; Entity in mid-air: y=0, h=16 → bottom at 16, probe at 17 → row=1 → empty
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 1 1))))
+ (e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #t))
+ (result (detect-ground e tm)))
+ (test-assert "on-ground? is #f" (not (entity-ref result #:on-ground? #f)))))
+
+ (test-group "entity probe spans two tiles, left is solid"
+ ;; Entity at x=0, w=16: left foot at col 0; probe below
+ ;; Row with solid at col 0, empty at col 1: should be on-ground
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 0 0))))
+ (e (list #:type 'player #:x 0 #:y 16 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
+ (result (detect-ground e tm)))
+ (test-assert "on-ground? is #t (left foot on solid)" (entity-ref result #:on-ground? #f))))
+
+ (test-group "entity probe spans two tiles, right is solid"
+ ;; Entity at x=8, w=16: left foot at col 0, right foot at col 1; probe below
+ ;; Row with empty at col 0, solid at col 1: should be on-ground (right foot on solid)
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 1 0))))
+ (e (list #:type 'player #:x 8 #:y 16 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f))
+ (result (detect-ground e tm)))
+ (test-assert "on-ground? is #t (right foot on solid)" (entity-ref result #:on-ground? #f)))))
+
+(test-group "apply-jump"
+ (test-group "on-ground and pressed → impulse applied"
+ (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:on-ground? #t))
+ (result (apply-jump e #t)))
+ (test-equal "ay is -jump-force" (- *jump-force*) (entity-ref result #:ay 0))))
+
+ (test-group "on-ground but not pressed → unchanged"
+ (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
+ #:vx 0 #:vy 0 #:on-ground? #t))
+ (result (apply-jump e #f)))
+ (test-equal "vy unchanged" 0 (entity-ref result #:vy 0))))
+
+ (test-group "in-air and pressed → no double jump"
+ (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
+ #:vx 0 #:vy -5 #:on-ground? #f))
+ (result (apply-jump e #t)))
+ (test-equal "vy unchanged (no double jump)" -5 (entity-ref result #:vy 0))))
+
+ (test-group "in-air and not pressed → unchanged"
+ (let* ((e (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16
+ #:vx 0 #:vy -5 #:on-ground? #f))
+ (result (apply-jump e #f)))
+ (test-equal "vy unchanged" -5 (entity-ref result #:vy 0)))))
+
+(test-group "apply-acceleration"
+ (test-group "gravity? #t, ay set: consumed into vy and cleared"
+ (let* ((e '(#:type player #:x 0 #:y 0 #:vy 3 #:ay 5 #:gravity? #t))
+ (result (apply-acceleration e)))
+ (test-equal "vy += ay" 8 (entity-ref result #:vy 0))
+ (test-equal "ay cleared" 0 (entity-ref result #:ay 0))))
+
+ (test-group "gravity? #t, ay is 0: vy unchanged"
+ (let* ((e '(#:type player #:x 0 #:y 0 #:vy 3 #:ay 0 #:gravity? #t))
+ (result (apply-acceleration e)))
+ (test-equal "vy unchanged" 3 (entity-ref result #:vy 0))
+ (test-equal "ay still 0" 0 (entity-ref result #:ay 0))))
+
+ (test-group "gravity? #f: entity unchanged"
+ (let* ((e '(#:type player #:x 0 #:y 0 #:vy 3 #:ay 5 #:gravity? #f))
+ (result (apply-acceleration e)))
+ (test-equal "entity unchanged" e result))))
+
+(test-group "pixel->tile"
+ (test-equal "pixel 0 in 16px tile → 0" 0 (pixel->tile 0 16))
+ (test-equal "pixel 15 in 16px tile → 0" 0 (pixel->tile 15 16))
+ (test-equal "pixel 16 in 16px tile → 1" 1 (pixel->tile 16 16))
+ (test-equal "pixel 24 in 16px tile → 1" 1 (pixel->tile 24 16))
+ (test-equal "pixel 24.7 in 16px tile → 1" 1 (pixel->tile 24.7 16))
+ (test-equal "pixel 32 in 16px tile → 2" 2 (pixel->tile 32 16)))
+
+(test-group "entity-tile-cells"
+ (test-group "entity aligned to one tile"
+ (let* ((tm (make-test-tilemap '((0 0) (0 0))))
+ (e '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (cells (entity-tile-cells e tm)))
+ (test-equal "one cell" 1 (length cells))
+ (test-equal "cell is (0 . 0)" '(0 . 0) (car cells))))
+
+ (test-group "entity spanning 2 cols and 2 rows"
+ (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (0 0 0))))
+ (e '(#:type player #:x 8 #:y 8 #:width 16 #:height 16))
+ (cells (entity-tile-cells e tm)))
+ (test-equal "four cells" 4 (length cells)))))
+
+(test-group "tile-push-pos"
+ (test-group "moving forward (v>0): snap leading edge to near side of tile"
+ ;; coord=3, tile-size=16, entity-size=16 → 3*16 - 16 = 32
+ (test-equal "push pos" 32 (tile-push-pos 1 3 16 16)))
+
+ (test-group "moving backward (v<0): snap trailing edge to far side of tile"
+ ;; coord=3, tile-size=16 → (3+1)*16 = 64
+ (test-equal "push pos" 64 (tile-push-pos -1 3 16 16))))
+
+(test-group "list-set"
+ (test-equal "replace first" '(x b c) (list-set '(a b c) 0 'x))
+ (test-equal "replace middle" '(a x c) (list-set '(a b c) 1 'x))
+ (test-equal "replace last" '(a b x) (list-set '(a b c) 2 'x)))
+
+(test-group "index-pairs"
+ (test-equal "n=0: empty" '() (index-pairs 0))
+ (test-equal "n=1: empty" '() (index-pairs 1))
+ (test-equal "n=2: one pair" '((0 . 1)) (index-pairs 2))
+ (test-group "n=3: three pairs"
+ (let ((pairs (index-pairs 3)))
+ (test-equal "count" 3 (length pairs))
+ (test-assert "(0 . 1)" (member '(0 . 1) pairs))
+ (test-assert "(0 . 2)" (member '(0 . 2) pairs))
+ (test-assert "(1 . 2)" (member '(1 . 2) pairs)))))
+
+(test-group "axis->dimension"
+ (test-equal "#:x → #:width" #:width (axis->dimension #:x))
+ (test-equal "#:y → #:height" #:height (axis->dimension #:y)))
+
+(test-group "axis->velocity"
+ (test-equal "#:x → #:vx" #:vx (axis->velocity #:x))
+ (test-equal "#:y → #:vy" #:vy (axis->velocity #:y)))
+
+(test-group "push-entity"
+ (test-group "push right (sign=1): x += overlap/2, vx=1"
+ (let* ((e '(#:type player #:x 10 #:y 0 #:vx 0 #:vy 0))
+ (result (push-entity e #:x #:vx 10 6 1)))
+ (test-equal "x = 10 + 3" 13 (entity-ref result #:x 0))
+ (test-equal "vx = 1" 1 (entity-ref result #:vx 0))))
+
+ (test-group "push left (sign=-1): x -= overlap/2, vx=-1"
+ (let* ((e '(#:type player #:x 10 #:y 0 #:vx 0 #:vy 0))
+ (result (push-entity e #:x #:vx 10 6 -1)))
+ (test-equal "x = 10 - 3" 7 (entity-ref result #:x 0))
+ (test-equal "vx = -1" -1 (entity-ref result #:vx 0)))))
+
+(test-group "entity-center-on-axis"
+ (let ((e '(#:type player #:x 10 #:y 20 #:width 16 #:height 24)))
+ (test-equal "center-x = 10 + 8 = 18" 18 (entity-center-on-axis e #:x))
+ (test-equal "center-y = 20 + 12 = 32" 32 (entity-center-on-axis e #:y))))
+
+(test-group "aabb-overlap-on-axis"
+ (test-group "x overlap: a at x=0 w=16, b at x=10 w=16 → overlap=6"
+ ;; half-sum of widths = 16, center dist = |18 - 8| = 10, overlap = 16 - 10 = 6
+ (let ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 10 #:y 0 #:width 16 #:height 16)))
+ (test-equal "x overlap = 6" 6 (aabb-overlap-on-axis #:x a b))))
+
+ (test-group "y overlap: a at y=0 h=16, b at y=10 h=16 → overlap=6"
+ (let ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 0 #:y 10 #:width 16 #:height 16)))
+ (test-equal "y overlap = 6" 6 (aabb-overlap-on-axis #:y a b))))
+
+ (test-group "no overlap: negative value"
+ (let ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 100 #:y 0 #:width 16 #:height 16)))
+ (test-assert "x overlap is negative" (< (aabb-overlap-on-axis #:x a b) 0)))))
+
+(test-group "push-along-axis"
+ (test-group "x axis: a left of b, pushed apart"
+ (let* ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 10 #:y 0 #:width 16 #:height 16))
+ (result (push-along-axis #:x a b 6))
+ (ra (car result))
+ (rb (cdr result)))
+ (test-equal "a pushed left to -3" -3 (entity-ref ra #:x 0))
+ (test-equal "b pushed right to 13" 13 (entity-ref rb #:x 0))
+ (test-equal "a vx = -1" -1 (entity-ref ra #:vx 0))
+ (test-equal "b vx = 1" 1 (entity-ref rb #:vx 0))))
+
+ (test-group "y axis: a above b, pushed apart"
+ (let* ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 0 #:y 10 #:width 16 #:height 16))
+ (result (push-along-axis #:y a b 6))
+ (ra (car result))
+ (rb (cdr result)))
+ (test-equal "a pushed up to -3" -3 (entity-ref ra #:y 0))
+ (test-equal "b pushed down to 13" 13 (entity-ref rb #:y 0)))))
+
+(test-group "push-apart"
+ (test-group "x overlap smaller: pushes on x axis"
+ ;; a at (0,0), b at (10,0), both 16x16: ovx=6, ovy=16 → push on x
+ (let* ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 10 #:y 0 #:width 16 #:height 16))
+ (result (push-apart a b)))
+ (test-equal "a pushed left" -3 (entity-ref (car result) #:x 0))
+ (test-equal "b pushed right" 13 (entity-ref (cdr result) #:x 0))))
+
+ (test-group "y overlap smaller: pushes on y axis"
+ ;; a at (0,0), b at (0,10), both 16x16: ovx=16, ovy=6 → push on y
+ (let* ((a '(#:type player #:x 0 #:y 0 #:width 16 #:height 16))
+ (b '(#:type player #:x 0 #:y 10 #:width 16 #:height 16))
+ (result (push-apart a b)))
+ (test-equal "a pushed up" -3 (entity-ref (car result) #:y 0))
+ (test-equal "b pushed down" 13 (entity-ref (cdr result) #:y 0)))))
+
+(test-group "resolve-pair"
+ (define (make-solid x y) (list #:type 'block #:x x #:y y #:width 16 #:height 16 #:solid? #t))
+
+ (test-group "one entity not solid: returns #f"
+ (let ((a (make-solid 0 0))
+ (b '(#:type ghost #:x 5 #:y 5 #:width 16 #:height 16)))
+ (test-assert "returns #f" (not (resolve-pair a b)))))
+
+ (test-group "no overlap: returns #f"
+ (let ((a (make-solid 0 0))
+ (b (make-solid 100 0)))
+ (test-assert "returns #f" (not (resolve-pair a b)))))
+
+ (test-group "overlap: returns (a2 . b2) pair"
+ (let* ((a (make-solid 0 0))
+ (b (make-solid 10 0))
+ (result (resolve-pair a b)))
+ (test-assert "result is a pair" (pair? result))
+ (test-assert "a2 is an entity" (pair? (car result)))
+ (test-assert "b2 is an entity" (pair? (cdr result))))))
+
+(test-group "aabb-overlap?"
+ (test-group "two boxes clearly overlapping"
+ (test-assert "boxes overlap in center"
+ (aabb-overlap? 0 0 10 10 5 5 10 10)))
+
+ (test-group "two boxes not overlapping (separated horizontally)"
+ (test-assert "boxes don't overlap when separated on x-axis"
+ (not (aabb-overlap? 0 0 10 10 20 0 10 10))))
+
+ (test-group "two boxes not overlapping (separated vertically)"
+ (test-assert "boxes don't overlap when separated on y-axis"
+ (not (aabb-overlap? 0 0 10 10 0 20 10 10))))
+
+ (test-group "edge-touching exactly"
+ (test-assert "touching edges are not overlapping"
+ (not (aabb-overlap? 0 0 10 10 10 0 10 10))))
+
+ (test-group "one box fully inside another"
+ (test-assert "inner box overlaps with outer"
+ (aabb-overlap? 0 0 20 20 5 5 10 10))))
+
+(test-end "physics-module")
diff --git a/tests/renderer-test.scm b/tests/renderer-test.scm
new file mode 100644
index 0000000..a8fdeed
--- /dev/null
+++ b/tests/renderer-test.scm
@@ -0,0 +1,92 @@
+;; Load base deps
+(import scheme
+ (chicken base)
+ (chicken keyword)
+ (only srfi-1 fold iota for-each)
+ defstruct
+ srfi-64)
+
+;; Mock tilemap module
+(module tilemap *
+ (import scheme (chicken base) defstruct)
+ (defstruct tileset tilewidth tileheight spacing tilecount columns image-source image)
+ (defstruct layer name width height map)
+ (defstruct tilemap width height tilewidth tileheight tileset-source tileset layers objects)
+ (defstruct tile id rect)
+ (define (tileset-tile ts id) (make-tile id: id rect: #f))
+ (define (tile-rect t) #f))
+(import tilemap)
+
+;; Mock sdl2
+(module sdl2 *
+ (import scheme (chicken base))
+ (define (make-rect x y w h) (list x y w h))
+ (define (render-copy! . args) #f)
+ (define (render-copy-ex! . args) #f)
+ (define (create-texture-from-surface . args) #f))
+(import (prefix sdl2 "sdl2:"))
+
+;; Mock sdl2-ttf
+(module sdl2-ttf *
+ (import scheme (chicken base))
+ (define (render-text-solid . args) #f)
+ (define (size-utf8 . args) (values 0 0)))
+(import (prefix sdl2-ttf "ttf:"))
+
+;; Load entity module
+(include "entity.scm")
+(import entity)
+
+;; Load world module
+(include "world.scm")
+(import world)
+
+;; Load renderer module
+(include "renderer.scm")
+(import renderer)
+
+(test-begin "renderer")
+
+(test-group "entity-screen-coords"
+ (let* ((cam (make-camera x: 10 y: 20))
+ (e (list #:x 50 #:y 80 #:width 16 #:height 16)))
+ (test-equal "subtracts camera offset from x"
+ 40
+ (car (entity-screen-coords e cam)))
+ (test-equal "subtracts camera offset from y"
+ 60
+ (cadr (entity-screen-coords e cam)))
+ (test-equal "preserves width"
+ 16
+ (caddr (entity-screen-coords e cam)))
+ (test-equal "preserves height"
+ 16
+ (cadddr (entity-screen-coords e cam))))
+
+ (let* ((cam (make-camera x: 0 y: 0))
+ (e (list #:x 100.7 #:y 200.3 #:width 16 #:height 16)))
+ (test-equal "floors fractional x"
+ 100
+ (car (entity-screen-coords e cam)))
+ (test-equal "floors fractional y"
+ 200
+ (cadr (entity-screen-coords e cam))))
+
+ (let* ((cam (make-camera x: 0 y: 0))
+ (e (list #:x 0 #:y 0 #:width 32 #:height 32)))
+ (test-equal "zero camera, zero position"
+ '(0 0 32 32)
+ (entity-screen-coords e cam))))
+
+(test-group "entity-flip"
+ (test-equal "facing 1: no flip"
+ '()
+ (entity-flip (list #:facing 1)))
+ (test-equal "facing -1: horizontal flip"
+ '(horizontal)
+ (entity-flip (list #:facing -1)))
+ (test-equal "no facing key: defaults to no flip"
+ '()
+ (entity-flip (list #:x 0))))
+
+(test-end "renderer")
diff --git a/tests/tilemap-test.scm b/tests/tilemap-test.scm
new file mode 100644
index 0000000..a76cff9
--- /dev/null
+++ b/tests/tilemap-test.scm
@@ -0,0 +1,204 @@
+;; Load dependencies first
+(import scheme
+ (chicken base)
+ (chicken io)
+ (chicken file)
+ (chicken format)
+ (chicken string)
+ (chicken pathname)
+ (chicken process-context)
+ (chicken pretty-print)
+ (only srfi-1 filter-map)
+ expat
+ matchable
+ defstruct
+ (prefix sdl2 sdl2:)
+ (prefix sdl2-image img:)
+ srfi-69
+ srfi-64)
+
+;; Load the module source directly
+(include "tilemap.scm")
+;; Now import it to access the exported functions
+(import tilemap)
+
+;; Test suite for tilemap module
+(test-begin "tilemap-module")
+
+;; Test: tileset record creation
+(test-group "tileset-structure"
+ (let ((ts (make-tileset tilewidth: 16
+ tileheight: 16
+ spacing: 1
+ tilecount: 100
+ columns: 10
+ image-source: "test.png"
+ image: #f)))
+ (test-assert "tileset is a record" (tileset? ts))
+ (test-equal "tilewidth is set correctly" 16 (tileset-tilewidth ts))
+ (test-equal "tileheight is set correctly" 16 (tileset-tileheight ts))
+ (test-equal "spacing is set correctly" 1 (tileset-spacing ts))
+ (test-equal "tilecount is set correctly" 100 (tileset-tilecount ts))
+ (test-equal "columns is set correctly" 10 (tileset-columns ts))
+ (test-equal "image-source is set correctly" "test.png" (tileset-image-source ts))))
+
+;; Test: tileset-rows calculation
+(test-group "tileset-rows"
+ (let ((ts (make-tileset tilewidth: 16
+ tileheight: 16
+ spacing: 1
+ tilecount: 100
+ columns: 10
+ image-source: "test.png"
+ image: #f)))
+ (test-equal "100 tiles / 10 columns = 10 rows"
+ 10
+ (tileset-rows ts)))
+
+ (let ((ts (make-tileset tilewidth: 16
+ tileheight: 16
+ spacing: 1
+ tilecount: 105
+ columns: 10
+ image-source: "test.png"
+ image: #f)))
+ (test-equal "105 tiles / 10 columns = 11 rows (ceiling)"
+ 11
+ (tileset-rows ts))))
+
+;; Test: tileset-tile calculates correct tile position
+(test-group "tileset-tile"
+ (let* ((ts (make-tileset tilewidth: 16
+ tileheight: 16
+ spacing: 1
+ tilecount: 100
+ columns: 10
+ image-source: "test.png"
+ image: #f))
+ (tile1 (tileset-tile ts 1))
+ (tile11 (tileset-tile ts 11)))
+
+ (test-assert "tile1 is a tile record" (tile? tile1))
+ (test-equal "tile1 has correct id" 1 (tile-id tile1))
+ (test-assert "tile1 has a rect" (sdl2:rect? (tile-rect tile1)))
+
+ ;; First tile should be at (0, 0)
+ (test-equal "tile1 x position" 0 (sdl2:rect-x (tile-rect tile1)))
+ (test-equal "tile1 y position" 0 (sdl2:rect-y (tile-rect tile1)))
+
+ ;; Tile 11 should be at start of second row (x=0, y=17 with spacing)
+ (test-equal "tile11 x position" 0 (sdl2:rect-x (tile-rect tile11)))
+ (test-equal "tile11 y position" 17 (sdl2:rect-y (tile-rect tile11)))))
+
+;; Test: layer record creation
+(test-group "layer-structure"
+ (let ((layer (make-layer name: "ground"
+ width: 40
+ height: 30
+ map: '())))
+ (test-assert "layer is a record" (layer? layer))
+ (test-equal "name is set correctly" "ground" (layer-name layer))
+ (test-equal "width is set correctly" 40 (layer-width layer))
+ (test-equal "height is set correctly" 30 (layer-height layer))
+ (test-equal "map is empty list" '() (layer-map layer))))
+
+;; Test: object record creation
+(test-group "object-structure"
+ (let ((obj (make-object name: "player"
+ type: "Player"
+ x: 100
+ y: 200
+ width: 16
+ height: 16
+ properties: '((text . "hello")))))
+ (test-assert "object is a record" (object? obj))
+ (test-equal "name is set correctly" "player" (object-name obj))
+ (test-equal "type is set correctly" "Player" (object-type obj))
+ (test-equal "x is set correctly" 100 (object-x obj))
+ (test-equal "y is set correctly" 200 (object-y obj))
+ (test-equal "properties contain text" "hello" (alist-ref 'text (object-properties obj)))))
+
+;; Test: tilemap record creation
+(test-group "tilemap-structure"
+ (let ((tm (make-tilemap width: 40
+ height: 30
+ tilewidth: 16
+ tileheight: 16
+ tileset-source: "test.tsx"
+ tileset: '()
+ layers: '()
+ objects: '())))
+ (test-assert "tilemap is a record" (tilemap? tm))
+ (test-equal "width is set correctly" 40 (tilemap-width tm))
+ (test-equal "height is set correctly" 30 (tilemap-height tm))
+ (test-equal "tilewidth is set correctly" 16 (tilemap-tilewidth tm))
+ (test-equal "tileheight is set correctly" 16 (tilemap-tileheight tm))))
+
+;; Test: tile record creation
+(test-group "tile-structure"
+ (let* ((rect (sdl2:make-rect 0 0 16 16))
+ (tile (make-tile id: 1 rect: rect)))
+ (test-assert "tile is a record" (tile? tile))
+ (test-equal "id is set correctly" 1 (tile-id tile))
+ (test-assert "rect is an SDL rect" (sdl2:rect? (tile-rect tile)))))
+
+;; Test: parse-tileset XML parsing
+(test-group "parse-tileset"
+ (let* ((xml "<?xml version='1.0' encoding='UTF-8'?>
+<tileset version='1.10' tiledversion='1.11.2' name='test' tilewidth='16' tileheight='16' spacing='1' tilecount='100' columns='10'>
+ <image source='test.png' width='160' height='160'/>
+</tileset>")
+ (ts (parse-tileset xml)))
+ (test-assert "returns a tileset" (tileset? ts))
+ (test-equal "parses tilewidth" 16 (tileset-tilewidth ts))
+ (test-equal "parses tileheight" 16 (tileset-tileheight ts))
+ (test-equal "parses spacing" 1 (tileset-spacing ts))
+ (test-equal "parses tilecount" 100 (tileset-tilecount ts))
+ (test-equal "parses columns" 10 (tileset-columns ts))
+ (test-equal "parses image source" "test.png" (tileset-image-source ts))))
+
+;; Test: parse-tilemap XML parsing
+(test-group "parse-tilemap"
+ (let* ((xml "<?xml version='1.0' encoding='UTF-8'?>
+<map version='1.10' orientation='orthogonal' width='10' height='10' tilewidth='16' tileheight='16'>
+ <tileset firstgid='1' source='test.tsx'/>
+ <layer id='1' name='ground' width='10' height='10'>
+ <data encoding='csv'>
+1,2,3,4,5,6,7,8,9,10,
+11,12,13,14,15,16,17,18,19,20
+</data>
+ </layer>
+</map>")
+ (tm (parse-tilemap xml)))
+ (test-assert "returns a tilemap" (tilemap? tm))
+ (test-equal "parses width" 10 (tilemap-width tm))
+ (test-equal "parses height" 10 (tilemap-height tm))
+ (test-equal "parses tilewidth" 16 (tilemap-tilewidth tm))
+ (test-equal "parses tileheight" 16 (tilemap-tileheight tm))
+ (test-equal "parses tileset source" "test.tsx" (tilemap-tileset-source tm))
+ (test-assert "has layers" (not (null? (tilemap-layers tm))))
+ (test-equal "first layer name" "ground" (layer-name (car (tilemap-layers tm))))))
+
+;; Test: parse-tilemap with objects
+(test-group "parse-tilemap-with-objects"
+ (let* ((xml "<?xml version='1.0' encoding='UTF-8'?>
+<map version='1.10' orientation='orthogonal' width='10' height='10' tilewidth='16' tileheight='16'>
+ <tileset firstgid='1' source='test.tsx'/>
+ <objectgroup id='1' name='entities'>
+ <object id='1' name='player' type='Player' x='50' y='50' width='16' height='16'>
+ <properties>
+ <property name='speed' value='5'/>
+ </properties>
+ </object>
+ </objectgroup>
+</map>")
+ (tm (parse-tilemap xml)))
+ (test-assert "has objects" (not (null? (tilemap-objects tm))))
+ (let ((obj (car (tilemap-objects tm))))
+ (test-equal "object name" "player" (object-name obj))
+ (test-equal "object type" "Player" (object-type obj))
+ (test-equal "object x" 50 (object-x obj))
+ (test-equal "object y" 50 (object-y obj))
+ (test-equal "object has properties" "5" (alist-ref 'speed (object-properties obj))))))
+
+(test-end "tilemap-module")
diff --git a/tests/world-test.scm b/tests/world-test.scm
new file mode 100644
index 0000000..c758d2a
--- /dev/null
+++ b/tests/world-test.scm
@@ -0,0 +1,239 @@
+;; Load dependencies first
+(import scheme
+ (chicken base)
+ (chicken keyword)
+ defstruct
+ srfi-64
+ (only srfi-1 every member make-list))
+
+;; Create a mock tilemap module to avoid SDL dependency
+(module tilemap *
+ (import scheme (chicken base) defstruct)
+
+ (defstruct tileset
+ tilewidth
+ tileheight
+ spacing
+ tilecount
+ columns
+ image-source
+ image)
+
+ (defstruct layer
+ name
+ width
+ height
+ map)
+
+ (defstruct tilemap
+ width
+ height
+ tilewidth
+ tileheight
+ tileset-source
+ tileset
+ layers
+ objects))
+
+(import tilemap)
+
+;; Load entity module first (since world now imports entity)
+(include "entity.scm")
+(import entity)
+
+;; Load the module source directly
+(include "world.scm")
+;; Now import it to access the exported functions
+(import world)
+
+;; Test suite for world module
+(test-begin "world-module")
+
+;; Test: tilemap-tile-at retrieves tile IDs
+(test-group "tilemap-tile-at"
+ (test-group "valid positions in a small 3x3 tilemap"
+ (let* ((layer1 (make-layer name: "test" width: 3 height: 3
+ map: '((1 2 3) (4 5 6) (7 8 9))))
+ (tm (make-tilemap width: 3 height: 3
+ tilewidth: 16 tileheight: 16
+ tileset-source: ""
+ tileset: #f
+ layers: (list layer1)
+ objects: '())))
+ (test-equal "top-left corner" 1 (tilemap-tile-at tm 0 0))
+ (test-equal "top-right corner" 3 (tilemap-tile-at tm 2 0))
+ (test-equal "bottom-left corner" 7 (tilemap-tile-at tm 0 2))
+ (test-equal "center" 5 (tilemap-tile-at tm 1 1))))
+
+ (test-group "out-of-bounds returns 0"
+ (let* ((layer1 (make-layer name: "test" width: 3 height: 3
+ map: '((1 2 3) (4 5 6) (7 8 9))))
+ (tm (make-tilemap width: 3 height: 3
+ tilewidth: 16 tileheight: 16
+ tileset-source: ""
+ tileset: #f
+ layers: (list layer1)
+ objects: '())))
+ (test-equal "negative col" 0 (tilemap-tile-at tm -1 0))
+ (test-equal "col beyond width" 0 (tilemap-tile-at tm 3 0))
+ (test-equal "negative row" 0 (tilemap-tile-at tm 0 -1))
+ (test-equal "row beyond height" 0 (tilemap-tile-at tm 0 3))))
+
+ (test-group "zero tiles are skipped to next layer"
+ (let* ((layer1 (make-layer name: "test1" width: 3 height: 3
+ map: '((0 0 0) (0 0 0) (0 0 0))))
+ (layer2 (make-layer name: "test2" width: 3 height: 3
+ map: '((1 2 3) (4 5 6) (7 8 9))))
+ (tm (make-tilemap width: 3 height: 3
+ tilewidth: 16 tileheight: 16
+ tileset-source: ""
+ tileset: #f
+ layers: (list layer1 layer2)
+ objects: '())))
+ (test-equal "skips zero in layer1, finds in layer2"
+ 5 (tilemap-tile-at tm 1 1)))))
+
+;; Test: scene record creation
+(test-group "scene-structure"
+ (let ((scene (make-scene entities: '() tilemap: #f)))
+ (test-assert "scene is a record" (scene? scene))
+ (test-equal "entities list is empty" '() (scene-entities scene))
+ (test-equal "tilemap is #f" #f (scene-tilemap scene))))
+
+;; Test: scene with entities and tilemap
+(test-group "scene-with-data"
+ (let* ((player (make-player-entity 100 100 16 16))
+ (enemy '(#:type enemy #:x 200 #:y 200))
+ (tilemap "mock-tilemap")
+ (scene (make-scene entities: (list player enemy)
+ tilemap: tilemap)))
+ (test-equal "scene has 2 entities"
+ 2
+ (length (scene-entities scene)))
+ (test-equal "first entity is player"
+ 'player
+ (entity-type (car (scene-entities scene))))
+ (test-equal "tilemap is set correctly"
+ "mock-tilemap"
+ (scene-tilemap scene))))
+
+;; Test: scene-add-entity adds entity to scene
+(test-group "scene-add-entity"
+ (let* ((player (make-player-entity 100 100 16 16))
+ (scene (make-scene entities: (list player) tilemap: #f))
+ (enemy '(#:type enemy #:x 200 #:y 200)))
+
+ (test-equal "initial entity count" 1 (length (scene-entities scene)))
+
+ (scene-add-entity scene enemy)
+
+ (test-equal "entity count after add" 2 (length (scene-entities scene)))
+ (test-equal "second entity is enemy"
+ 'enemy
+ (entity-type (cadr (scene-entities scene))))))
+
+;; Test: scene-add-entity appends to end
+(test-group "scene-add-entity-order"
+ (let* ((e1 '(#:type a #:x 1))
+ (e2 '(#:type b #:x 2))
+ (e3 '(#:type c #:x 3))
+ (scene (make-scene entities: (list e1) tilemap: #f)))
+
+ (scene-add-entity scene e2)
+ (scene-add-entity scene e3)
+
+ (test-equal "entities are in order"
+ '(a b c)
+ (map entity-type (scene-entities scene)))))
+
+;; Test: scene-update-entities applies function to all entities
+(test-group "scene-update-entities"
+ (let* ((e1 '(#:type player #:x 100 #:y 100))
+ (e2 '(#:type enemy #:x 200 #:y 200))
+ (scene (make-scene entities: (list e1 e2) tilemap: #f))
+ ;; Function that moves all entities right by 10
+ (move-right (lambda (entity)
+ (let ((x (entity-ref entity #:x))
+ (y (entity-ref entity #:y))
+ (type (entity-ref entity #:type)))
+ (list #:type type #:x (+ x 10) #:y y)))))
+
+ (scene-update-entities scene move-right)
+
+ (test-equal "first entity moved right"
+ 110
+ (entity-ref (car (scene-entities scene)) #:x))
+ (test-equal "second entity moved right"
+ 210
+ (entity-ref (cadr (scene-entities scene)) #:x))
+ (test-equal "y values unchanged"
+ 100
+ (entity-ref (car (scene-entities scene)) #:y))))
+
+;; Test: scene-update-entities with identity function
+(test-group "scene-update-entities-identity"
+ (let* ((e1 '(#:type player #:x 100))
+ (e2 '(#:type enemy #:x 200))
+ (scene (make-scene entities: (list e1 e2) tilemap: #f)))
+
+ (scene-update-entities scene (lambda (e) e))
+
+ (test-equal "entity count unchanged" 2 (length (scene-entities scene)))
+ (test-equal "first entity unchanged"
+ 100
+ (entity-ref (car (scene-entities scene)) #:x))))
+
+;; Test: scene mutation
+(test-group "scene-mutation"
+ (let* ((scene (make-scene entities: '() tilemap: #f))
+ (player (make-player-entity 10 20 16 16)))
+
+ ;; Add entity
+ (scene-add-entity scene player)
+ (test-equal "entity added" 1 (length (scene-entities scene)))
+
+ ;; Update entities
+ (scene-update-entities scene
+ (lambda (e)
+ (let ((x (entity-ref e #:x))
+ (y (entity-ref e #:y))
+ (type (entity-type e)))
+ (list #:type type #:x (* x 2) #:y (* y 2)
+ #:width 16 #:height 16))))
+
+ (test-equal "entity x doubled" 20 (entity-ref (car (scene-entities scene)) #:x))
+ (test-equal "entity y doubled" 40 (entity-ref (car (scene-entities scene)) #:y))))
+
+;; Test: scene-tilemap-set!
+(test-group "scene-tilemap-mutation"
+ (let ((scene (make-scene entities: '() tilemap: #f)))
+ (test-equal "tilemap initially #f" #f (scene-tilemap scene))
+
+ (scene-tilemap-set! scene "new-tilemap")
+ (test-equal "tilemap updated" "new-tilemap" (scene-tilemap scene))))
+
+;; Create a test tilemap for the filter test
+(define test-tilemap
+ (make-tilemap width: 3 height: 3
+ tilewidth: 16 tileheight: 16
+ tileset-source: ""
+ tileset: #f
+ layers: '()
+ objects: '()))
+
+;; Test: scene-filter-entities
+(test-group "scene-filter-entities"
+ (let* ((e1 (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16))
+ (e2 (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16))
+ (scene (make-scene entities: (list e1 e2)
+ tilemap: test-tilemap
+ camera: (make-camera x: 0 y: 0)
+ tileset-texture: #f)))
+ (scene-filter-entities scene
+ (lambda (e) (eq? (entity-ref e #:type #f) 'player)))
+ (test-equal "keeps matching entities" 1 (length (scene-entities scene)))
+ (test-equal "kept entity is player"
+ 'player
+ (entity-ref (car (scene-entities scene)) #:type #f))))
+
+(test-end "world-module")