blob: 88fb544582089293fb3672cbf0881891983b207a (
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
|
;; 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)
;; 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)
(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-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")
|
