From 526e6cdcdf1025d5e29680bc99ab910c79789764 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Sun, 5 Apr 2026 14:17:51 +0100 Subject: Initial port of macroknight to an engine --- tests/tilemap-test.scm | 204 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 204 insertions(+) create mode 100644 tests/tilemap-test.scm (limited to 'tests/tilemap-test.scm') 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 " + + +") + (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 " + + + + +1,2,3,4,5,6,7,8,9,10, +11,12,13,14,15,16,17,18,19,20 + + +") + (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") -- cgit v1.2.3