blob: e86ea428e756ee75a2c8729dba81d2448bb98793 (
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
|
;; Load base deps
(import scheme
(chicken base)
(chicken keyword)
(only srfi-1 fold filter)
defstruct
test)
;; 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))
;; Load the real entity module (alist-based)
(include "entity.scm")
(import (downstroke entity))
(import (only (list-utils alist) plist->alist))
;; Test helper: build an alist entity from plist-style keyword args.
(define (entity . kws) (plist->alist kws))
;; Mock world module
(module (downstroke world) *
(import scheme (chicken base) defstruct)
(defstruct camera x y)
(defstruct scene entities tilemap tileset camera tileset-texture camera-target background engine-update)
(define (scene-add-entity scene entity)
(update-scene scene
entities: (append (scene-entities scene) (list entity)))))
(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:"))
;; Mock (downstroke prefabs)
;; The mock registry is just an alist ((type . constructor) ...) for test simplicity.
;; instantiate-prefab maps to the constructor call.
(module (downstroke prefabs) *
(import scheme (chicken base))
(define (instantiate-prefab registry type x y w h)
(let ((entry (assq type registry)))
(and entry ((cdr entry) x y w h)))))
(import (downstroke prefabs))
;; Load scene-loader module
(include "scene-loader.scm")
(import (downstroke scene-loader))
(test-begin "scene-loader")
(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)))
;; mock registry: alist of (type . constructor)
(registry
(list (cons 'player (lambda (x y w h) (entity #:type 'player #:x x #:y y #:width w #:height h)))
(cons 'enemy (lambda (x y w h) (entity #:type 'enemy #:x x #:y y #:width w #:height h)))))
(result (tilemap-objects->entities tm registry)))
(test "filters #f results: 2 entities from 3 objects"
2 (length result))
(test "first entity is player"
'player (entity-ref (car result) #:type))
(test "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 '())))
(test "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 "mock font is a list"
'font
(car font))))
(test-group "make-sprite-scene"
(let ((s (make-sprite-scene)))
(test "tilemap is #f" #f (scene-tilemap s))
(test "entities defaults to empty" '() (scene-entities s)))
(let* ((ts (make-tileset tilewidth: 8 tileheight: 8 spacing: 0 tilecount: 4
columns: 2 image-source: "" image: #f))
(s (make-sprite-scene tileset: ts
entities: (list (entity #:type 'a))
background: '(0 0 0))))
(test "tileset passed through" ts (scene-tileset s))
(test "entities passed through" 1 (length (scene-entities s)))
(test "background passed through" '(0 0 0) (scene-background s))
(test-assert "camera defaults to an origin camera" (scene-camera s))))
(test-end "scene-loader")
(test-exit)
|
