diff options
Diffstat (limited to 'tests/tilemap-test.scm')
| -rw-r--r-- | tests/tilemap-test.scm | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/tests/tilemap-test.scm b/tests/tilemap-test.scm new file mode 100644 index 0000000..a76cff9 --- /dev/null +++ b/tests/tilemap-test.scm @@ -0,0 +1,204 @@ +;; 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 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 "<?xml version='1.0' encoding='UTF-8'?> +<tileset version='1.10' tiledversion='1.11.2' name='test' tilewidth='16' tileheight='16' spacing='1' tilecount='100' columns='10'> + <image source='test.png' width='160' height='160'/> +</tileset>") + (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 "<?xml version='1.0' encoding='UTF-8'?> +<map version='1.10' orientation='orthogonal' width='10' height='10' tilewidth='16' tileheight='16'> + <tileset firstgid='1' source='test.tsx'/> + <layer id='1' name='ground' width='10' height='10'> + <data encoding='csv'> +1,2,3,4,5,6,7,8,9,10, +11,12,13,14,15,16,17,18,19,20 +</data> + </layer> +</map>") + (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 "<?xml version='1.0' encoding='UTF-8'?> +<map version='1.10' orientation='orthogonal' width='10' height='10' tilewidth='16' tileheight='16'> + <tileset firstgid='1' source='test.tsx'/> + <objectgroup id='1' name='entities'> + <object id='1' name='player' type='Player' x='50' y='50' width='16' height='16'> + <properties> + <property name='speed' value='5'/> + </properties> + </object> + </objectgroup> +</map>") + (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") |