diff options
Diffstat (limited to 'tests/world-test.scm')
| -rw-r--r-- | tests/world-test.scm | 239 |
1 files changed, 239 insertions, 0 deletions
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") |