blob: 1e3ab19039781abccd403e4ad1f9bb717b21cde8 (
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
|
(import test)
(include "entity.scm")
(import (downstroke entity))
(test-begin "entity")
;; Test: entity-ref retrieves values from entity alists
(test-group "entity-ref"
(let ((entity '((#:type . player)
(#:x . 100)
(#:y . 200)
(#:width . 16)
(#:height . 16))))
(test "retrieves type" 'player (entity-ref entity #:type))
(test "retrieves x" 100 (entity-ref entity #:x))
(test "retrieves y" 200 (entity-ref entity #:y))
(test "retrieves width" 16 (entity-ref entity #:width))
(test "retrieves height" 16 (entity-ref entity #:height)))
;; Test with default value
(let ((entity '((#:type . player))))
(test "returns default for missing key"
99
(entity-ref entity #:x 99))
(test "returns #f as default if not specified"
#f
(entity-ref entity #:missing-key))))
;; Test: entity-ref with procedure as default
(test-group "entity-ref-with-procedure-default"
(let ((entity '((#:type . player))))
(test "calls procedure default when key missing"
42
(entity-ref entity #:x (lambda () 42)))))
;; Test: make-player-entity creates valid player entity
(test-group "make-entity"
(let ((player (make-entity 50 75 16 16)))
(test-assert "returns a list" (list? player))
(test "has correct x" 50 (entity-ref player #:x))
(test "has correct y" 75 (entity-ref player #:y))
(test "has correct width" 16 (entity-ref player #:width))
(test "has correct height" 16 (entity-ref player #:height))))
;; Test: entity-type extracts type from entity
(test-group "entity-type"
(let ((player '((#:type . player) (#:x . 100)))
(enemy '((#:type . enemy) (#:x . 200))))
(test "extracts player type" 'player (entity-type player))
(test "extracts enemy type" 'enemy (entity-type enemy)))
(let ((no-type '((#:x . 100) (#:y . 200))))
(test "returns #f for entity without type"
#f
(entity-type no-type))))
;; Test: complex entity with multiple properties
(test-group "complex-entity"
(let ((entity '((#:type . enemy)
(#:x . 100)
(#:y . 200)
(#:width . 16)
(#:height . 16)
(#:health . 50)
(#:speed . 2.5)
(#:ai-state . patrol))))
(test "retrieves numeric property" 50 (entity-ref entity #:health))
(test "retrieves float property" 2.5 (entity-ref entity #:speed))
(test "retrieves symbol property" 'patrol (entity-ref entity #:ai-state))))
;; Test: entity-set updates entity properties
(test-group "entity-set"
(test-group "existing key is replaced"
(let ((e (entity-set '((#:x . 10) (#:y . 20)) #:x 15)))
(test "value updated" 15 (entity-ref e #:x))
(test "other key untouched" 20 (entity-ref e #:y))
;; alist length stays at 2 (one pair removed, one added) — not 3.
(test "no duplicate key: list length unchanged" 2 (length e))))
(test-group "new key is added"
(let ((e (entity-set '((#:x . 10)) #:vx 3)))
(test "new key present" 3 (entity-ref e #:vx))
(test "existing key untouched" 10 (entity-ref e #:x))
(test "list grows by one pair" 2 (length e)))))
(test-group "entity-set-many"
(test-group "Set multiple entities with cons"
(let ((e (entity-set-many '((#:x . 10) (#:y . 20))
'((#:x . 15) (#:y . 25)))))
(test "value x updated" 15 (entity-ref e #:x))
(test "value y updated" 25 (entity-ref e #:y)))))
;; Test: entity-update applies transformations
(test-group "entity-update"
(test-group "transform existing value"
(let ((e (entity-update '((#:x . 10) (#:y . 20)) #:x (lambda (v) (+ v 5)))))
(test "#:x is 15" 15 (entity-ref e #:x))
(test "#:y is 20" 20 (entity-ref e #:y))))
(test-group "missing key uses default"
(let ((e (entity-update '((#:x . 10)) #:health (lambda (v) (+ v 1)) 0)))
(test "#:health is 1" 1 (entity-ref e #:health))))
(test-group "missing key without default"
(let ((e (entity-update '((#:x . 10)) #:z (lambda (v) v))))
(test "#:z is #f" #f (entity-ref e #:z))))
(test-group "no duplicate keys"
(let ((e (entity-update '((#:x . 10) (#:y . 20)) #:x (lambda (v) (* v 2)))))
(test "length is 2" 2 (length e)))))
(test-group "entity-skips-pipeline?"
(test-assert "absent skip list"
(not (entity-skips-pipeline? '((#:type . a)) 'gravity)))
(test-assert "empty skip list"
(not (entity-skips-pipeline? '((#:skip-pipelines . ())) 'gravity)))
(test-assert "member"
(entity-skips-pipeline? '((#:skip-pipelines . (gravity velocity-x))) 'gravity))
(test-assert "not member"
(not (entity-skips-pipeline? '((#:skip-pipelines . (gravity))) 'velocity-x))))
(define-pipeline (fixture-pipeline fixture-skip) (scene_ ent _dt)
(entity-set ent #:x 42))
(test-group "define-pipeline"
(let ((e '((#:type . t) (#:x . 0))))
(test "runs body" 42 (entity-ref (fixture-pipeline #f e 0) #:x)))
(let ((e '((#:type . t) (#:x . 0) (#:skip-pipelines . (fixture-skip)))))
(test "skipped" 0 (entity-ref (fixture-pipeline #f e 0) #:x))))
(define-pipeline (guarded-pipeline guarded-skip) (scene_ ent _dt)
guard: (entity-ref ent #:active? #f)
(entity-set ent #:x 99))
(test-group "define-pipeline with guard:"
(let ((e '((#:type . t) (#:x . 0) (#:active? . #t))))
(test "runs body when guard passes" 99
(entity-ref (guarded-pipeline #f e 0) #:x)))
(let ((e '((#:type . t) (#:x . 0))))
(test "returns entity unchanged when guard fails" 0
(entity-ref (guarded-pipeline #f e 0) #:x)))
(let ((e '((#:type . t) (#:x . 0) (#:active? . #t) (#:skip-pipelines . (guarded-skip)))))
(test "skip-pipelines takes precedence over guard" 0
(entity-ref (guarded-pipeline #f e 0) #:x))))
(test-end "entity")
(test-exit)
|
