path: root/tests/world-test.scm

;; 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-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-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)))

    (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 (scene-add-entity scene e2))
         (scene (scene-add-entity scene e3)))

    (test-equal "entities are in order"
                '(a b c)
                (map entity-type (scene-entities scene)))))

;; Test: scene-map-entities applies function to all entities
(test-group "scene-map-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))
         (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))))
         (scene2 (scene-map-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 scene2)) #:x))
    (test-equal "second entity moved right"
                210
                (entity-ref (cadr (scene-entities scene2)) #:x))
    (test-equal "y values unchanged"
                100
                (entity-ref (car (scene-entities scene2)) #:y))))

;; Test: scene-map-entities with identity function
(test-group "scene-map-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))
         (scene2 (scene-map-entities scene (lambda (e) e))))

    (test-equal "entity count unchanged" 2 (length (scene-entities scene2)))
    (test-equal "first entity unchanged"
                100
                (entity-ref (car (scene-entities scene2)) #:x))))

;; Test: scene chaining (was mutation test)
(test-group "scene-chaining"
  (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f))
         (player (make-entity 10 20 16 16))
         (scene (scene-add-entity scene player)))

    (test-equal "entity added" 1 (length (scene-entities scene)))

    (let ((scene (scene-map-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))
    (test-equal "tilemap updated in new scene" "new-tilemap" (scene-tilemap scene2))))

;; 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))
         (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 scene2)) #: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))
           (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))
           (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)))
           (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 "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))
           (entities (list origin m1 m2))
           (result   (sync-groups entities)))
      (test-equal "original list unchanged" 0 (entity-ref (list-ref entities 1) #:x))
      (test-equal "member 1 follows origin" 105 (entity-ref (list-ref result 1) #:x))
      (test-equal "member 1 y" 200 (entity-ref (list-ref result 1) #:y))
      (test-equal "member 2 x" 100 (entity-ref (list-ref result 2) #:x))
      (test-equal "member 2 y" 207 (entity-ref (list-ref result 2) #:y))))

  (test-group "scene-transform-entities"
    (let* ((e1 '(#:type a #:x 1))
           (e2 '(#:type b #:x 2))
           (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f))
           (scene2 (scene-transform-entities scene reverse)))
      (test-equal "transforms entity list" 'b
        (entity-type (car (scene-entities scene2))))
      (test-equal "original scene unchanged" 'a
        (entity-type (car (scene-entities scene))))))

(test-end "world-module")