blob: 61f142f910e70b5aeeddb62f1417fe872f7b4cb7 (
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
|
;; Load base deps
(import scheme
(chicken base)
(chicken keyword)
(only srfi-1 fold filter)
defstruct
srfi-64)
;; Mock tilemap module
(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 object name type x y width height properties)
(defstruct tilemap width height tilewidth tileheight tileset-source tileset layers objects)
(defstruct tile id rect)
(define (tileset-tile ts id) (make-tile id: id rect: #f))
(define (tile-rect t) #f)
(define (load-tilemap filename) (make-tilemap width: 100 height: 100 tilewidth: 16 tileheight: 16 tileset-source: "" tileset: (make-tileset tilewidth: 16 tileheight: 16 spacing: 0 tilecount: 256 columns: 16 image-source: "" image: #f) layers: '() objects: '()))
(define (load-tileset filename) (make-tileset tilewidth: 16 tileheight: 16 spacing: 0 tilecount: 256 columns: 16 image-source: "" image: #f)))
(import downstroke/tilemap)
;; Mock entity module (minimal)
(module downstroke/entity *
(import scheme (chicken base))
(define (entity-ref entity key #!optional (default #f))
(let loop ((plist entity))
(cond
((null? plist) (if (procedure? default) (default) default))
((eq? (car plist) key) (cadr plist))
(else (loop (cddr plist))))))
(define (entity-set entity key val)
(let loop ((plist entity) (acc '()))
(cond
((null? plist) (reverse (cons val (cons key acc))))
((eq? (car plist) key) (append (reverse acc) (cons key (cons val (cddr plist)))))
(else (loop (cddr plist) (cons (cadr plist) (cons (car plist) acc)))))))
(define (entity-type entity)
(entity-ref entity #:type #f)))
(import downstroke/entity)
;; Mock world module
(module downstroke/world *
(import scheme (chicken base) defstruct)
(defstruct camera x y)
(defstruct scene entities tilemap camera tileset-texture camera-target)
(define (scene-add-entity scene entity)
(scene-entities-set! scene (cons entity (scene-entities scene)))
scene))
(import downstroke/world)
;; Mock assets module
(module downstroke/assets *
(import scheme (chicken base))
(define (asset-set! assets key value) #f))
(import downstroke/assets)
;; Mock engine module
(module downstroke/engine *
(import scheme (chicken base))
(define (game-renderer game) #f)
(define (game-asset-set! game key value) #f)
(define (game-scene-set! game scene) #f))
(import downstroke/engine)
;; Mock sdl2
(module sdl2 *
(import scheme (chicken base))
(define (create-texture-from-surface renderer surface) #f))
(import (prefix sdl2 "sdl2:"))
;; Mock sdl2-ttf
(module sdl2-ttf *
(import scheme (chicken base))
(define (open-font filename size) (list 'font filename size)))
(import (prefix sdl2-ttf "ttf:"))
;; Load scene-loader module
(include "scene-loader.scm")
(import downstroke/scene-loader)
(test-begin "scene-loader")
(test-group "make-prefab-registry + instantiate-prefab"
(let* ((registry (make-prefab-registry
'player (lambda (x y w h) (list #:type 'player #:x x #:y y #:width w #:height h))
'enemy (lambda (x y w h) (list #:type 'enemy #:x x #:y y #:width w #:height h))))
(result (instantiate-prefab registry 'player 10 20 16 16)))
(test-assert "instantiate-prefab returns a plist for known type"
(list? result))
(test-equal "player has correct x"
10
(entity-ref result #:x))
(test-equal "player has correct type"
'player
(entity-ref result #:type))
(test-assert "unknown type returns #f"
(not (instantiate-prefab registry 'unknown 10 20 16 16)))))
(test-group "tilemap-objects->entities"
(let* ((obj1 (make-object name: "player1" type: "player" x: 10 y: 20 width: 16 height: 16 properties: '()))
(obj2 (make-object name: "deco" type: "decoration" x: 50 y: 60 width: 32 height: 32 properties: '()))
(obj3 (make-object name: "enemy1" type: "enemy" x: 100 y: 120 width: 16 height: 16 properties: '()))
(tm (make-tilemap width: 100 height: 100 tilewidth: 16 tileheight: 16
tileset-source: "" tileset: #f layers: '()
objects: (list obj1 obj2 obj3)))
(fn (lambda (type x y w h)
(cond
((eq? type 'player) (list #:type 'player #:x x #:y y #:width w #:height h))
((eq? type 'enemy) (list #:type 'enemy #:x x #:y y #:width w #:height h))
(else #f))))
(result (tilemap-objects->entities tm fn)))
(test-equal "filters #f results: 2 entities from 3 objects"
2
(length result))
(test-equal "first entity is player"
'player
(entity-ref (car result) #:type))
(test-equal "second entity is enemy"
'enemy
(entity-ref (cadr result) #:type)))
(let* ((tm-empty (make-tilemap width: 100 height: 100 tilewidth: 16 tileheight: 16
tileset-source: "" tileset: #f layers: '()
objects: '()))
(result (tilemap-objects->entities tm-empty (lambda (t x y w h) #f))))
(test-equal "empty object list returns empty list"
0
(length result))))
(test-group "game-load-tilemap! / game-load-tileset! / game-load-font!"
;; game-load-tilemap! calls load-tilemap and stores result
;; We can't test file I/O directly, but we can verify the function exists
;; and that our mock game-asset-set! doesn't crash
(test-assert "game-load-tilemap! is a procedure"
(procedure? game-load-tilemap!))
(test-assert "game-load-tileset! is a procedure"
(procedure? game-load-tileset!))
(test-assert "game-load-font! is a procedure"
(procedure? game-load-font!))
;; game-load-font! with mock ttf returns a font value
(let* ((game #f) ; mock game (game-asset-set! ignores it in mock)
(font (ttf:open-font "test.ttf" 16)))
(test-equal "mock font is a list"
'font
(car font))))
(test-end "scene-loader")
|
