blob: c4fd887975b2e04c077759dfbf316c712766b943 (
plain)
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
;; 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)))
(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: scene with entities and tilemap
(test-group "scene-with-data"
(let* ((player (make-player-entity 100 100 16 16))
(enemy '(#:type enemy #:x 200 #:y 200))
(tilemap "mock-tilemap")
(scene (make-scene entities: (list player enemy)
tilemap: tilemap)))
(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-player-entity 100 100 16 16))
(scene (make-scene entities: (list player) tilemap: #f))
(enemy '(#:type enemy #:x 200 #:y 200)))
(test-equal "initial entity count" 1 (length (scene-entities scene)))
(scene-add-entity scene enemy)
(test-equal "entity count after add" 2 (length (scene-entities scene)))
(test-equal "second entity is enemy"
'enemy
(entity-type (cadr (scene-entities scene))))))
;; 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)))
(scene-add-entity scene e2)
(scene-add-entity scene e3)
(test-equal "entities are in order"
'(a b c)
(map entity-type (scene-entities scene)))))
;; Test: scene-update-entities applies function to all entities
(test-group "scene-update-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))
;; Function that moves all entities right by 10
(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)))))
(scene-update-entities scene move-right)
(test-equal "first entity moved right"
110
(entity-ref (car (scene-entities scene)) #:x))
(test-equal "second entity moved right"
210
(entity-ref (cadr (scene-entities scene)) #:x))
(test-equal "y values unchanged"
100
(entity-ref (car (scene-entities scene)) #:y))))
;; Test: scene-update-entities with identity function
(test-group "scene-update-entities-identity"
(let* ((e1 '(#:type player #:x 100))
(e2 '(#:type enemy #:x 200))
(scene (make-scene entities: (list e1 e2) tilemap: #f)))
(scene-update-entities scene (lambda (e) e))
(test-equal "entity count unchanged" 2 (length (scene-entities scene)))
(test-equal "first entity unchanged"
100
(entity-ref (car (scene-entities scene)) #:x))))
;; Test: scene mutation
(test-group "scene-mutation"
(let* ((scene (make-scene entities: '() tilemap: #f))
(player (make-player-entity 10 20 16 16)))
;; Add entity
(scene-add-entity scene player)
(test-equal "entity added" 1 (length (scene-entities scene)))
;; Update entities
(scene-update-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: scene-tilemap-set!
(test-group "scene-tilemap-mutation"
(let ((scene (make-scene entities: '() tilemap: #f)))
(test-equal "tilemap initially #f" #f (scene-tilemap scene))
(scene-tilemap-set! scene "new-tilemap")
(test-equal "tilemap updated" "new-tilemap" (scene-tilemap scene))))
;; 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)))
(scene-filter-entities scene
(lambda (e) (eq? (entity-ref e #:type #f) 'player)))
(test-equal "keeps matching entities" 1 (length (scene-entities scene)))
(test-equal "kept entity is player"
'player
(entity-ref (car (scene-entities scene)) #: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)))
(camera-follow! cam entity 600 400)
(test-equal "centers camera x on entity" 100 (camera-x cam))
(test-equal "centers camera y on entity" 100 (camera-y cam)))
(let* ((cam (make-camera x: 0 y: 0))
(entity (list #:type 'player #:x 50 #:y 30 #:width 16 #:height 16)))
(camera-follow! cam entity 600 400)
(test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam))
(test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam))))
(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)))
(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)))
(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-end "world-module")
|
