diff options
Diffstat (limited to 'tests/world-test.scm')
| -rw-r--r-- | tests/world-test.scm | 124 |
1 files changed, 61 insertions, 63 deletions
diff --git a/tests/world-test.scm b/tests/world-test.scm index dbae9d9..1b368c0 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -134,22 +134,21 @@ (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)))))) + (let ((scene2 (scene-add-entity scene enemy))) + (test-equal "original scene unchanged" 1 (length (scene-entities scene))) + (test-equal "entity count after add" 2 (length (scene-entities scene2))) + (test-equal "second entity is enemy" + 'enemy + (entity-type (cadr (scene-entities scene2))))))) ;; 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) + (scene (make-scene entities: (list e1) tilemap: #f camera-target: #f)) + (scene (scene-add-entity scene e2)) + (scene (scene-add-entity scene e3))) (test-equal "entities are in order" '(a b c) @@ -160,66 +159,62 @@ (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) + (list #:type type #:x (+ x 10) #:y y)))) + (scene2 (scene-update-entities scene move-right))) + (test-equal "original scene unchanged" + 100 + (entity-ref (car (scene-entities scene)) #:x)) (test-equal "first entity moved right" 110 - (entity-ref (car (scene-entities scene)) #:x)) + (entity-ref (car (scene-entities scene2)) #:x)) (test-equal "second entity moved right" 210 - (entity-ref (cadr (scene-entities scene)) #:x)) + (entity-ref (cadr (scene-entities scene2)) #:x)) (test-equal "y values unchanged" 100 - (entity-ref (car (scene-entities scene)) #:y)))) + (entity-ref (car (scene-entities scene2)) #: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)) + (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) + (scene2 (scene-update-entities scene (lambda (e) e)))) - (test-equal "entity count unchanged" 2 (length (scene-entities scene))) + (test-equal "entity count unchanged" 2 (length (scene-entities scene2))) (test-equal "first entity unchanged" 100 - (entity-ref (car (scene-entities scene)) #:x)))) + (entity-ref (car (scene-entities scene2)) #:x)))) -;; Test: scene mutation -(test-group "scene-mutation" +;; Test: scene chaining (was mutation test) +(test-group "scene-chaining" (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f)) - (player (make-player-entity 10 20 16 16))) + (player (make-player-entity 10 20 16 16)) + (scene (scene-add-entity scene player))) - ;; 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))) + (let ((scene (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: update-scene for tilemap +(test-group "scene-tilemap-update" + (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f)) + (scene2 (update-scene scene tilemap: "new-tilemap"))) (test-equal "tilemap initially #f" #f (scene-tilemap scene)) - - (scene-tilemap-set! scene "new-tilemap") - (test-equal "tilemap updated" "new-tilemap" (scene-tilemap scene)))) + (test-equal "tilemap updated in new scene" "new-tilemap" (scene-tilemap scene2)))) ;; Create a test tilemap for the filter test (define test-tilemap @@ -238,25 +233,27 @@ 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))) + camera-target: #f)) + (scene2 (scene-filter-entities scene + (lambda (e) (eq? (entity-ref e #:type #f) 'player))))) + (test-equal "original scene unchanged" 2 (length (scene-entities scene))) + (test-equal "keeps matching entities" 1 (length (scene-entities scene2))) (test-equal "kept entity is player" 'player - (entity-ref (car (scene-entities scene)) #:type #f)))) + (entity-ref (car (scene-entities scene2)) #:type #f)))) - (test-group "camera-follow!" + (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))) + (entity (list #:type 'player #:x 400 #:y 300 #:width 16 #:height 16)) + (cam2 (camera-follow cam entity 600 400))) + (test-equal "original camera unchanged" 0 (camera-x cam)) + (test-equal "centers camera x on entity" 100 (camera-x cam2)) + (test-equal "centers camera y on entity" 100 (camera-y cam2))) (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)))) + (entity (list #:type 'player #:x 50 #:y 30 #:width 16 #:height 16)) + (cam2 (camera-follow cam entity 600 400))) + (test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam2)) + (test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam2)))) (test-group "scene-find-tagged" (let* ((p (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) @@ -277,7 +274,7 @@ (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!" + (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)) @@ -286,9 +283,10 @@ (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))) + camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f)) + (s2 (scene-sync-groups s))) + (test-equal "original scene members unchanged" 0 (entity-ref (list-ref (scene-entities s) 1) #:x)) + (let ((es (scene-entities s2))) (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)) |