diff options
| author | Gene Pasquet <dev@etenil.net> | 2026-04-18 05:59:07 +0100 |
|---|---|---|
| committer | Gene Pasquet <dev@etenil.net> | 2026-04-18 05:59:07 +0100 |
| commit | 84f251ee6e829d33a4f29aa4043924023a378724 (patch) | |
| tree | ab03d18fa192303bf2e1758743ac16c11d9da87f /tests/world-test.scm | |
| parent | c2085be2dd2a0cb3da05991847e35080915e547e (diff) | |
Re-format
Diffstat (limited to 'tests/world-test.scm')
| -rw-r--r-- | tests/world-test.scm | 192 |
1 files changed, 96 insertions, 96 deletions
diff --git a/tests/world-test.scm b/tests/world-test.scm index 0915cd2..9fd4947 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -96,7 +96,7 @@ layers: (list layer1 layer2) objects: '()))) (test "skips zero in layer1, finds in layer2" - 5 (tilemap-tile-at tm 1 1))))) + 5 (tilemap-tile-at tm 1 1))))) ;; Test: scene record creation (test-group "scene-structure" @@ -122,14 +122,14 @@ tilemap: tilemap camera-target: #f))) (test "scene has 2 entities" - 2 - (length (scene-entities scene))) + 2 + (length (scene-entities scene))) (test "first entity is player" - 'player - (entity-type (car (scene-entities scene)))) + 'player + (entity-type (car (scene-entities scene)))) (test "tilemap is set correctly" - "mock-tilemap" - (scene-tilemap scene)))) + "mock-tilemap" + (scene-tilemap scene)))) ;; Test: scene-add-entity adds entity to scene (test-group "scene-add-entity" @@ -143,8 +143,8 @@ (test "original scene unchanged" 1 (length (scene-entities scene))) (test "entity count after add" 2 (length (scene-entities scene2))) (test "second entity is enemy" - 'enemy - (entity-type (cadr (scene-entities scene2))))))) + 'enemy + (entity-type (cadr (scene-entities scene2))))))) ;; Test: scene-add-entity appends to end (test-group "scene-add-entity-order" @@ -156,8 +156,8 @@ (scene (scene-add-entity scene e3))) (test "entities are in order" - '(a b c) - (map entity-type (scene-entities scene))))) + '(a b c) + (map entity-type (scene-entities scene))))) ;; Test: scene-map-entities applies function to all entities (test-group "scene-map-entities" @@ -165,24 +165,24 @@ (e2 (entity #:type 'enemy #:x 200 #:y 200)) (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) (move-right (lambda (scene ent) - (let ((x (entity-ref ent #:x)) - (y (entity-ref ent #:y)) - (type (entity-ref ent #:type))) - (entity #:type type #:x (+ x 10) #:y y)))) + (let ((x (entity-ref ent #:x)) + (y (entity-ref ent #:y)) + (type (entity-ref ent #:type))) + (entity #:type type #:x (+ x 10) #:y y)))) (scene2 (scene-map-entities scene move-right))) (test "original scene unchanged" - 100 - (entity-ref (car (scene-entities scene)) #:x)) + 100 + (entity-ref (car (scene-entities scene)) #:x)) (test "first entity moved right" - 110 - (entity-ref (car (scene-entities scene2)) #:x)) + 110 + (entity-ref (car (scene-entities scene2)) #:x)) (test "second entity moved right" - 210 - (entity-ref (cadr (scene-entities scene2)) #:x)) + 210 + (entity-ref (cadr (scene-entities scene2)) #:x)) (test "y values unchanged" - 100 - (entity-ref (car (scene-entities scene2)) #:y)))) + 100 + (entity-ref (car (scene-entities scene2)) #:y)))) ;; Test: scene-map-entities with identity function (test-group "scene-map-entities-identity" @@ -193,8 +193,8 @@ (test "entity count unchanged" 2 (length (scene-entities scene2))) (test "first entity unchanged" - 100 - (entity-ref (car (scene-entities scene2)) #:x)))) + 100 + (entity-ref (car (scene-entities scene2)) #:x)))) ;; Test: scene chaining (was mutation test) (test-group "scene-chaining" @@ -205,12 +205,12 @@ (test "entity added" 1 (length (scene-entities scene))) (let ((scene (scene-map-entities scene - (lambda (scene e) - (let ((x (entity-ref e #:x)) - (y (entity-ref e #:y)) - (type (entity-type e))) - (entity #:type type #:x (* x 2) #:y (* y 2) - #:width 16 #:height 16)))))) + (lambda (scene e) + (let ((x (entity-ref e #:x)) + (y (entity-ref e #:y)) + (type (entity-type e))) + (entity #:type type #:x (* x 2) #:y (* y 2) + #:width 16 #:height 16)))))) (test "entity x doubled" 20 (entity-ref (car (scene-entities scene)) #:x)) (test "entity y doubled" 40 (entity-ref (car (scene-entities scene)) #:y))))) @@ -235,75 +235,75 @@ (let* ((e1 (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16)) (e2 (entity #: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)) + tilemap: test-tilemap + camera: (make-camera x: 0 y: 0) + tileset-texture: #f + camera-target: #f)) (scene2 (scene-filter-entities scene - (lambda (e) (eq? (entity-ref e #:type #f) 'player))))) + (lambda (e) (eq? (entity-ref e #:type #f) 'player))))) (test "original scene unchanged" 2 (length (scene-entities scene))) (test "keeps matching entities" 1 (length (scene-entities scene2))) (test "kept entity is player" - 'player - (entity-ref (car (scene-entities scene2)) #:type #f)))) - - (test-group "camera-follow" - (let* ((cam (make-camera x: 0 y: 0)) - (ent (entity #:type 'player #:x 400 #:y 300 #:width 16 #:height 16)) - (cam2 (camera-follow cam ent 600 400))) - (test "original camera unchanged" 0 (camera-x cam)) - (test "centers camera x on entity" 100 (camera-x cam2)) - (test "centers camera y on entity" 100 (camera-y cam2))) - (let* ((cam (make-camera x: 0 y: 0)) - (ent (entity #:type 'player #:x 50 #:y 30 #:width 16 #:height 16)) - (cam2 (camera-follow cam ent 600 400))) - (test "clamps camera x to 0 when entity near origin" 0 (camera-x cam2)) - (test "clamps camera y to 0 when entity near origin" 0 (camera-y cam2)))) - - (test-group "scene-find-tagged" - (let* ((p (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) - (e (entity #: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 "finds entity with matching tag" p (scene-find-tagged s 'player)) - (test "finds enemy by 'enemy tag" e (scene-find-tagged s 'enemy)) - (test "finds entity with second tag in list" e (scene-find-tagged s 'npc)) - (test "returns #f when tag not found" #f (scene-find-tagged s 'boss)))) - - (test-group "scene-find-all-tagged" - (let* ((p1 (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player friendly))) - (p2 (entity #:type 'ally #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(ally friendly))) - (e (entity #: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 "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) - (test "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) - - (test-group "sync-groups" - (let* ((gid 'g1) - (origin (entity #:type 'group-origin #:group-origin? #t #:group-id gid - #:x 100 #:y 200 #:width 0 #:height 0)) - (m1 (entity #:type 'part #:group-id gid #:group-local-x 5 #:group-local-y 0 - #:x 0 #:y 0 #:width 8 #:height 8)) - (m2 (entity #:type 'part #:group-id gid #:group-local-x 0 #:group-local-y 7 - #:x 0 #:y 0 #:width 8 #:height 8)) - (entities (list origin m1 m2)) - (result (sync-groups entities))) - (test "original list unchanged" 0 (entity-ref (list-ref entities 1) #:x)) - (test "member 1 follows origin" 105 (entity-ref (list-ref result 1) #:x)) - (test "member 1 y" 200 (entity-ref (list-ref result 1) #:y)) - (test "member 2 x" 100 (entity-ref (list-ref result 2) #:x)) - (test "member 2 y" 207 (entity-ref (list-ref result 2) #:y)))) - - (test-group "scene-transform-entities" - (let* ((e1 (entity #:type 'a #:x 1)) - (e2 (entity #:type 'b #:x 2)) - (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) - (scene2 (scene-transform-entities scene reverse))) - (test "transforms entity list" 'b - (entity-type (car (scene-entities scene2)))) - (test "original scene unchanged" 'a - (entity-type (car (scene-entities scene)))))) + 'player + (entity-ref (car (scene-entities scene2)) #:type #f)))) + +(test-group "camera-follow" + (let* ((cam (make-camera x: 0 y: 0)) + (ent (entity #:type 'player #:x 400 #:y 300 #:width 16 #:height 16)) + (cam2 (camera-follow cam ent 600 400))) + (test "original camera unchanged" 0 (camera-x cam)) + (test "centers camera x on entity" 100 (camera-x cam2)) + (test "centers camera y on entity" 100 (camera-y cam2))) + (let* ((cam (make-camera x: 0 y: 0)) + (ent (entity #:type 'player #:x 50 #:y 30 #:width 16 #:height 16)) + (cam2 (camera-follow cam ent 600 400))) + (test "clamps camera x to 0 when entity near origin" 0 (camera-x cam2)) + (test "clamps camera y to 0 when entity near origin" 0 (camera-y cam2)))) + +(test-group "scene-find-tagged" + (let* ((p (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) + (e (entity #: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 "finds entity with matching tag" p (scene-find-tagged s 'player)) + (test "finds enemy by 'enemy tag" e (scene-find-tagged s 'enemy)) + (test "finds entity with second tag in list" e (scene-find-tagged s 'npc)) + (test "returns #f when tag not found" #f (scene-find-tagged s 'boss)))) + +(test-group "scene-find-all-tagged" + (let* ((p1 (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player friendly))) + (p2 (entity #:type 'ally #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(ally friendly))) + (e (entity #: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 "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) + (test "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) + +(test-group "sync-groups" + (let* ((gid 'g1) + (origin (entity #:type 'group-origin #:group-origin? #t #:group-id gid + #:x 100 #:y 200 #:width 0 #:height 0)) + (m1 (entity #:type 'part #:group-id gid #:group-local-x 5 #:group-local-y 0 + #:x 0 #:y 0 #:width 8 #:height 8)) + (m2 (entity #:type 'part #:group-id gid #:group-local-x 0 #:group-local-y 7 + #:x 0 #:y 0 #:width 8 #:height 8)) + (entities (list origin m1 m2)) + (result (sync-groups entities))) + (test "original list unchanged" 0 (entity-ref (list-ref entities 1) #:x)) + (test "member 1 follows origin" 105 (entity-ref (list-ref result 1) #:x)) + (test "member 1 y" 200 (entity-ref (list-ref result 1) #:y)) + (test "member 2 x" 100 (entity-ref (list-ref result 2) #:x)) + (test "member 2 y" 207 (entity-ref (list-ref result 2) #:y)))) + +(test-group "scene-transform-entities" + (let* ((e1 (entity #:type 'a #:x 1)) + (e2 (entity #:type 'b #:x 2)) + (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) + (scene2 (scene-transform-entities scene reverse))) + (test "transforms entity list" 'b + (entity-type (car (scene-entities scene2)))) + (test "original scene unchanged" 'a + (entity-type (car (scene-entities scene)))))) (test-end "world-module") (test-exit) |
