blob: 5c85ede7fc75b801fab85ad44cafb8cf2f667dee (
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
|
;; 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 tileset camera tileset-texture camera-target background)
(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) (list #:type 'player #:x x #:y y #:width w #:height h)))
(cons 'enemy (lambda (x y w h) (list #:type 'enemy #:x x #:y y #:width w #:height h)))))
(result (tilemap-objects->entities tm registry)))
(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 '())))
(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")
|
