blob: d14f12cf87355b88f35e60a9c9f697ce9c3ef6cd (
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
|
;; Load base deps
(import scheme
(chicken base)
(chicken keyword)
(only srfi-1 fold iota for-each)
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 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))
(import downstroke/tilemap)
;; Mock sdl2
(module sdl2 *
(import scheme (chicken base))
(define (make-rect x y w h) (list x y w h))
(define (render-copy! . args) #f)
(define (render-copy-ex! . args) #f)
(define (create-texture-from-surface . args) #f))
(import (prefix sdl2 "sdl2:"))
;; Mock sdl2-ttf
(module sdl2-ttf *
(import scheme (chicken base))
(define (render-text-solid . args) #f)
(define (size-utf8 . args) (values 0 0)))
(import (prefix sdl2-ttf "ttf:"))
;; Load entity module
(include "entity.scm")
(import downstroke/entity)
;; Load world module
(include "world.scm")
(import downstroke/world)
;; Load renderer module
(include "renderer.scm")
(import downstroke/renderer)
(test-begin "renderer")
(test-group "entity-screen-coords"
(let* ((cam (make-camera x: 10 y: 20))
(e (list #:x 50 #:y 80 #:width 16 #:height 16)))
(test-equal "subtracts camera offset from x"
40
(car (entity-screen-coords e cam)))
(test-equal "subtracts camera offset from y"
60
(cadr (entity-screen-coords e cam)))
(test-equal "preserves width"
16
(caddr (entity-screen-coords e cam)))
(test-equal "preserves height"
16
(cadddr (entity-screen-coords e cam))))
(let* ((cam (make-camera x: 0 y: 0))
(e (list #:x 100.7 #:y 200.3 #:width 16 #:height 16)))
(test-equal "floors fractional x"
100
(car (entity-screen-coords e cam)))
(test-equal "floors fractional y"
200
(cadr (entity-screen-coords e cam))))
(let* ((cam (make-camera x: 0 y: 0))
(e (list #:x 0 #:y 0 #:width 32 #:height 32)))
(test-equal "zero camera, zero position"
'(0 0 32 32)
(entity-screen-coords e cam))))
(test-group "entity-flip"
(test-equal "facing 1: no flip"
'()
(entity-flip (list #:facing 1)))
(test-equal "facing -1: horizontal flip"
'(horizontal)
(entity-flip (list #:facing -1)))
(test-equal "no facing key: defaults to no flip"
'()
(entity-flip (list #:x 0))))
(test-group "render-scene!"
(let* ((cam (make-camera x: 0 y: 0))
(tileset (make-tileset tilewidth: 16 tileheight: 16
spacing: 0 tilecount: 100 columns: 10
image-source: "" image: #f))
(layer (make-layer name: "ground" width: 2 height: 2
map: '((1 2) (3 4))))
(tilemap (make-tilemap width: 2 height: 2
tilewidth: 16 tileheight: 16
tileset-source: ""
tileset: tileset
layers: (list layer)
objects: '()))
(scene (make-scene entities: '()
tilemap: tilemap
camera: cam
tileset-texture: #f
camera-target: #f)))
(test-assert "does not crash on valid scene"
(begin (render-scene! #f scene) #t))))
(test-end "renderer")
|
