1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
;; 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
test)
;; 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 "tilewidth is set correctly" 16 (tileset-tilewidth ts))
(test "tileheight is set correctly" 16 (tileset-tileheight ts))
(test "spacing is set correctly" 1 (tileset-spacing ts))
(test "tilecount is set correctly" 100 (tileset-tilecount ts))
(test "columns is set correctly" 10 (tileset-columns ts))
(test "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 "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 "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 "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 "tile1 x position" 0 (sdl2:rect-x (tile-rect tile1)))
(test "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 "tile11 x position" 0 (sdl2:rect-x (tile-rect tile11)))
(test "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 "name is set correctly" "ground" (layer-name layer))
(test "width is set correctly" 40 (layer-width layer))
(test "height is set correctly" 30 (layer-height layer))
(test "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 "name is set correctly" "player" (object-name obj))
(test "type is set correctly" "Player" (object-type obj))
(test "x is set correctly" 100 (object-x obj))
(test "y is set correctly" 200 (object-y obj))
(test "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 "width is set correctly" 40 (tilemap-width tm))
(test "height is set correctly" 30 (tilemap-height tm))
(test "tilewidth is set correctly" 16 (tilemap-tilewidth tm))
(test "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 "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 "parses tilewidth" 16 (tileset-tilewidth ts))
(test "parses tileheight" 16 (tileset-tileheight ts))
(test "parses spacing" 1 (tileset-spacing ts))
(test "parses tilecount" 100 (tileset-tilecount ts))
(test "parses columns" 10 (tileset-columns ts))
(test "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 "parses width" 10 (tilemap-width tm))
(test "parses height" 10 (tilemap-height tm))
(test "parses tilewidth" 16 (tilemap-tilewidth tm))
(test "parses tileheight" 16 (tilemap-tileheight tm))
(test "parses tileset source" "test.tsx" (tilemap-tileset-source tm))
(test-assert "has layers" (not (null? (tilemap-layers tm))))
(test "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 "object name" "player" (object-name obj))
(test "object type" "Player" (object-type obj))
(test "object x" 50 (object-x obj))
(test "object y" 50 (object-y obj))
(test "object has properties" "5" (alist-ref 'speed (object-properties obj))))))
(test-end "tilemap-module")
(test-exit)
|
