;; Load dependencies first
(import scheme
(chicken base)
(chicken io)
(chicken file)
(chicken format)
(chicken string)
(chicken pathname)
(chicken process-context)
(chicken pretty-print)
(only srfi-1 filter-map)
expat
matchable
defstruct
(prefix sdl2 sdl2:)
(prefix sdl2-image img:)
srfi-69
srfi-64)
;; Load the module source directly
(include "tilemap.scm")
;; Now import it to access the exported functions
(import downstroke/tilemap)
;; Test suite for tilemap module
(test-begin "tilemap-module")
;; Test: tileset record creation
(test-group "tileset-structure"
(let ((ts (make-tileset tilewidth: 16
tileheight: 16
spacing: 1
tilecount: 100
columns: 10
image-source: "test.png"
image: #f)))
(test-assert "tileset is a record" (tileset? ts))
(test-equal "tilewidth is set correctly" 16 (tileset-tilewidth ts))
(test-equal "tileheight is set correctly" 16 (tileset-tileheight ts))
(test-equal "spacing is set correctly" 1 (tileset-spacing ts))
(test-equal "tilecount is set correctly" 100 (tileset-tilecount ts))
(test-equal "columns is set correctly" 10 (tileset-columns ts))
(test-equal "image-source is set correctly" "test.png" (tileset-image-source ts))))
;; Test: tileset-rows calculation
(test-group "tileset-rows"
(let ((ts (make-tileset tilewidth: 16
tileheight: 16
spacing: 1
tilecount: 100
columns: 10
image-source: "test.png"
image: #f)))
(test-equal "100 tiles / 10 columns = 10 rows"
10
(tileset-rows ts)))
(let ((ts (make-tileset tilewidth: 16
tileheight: 16
spacing: 1
tilecount: 105
columns: 10
image-source: "test.png"
image: #f)))
(test-equal "105 tiles / 10 columns = 11 rows (ceiling)"
11
(tileset-rows ts))))
;; Test: tileset-tile calculates correct tile position
(test-group "tileset-tile"
(let* ((ts (make-tileset tilewidth: 16
tileheight: 16
spacing: 1
tilecount: 100
columns: 10
image-source: "test.png"
image: #f))
(tile1 (tileset-tile ts 1))
(tile11 (tileset-tile ts 11)))
(test-assert "tile1 is a tile record" (tile? tile1))
(test-equal "tile1 has correct id" 1 (tile-id tile1))
(test-assert "tile1 has a rect" (sdl2:rect? (tile-rect tile1)))
;; First tile should be at (0, 0)
(test-equal "tile1 x position" 0 (sdl2:rect-x (tile-rect tile1)))
(test-equal "tile1 y position" 0 (sdl2:rect-y (tile-rect tile1)))
;; Tile 11 should be at start of second row (x=0, y=17 with spacing)
(test-equal "tile11 x position" 0 (sdl2:rect-x (tile-rect tile11)))
(test-equal "tile11 y position" 17 (sdl2:rect-y (tile-rect tile11)))))
;; Test: layer record creation
(test-group "layer-structure"
(let ((layer (make-layer name: "ground"
width: 40
height: 30
map: '())))
(test-assert "layer is a record" (layer? layer))
(test-equal "name is set correctly" "ground" (layer-name layer))
(test-equal "width is set correctly" 40 (layer-width layer))
(test-equal "height is set correctly" 30 (layer-height layer))
(test-equal "map is empty list" '() (layer-map layer))))
;; Test: object record creation
(test-group "object-structure"
(let ((obj (make-object name: "player"
type: "Player"
x: 100
y: 200
width: 16
height: 16
properties: '((text . "hello")))))
(test-assert "object is a record" (object? obj))
(test-equal "name is set correctly" "player" (object-name obj))
(test-equal "type is set correctly" "Player" (object-type obj))
(test-equal "x is set correctly" 100 (object-x obj))
(test-equal "y is set correctly" 200 (object-y obj))
(test-equal "properties contain text" "hello" (alist-ref 'text (object-properties obj)))))
;; Test: tilemap record creation
(test-group "tilemap-structure"
(let ((tm (make-tilemap width: 40
height: 30
tilewidth: 16
tileheight: 16
tileset-source: "test.tsx"
tileset: '()
layers: '()
objects: '())))
(test-assert "tilemap is a record" (tilemap? tm))
(test-equal "width is set correctly" 40 (tilemap-width tm))
(test-equal "height is set correctly" 30 (tilemap-height tm))
(test-equal "tilewidth is set correctly" 16 (tilemap-tilewidth tm))
(test-equal "tileheight is set correctly" 16 (tilemap-tileheight tm))))
;; Test: tile record creation
(test-group "tile-structure"
(let* ((rect (sdl2:make-rect 0 0 16 16))
(tile (make-tile id: 1 rect: rect)))
(test-assert "tile is a record" (tile? tile))
(test-equal "id is set correctly" 1 (tile-id tile))
(test-assert "rect is an SDL rect" (sdl2:rect? (tile-rect tile)))))
;; Test: parse-tileset XML parsing
(test-group "parse-tileset"
(let* ((xml "
")
(ts (parse-tileset xml)))
(test-assert "returns a tileset" (tileset? ts))
(test-equal "parses tilewidth" 16 (tileset-tilewidth ts))
(test-equal "parses tileheight" 16 (tileset-tileheight ts))
(test-equal "parses spacing" 1 (tileset-spacing ts))
(test-equal "parses tilecount" 100 (tileset-tilecount ts))
(test-equal "parses columns" 10 (tileset-columns ts))
(test-equal "parses image source" "test.png" (tileset-image-source ts))))
;; Test: parse-tilemap XML parsing
(test-group "parse-tilemap"
(let* ((xml "
")
(tm (parse-tilemap xml)))
(test-assert "returns a tilemap" (tilemap? tm))
(test-equal "parses width" 10 (tilemap-width tm))
(test-equal "parses height" 10 (tilemap-height tm))
(test-equal "parses tilewidth" 16 (tilemap-tilewidth tm))
(test-equal "parses tileheight" 16 (tilemap-tileheight tm))
(test-equal "parses tileset source" "test.tsx" (tilemap-tileset-source tm))
(test-assert "has layers" (not (null? (tilemap-layers tm))))
(test-equal "first layer name" "ground" (layer-name (car (tilemap-layers tm))))))
;; Test: parse-tilemap with objects
(test-group "parse-tilemap-with-objects"
(let* ((xml "
")
(tm (parse-tilemap xml)))
(test-assert "has objects" (not (null? (tilemap-objects tm))))
(let ((obj (car (tilemap-objects tm))))
(test-equal "object name" "player" (object-name obj))
(test-equal "object type" "Player" (object-type obj))
(test-equal "object x" 50 (object-x obj))
(test-equal "object y" 50 (object-y obj))
(test-equal "object has properties" "5" (alist-ref 'speed (object-properties obj))))))
(test-end "tilemap-module")