;; 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 downstroke-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 downstroke-tilemap) ;; Load entity module first (since world now imports entity) (include "entity.scm") (import downstroke-entity) ;; Load the module source directly (include "world.scm") ;; Now import it to access the exported functions (import downstroke-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 camera-target: #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-equal "background defaults to #f" #f (scene-background scene)) (test-equal "tileset defaults to #f" #f (scene-tileset scene))) (let ((s (make-scene entities: '() tilemap: #f camera-target: #f background: '(40 44 52)))) (test-equal "background RGB stored" '(40 44 52) (scene-background s))) (let ((s (make-scene entities: '() tilemap: #f camera-target: #f background: '(1 2 3 200)))) (test-equal "background RGBA stored" '(1 2 3 200) (scene-background s)))) ;; 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 camera-target: #f))) (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 camera-target: #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 camera-target: #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 camera-target: #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 camera-target: #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 camera-target: #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 camera-target: #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 camera-target: #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-group "camera-follow!" (let* ((cam (make-camera x: 0 y: 0)) (entity (list #:type 'player #:x 400 #:y 300 #:width 16 #:height 16))) (camera-follow! cam entity 600 400) (test-equal "centers camera x on entity" 100 (camera-x cam)) (test-equal "centers camera y on entity" 100 (camera-y cam))) (let* ((cam (make-camera x: 0 y: 0)) (entity (list #:type 'player #:x 50 #:y 30 #:width 16 #:height 16))) (camera-follow! cam entity 600 400) (test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam)) (test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam)))) (test-group "scene-find-tagged" (let* ((p (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) (e (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(enemy npc))) (s (make-scene entities: (list p e) tilemap: #f camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f))) (test-equal "finds entity with matching tag" p (scene-find-tagged s 'player)) (test-equal "finds enemy by 'enemy tag" e (scene-find-tagged s 'enemy)) (test-equal "finds entity with second tag in list" e (scene-find-tagged s 'npc)) (test-equal "returns #f when tag not found" #f (scene-find-tagged s 'boss)))) (test-group "scene-find-all-tagged" (let* ((p1 (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player friendly))) (p2 (list #:type 'ally #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(ally friendly))) (e (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(enemy))) (s (make-scene entities: (list p1 p2 e) tilemap: #f camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f))) (test-equal "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) (test-equal "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) (test-group "scene-sync-groups!" (let* ((gid 'g1) (origin (list #:type 'group-origin #:group-origin? #t #:group-id gid #:x 100 #:y 200 #:width 0 #:height 0)) (m1 (list #:type 'part #:group-id gid #:group-local-x 5 #:group-local-y 0 #:x 0 #:y 0 #:width 8 #:height 8)) (m2 (list #:type 'part #:group-id gid #:group-local-x 0 #:group-local-y 7 #:x 0 #:y 0 #:width 8 #:height 8)) (s (make-scene entities: (list origin m1 m2) tilemap: #f camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f))) (scene-sync-groups! s) (let ((es (scene-entities s))) (test-equal "member 1 follows origin" 105 (entity-ref (list-ref es 1) #:x)) (test-equal "member 1 y" 200 (entity-ref (list-ref es 1) #:y)) (test-equal "member 2 x" 100 (entity-ref (list-ref es 2) #:x)) (test-equal "member 2 y" 207 (entity-ref (list-ref es 2) #:y))))) (test-end "world-module")