aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/animation-test.scm55
-rw-r--r--tests/entity-test.scm12
-rw-r--r--tests/input-test.scm17
-rw-r--r--tests/world-test.scm8
4 files changed, 58 insertions, 34 deletions
diff --git a/tests/animation-test.scm b/tests/animation-test.scm
index aaaba41..9a71dec 100644
--- a/tests/animation-test.scm
+++ b/tests/animation-test.scm
@@ -9,13 +9,13 @@
(test-group "frame->tile-id"
(test-group "tile IDs only"
- (test-equal "first frame, frames (0)" 1 (frame->tile-id '(0) 0))
- (test-equal "wraps around" 1 (frame->tile-id '(0 1) 2))
- (test-equal "frame 1 of (27 28)" 29 (frame->tile-id '(27 28) 1)))
+ (test-equal "first frame, frames (0)" 0 (frame->tile-id '(0) 0))
+ (test-equal "wraps around" 0 (frame->tile-id '(0 1) 2))
+ (test-equal "frame 1 of (27 28)" 28 (frame->tile-id '(27 28) 1)))
(test-group "tile IDs and durations"
- (test-equal "first frame, frames (0)" 1 (frame->tile-id '((0 10)) 0))
- (test-equal "wraps around" 1 (frame->tile-id '((0 10) (1 10)) 2))
- (test-equal "frame 1 of (27 28)" 29 (frame->tile-id '((27 10) (28 10)) 1))))
+ (test-equal "first frame, frames (0)" 0 (frame->tile-id '((0 10)) 0))
+ (test-equal "wraps around" 0 (frame->tile-id '((0 10) (1 10)) 2))
+ (test-equal "frame 1 of (27 28)" 28 (frame->tile-id '((27 10) (28 10)) 1))))
(test-group "frame->duration"
(test-equal "first frame, frames (0)" 100 (frame->duration '((0 100)) 0))
@@ -31,17 +31,36 @@
(test-equal "resets tick" 0 (entity-ref switched #:anim-tick)))))
(test-group "animate-entity"
- (let* ((anims '((#:name walk #:frames (0 1) #:duration 4)))
- (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 0))
- (stepped (animate-entity entity anims)))
- (test-equal "increments tick" 1 (entity-ref stepped #:anim-tick))
- (test-equal "sets tile-id on first tick" 1 (entity-ref stepped #:tile-id)))
- (let* ((anims '((#:name walk #:frames (0 1) #:duration 2)))
- (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 1))
- (advanced (animate-entity entity anims)))
- (test-equal "advances frame when tick reaches duration" 1 (entity-ref advanced #:anim-frame))
- (test-equal "resets tick on frame advance" 0 (entity-ref advanced #:anim-tick)))
- (let* ((entity (list #:type 'player)))
- (test-equal "unchanged entity without anim-name" entity (animate-entity entity '()))))
+ (test-group "Single frames"
+ (let* ((anims '((#:name walk #:frames (2 3) #:duration 4)))
+ (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 0))
+ (stepped (animate-entity entity anims)))
+ (test-equal "increments tick" 1 (entity-ref stepped #:anim-tick))
+ (test-equal "sets tile-id on first tick" 2 (entity-ref stepped #:tile-id)))
+ (let* ((anims '((#:name walk #:frames (0 1) #:duration 2)))
+ (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 1))
+ (advanced (animate-entity entity anims)))
+ (test-equal "advances frame when tick reaches duration" 1 (entity-ref advanced #:anim-frame))
+ (test-equal "resets tick on frame advance" 0 (entity-ref advanced #:anim-tick))))
+ (test-group "Frames with duration"
+ (let* ((anims '((#:name walk #:frames ((0 10) (1 20)) #:duration 4)))
+ (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 9))
+ (stepped (animate-entity entity anims)))
+ (test-equal "ticks resets on frame switch" 0 (entity-ref stepped #:anim-tick))
+ (test-equal "sets tile-id on 10th tick" 1 (entity-ref stepped #:tile-id))
+ (test-equal "sets duration to frame duration" 20 (entity-ref stepped #:duration))))
+ (test-group "Empty"
+ (let* ((entity (list #:type 'player)))
+ (test-equal "unchanged entity without anim-name" entity (animate-entity entity '())))))
+
+(test-group "animation pipeline"
+ (test-group "animated entity"
+ (let* ((anims '((#:name walk #:frames (2 3) #:duration 4)))
+ (entity (list #:type 'player #:anim-name 'walk #:anim-frame 0 #:anim-tick 0 #:animations anims))
+ (stepped-entity (apply-animation entity #f 10)))
+ (test-equal "Updated animated entity" 1 (entity-ref stepped-entity #:anim-tick)))
+ (let* ((entity (list #:type 'static))
+ (stepped-entity (apply-animation entity #f 10)))
+ (test-equal "unchanged static entity" #f (entity-ref stepped-entity #:anim-tick)))))
(test-end "animation")
diff --git a/tests/entity-test.scm b/tests/entity-test.scm
index 9c7607c..3b83dff 100644
--- a/tests/entity-test.scm
+++ b/tests/entity-test.scm
@@ -82,12 +82,12 @@
(test-group "entity-set-many"
(test-group "Set multiple entities with lists"
(let ((e (entity-set-many '(#:x 10 #:y 20) '((#:x 15) (#:y 25)))))
- (test-equal "value x updated" (entity-ref e #:x) 15)
- (test-equal "value y updated" (entity-ref e #:y) 25)))
+ (test-equal "value x updated" 15 (entity-ref e #:x))
+ (test-equal "value y updated" 25 (entity-ref e #:y))))
(test-group "Set multiple entities with cons"
(let ((e (entity-set-many '(#:x 10 #:y 20) (list (cons #:x 15) (cons #:y 25)))))
- (test-equal "value x updated" (entity-ref e #:x) 15)
- (test-equal "value y updated" (entity-ref e #:y) 25))))
+ (test-equal "value x updated" 15 (entity-ref e #:x))
+ (test-equal "value y updated" 25 (entity-ref e #:y)))))
;; Test: entity-update applies transformations
(test-group "entity-update"
@@ -118,7 +118,7 @@
(test-assert "not member"
(not (entity-skips-pipeline? '(#:skip-pipelines (gravity)) 'velocity-x))))
-(define-pipeline (fixture-pipeline fixture-skip) (ent)
+(define-pipeline (fixture-pipeline fixture-skip) (scene_ ent)
(entity-set ent #:x 42))
(test-group "define-pipeline"
@@ -127,7 +127,7 @@
(let ((e '(#:type t #:x 0 #:skip-pipelines (fixture-skip))))
(test-equal "skipped" 0 (entity-ref (fixture-pipeline e) #:x))))
-(define-pipeline (guarded-pipeline guarded-skip) (ent)
+(define-pipeline (guarded-pipeline guarded-skip) (scene_ ent)
guard: (entity-ref ent #:active? #f)
(entity-set ent #:x 99))
diff --git a/tests/input-test.scm b/tests/input-test.scm
index 44af6e8..0d1e4b5 100644
--- a/tests/input-test.scm
+++ b/tests/input-test.scm
@@ -117,6 +117,11 @@
#f
(input-pressed? state3 'up)))))
+(define (make-physics-entity)
+ (entity-set-many (make-entity 0 0 16 16)
+ '((#:vx 0) (#:vy 0)
+ (#:input-map ((left . (-2 . 0)) (right . (2 . 0)))))))
+
;; Test: apply-input-to-entity applies input to entity
(test-group "apply-input-to-entity"
(test-group "no input-map: entity unchanged"
@@ -125,35 +130,35 @@
(test-equal "entity returned as-is" e out)))
(test-group "no actions held: velocity is zero"
- (let* ((e (make-entity 0 0 16 16))
+ (let* ((e (make-physics-entity))
(out (apply-input-to-entity e (lambda (a) #f))))
(test-equal "vx is 0" 0 (entity-ref out #:vx))
(test-equal "vy is 0" 0 (entity-ref out #:vy))))
(test-group "right held: vx=2 vy=0"
- (let* ((e (make-entity 0 0 16 16))
+ (let* ((e (make-physics-entity))
(out (apply-input-to-entity e (lambda (a) (eq? a 'right)))))
(test-equal "vx is 2" 2 (entity-ref out #:vx))
(test-equal "vy is 0" 0 (entity-ref out #:vy))))
(test-group "right+down held: vx=2 vy unchanged"
- (let* ((e (make-entity 0 0 16 16))
+ (let* ((e (make-physics-entity))
(out (apply-input-to-entity e (lambda (a) (memv a '(right down))))))
(test-equal "vx is 2" 2 (entity-ref out #:vx))
(test-equal "vy is unchanged (input handler does not set vy)" 0 (entity-ref out #:vy))))
(test-group "right held: facing set to 1"
- (let* ((e (make-entity 0 0 16 16))
+ (let* ((e (make-physics-entity))
(out (apply-input-to-entity e (lambda (a) (eq? a 'right)))))
(test-equal "facing is 1" 1 (entity-ref out #:facing 0))))
(test-group "left held: facing set to -1"
- (let* ((e (make-entity 0 0 16 16))
+ (let* ((e (make-physics-entity))
(out (apply-input-to-entity e (lambda (a) (eq? a 'left)))))
(test-equal "facing is -1" -1 (entity-ref out #:facing 0))))
(test-group "no key held: facing retains previous value"
- (let* ((e (entity-set (make-entity 0 0 16 16) #:facing 1))
+ (let* ((e (entity-set (make-physics-entity) #:facing 1))
(out (apply-input-to-entity e (lambda (a) #f))))
(test-equal "facing stays 1 when vx=0" 1 (entity-ref out #:facing 0)))))
diff --git a/tests/world-test.scm b/tests/world-test.scm
index 557a121..bfbb336 100644
--- a/tests/world-test.scm
+++ b/tests/world-test.scm
@@ -110,7 +110,7 @@
;; Test: scene with entities and tilemap
(test-group "scene-with-data"
- (let* ((player (make-entity 100 100 16 16))
+ (let* ((player (entity-set (make-entity 100 100 16 16) #:type 'player))
(enemy '(#:type enemy #:x 200 #:y 200))
(tilemap "mock-tilemap")
(scene (make-scene entities: (list player enemy)
@@ -159,7 +159,7 @@
(let* ((e1 '(#:type player #:x 100 #:y 100))
(e2 '(#:type enemy #:x 200 #:y 200))
(scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f))
- (move-right (lambda (entity)
+ (move-right (lambda (scene entity)
(let ((x (entity-ref entity #:x))
(y (entity-ref entity #:y))
(type (entity-ref entity #:type)))
@@ -184,7 +184,7 @@
(let* ((e1 '(#:type player #:x 100))
(e2 '(#:type enemy #:x 200))
(scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f))
- (scene2 (scene-map-entities scene (lambda (e) e))))
+ (scene2 (scene-map-entities scene (lambda (scene e) e))))
(test-equal "entity count unchanged" 2 (length (scene-entities scene2)))
(test-equal "first entity unchanged"
@@ -200,7 +200,7 @@
(test-equal "entity added" 1 (length (scene-entities scene)))
(let ((scene (scene-map-entities scene
- (lambda (e)
+ (lambda (scene e)
(let ((x (entity-ref e #:x))
(y (entity-ref e #:y))
(type (entity-type e)))
generated by cgit v1.2.3 (git 2.46.0) at 2026-04-20 23:44:58 +0000