diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/ai-test.scm | 48 | ||||
| -rw-r--r-- | tests/animation-test.scm | 36 | ||||
| -rw-r--r-- | tests/engine-test.scm | 29 | ||||
| -rw-r--r-- | tests/input-test.scm | 2 | ||||
| -rw-r--r-- | tests/world-test.scm | 31 |
5 files changed, 144 insertions, 2 deletions
diff --git a/tests/ai-test.scm b/tests/ai-test.scm new file mode 100644 index 0000000..9bb3d28 --- /dev/null +++ b/tests/ai-test.scm @@ -0,0 +1,48 @@ +;; Mock entity module for testing +(module downstroke/entity * + (import scheme (chicken base) (chicken keyword)) + (define (entity-ref entity key #!optional default) + (get-keyword key entity (if (procedure? default) default (lambda () default)))) + (define (entity-set entity key val) + (cons key (cons val (let loop ((lst entity)) + (if (null? lst) '() + (if (eq? (car lst) key) + (cddr lst) + (cons (car lst) (cons (cadr lst) (loop (cddr lst)))))))))) + (define (entity-type e) (entity-ref e #:type #f))) + +;; Mock world module for testing +(module downstroke/world * + (import scheme (chicken base)) + (define (scene-entities s) s) + (define (scene-find-tagged scene tag) #f)) + +(import (srfi 64) + states + downstroke/entity + downstroke/world) + +(include "ai.scm") +(import downstroke/ai) + +(test-begin "ai") + +(test-group "find-player (tag-based)" + (let* ((player (list #:type 'player #:x 100 #:y 100 #:width 16 #:height 16 + #:tags '(player))) + (enemy (list #:type 'enemy #:x 200 #:y 100 #:width 16 #:height 16 + #:tags '(enemy))) + (entities (list enemy player))) + (test-equal "finds player by tags" player (find-player entities)) + (test-equal "returns #f with no player" #f (find-player (list enemy))))) + +(test-group "update-enemy-ai" + (let* ((entity (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 + #:disabled #t))) + (test-equal "returns entity unchanged when disabled" entity + (update-enemy-ai entity '()))) + (let* ((entity (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16))) + (test-equal "returns entity unchanged when no ai-machine" entity + (update-enemy-ai entity '())))) + +(test-end "ai") diff --git a/tests/animation-test.scm b/tests/animation-test.scm new file mode 100644 index 0000000..fefb77f --- /dev/null +++ b/tests/animation-test.scm @@ -0,0 +1,36 @@ +(import srfi-64) +(include "entity.scm") +(include "world.scm") +(include "animation.scm") +(import downstroke/entity downstroke/world downstroke/animation) + +(test-begin "animation") + +(test-group "frame->tile-id" + (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-group "set-animation" + (let ((entity (list #:type 'player #:anim-name 'idle #:anim-frame 5 #:anim-tick 8))) + (test-equal "no-op if already active" entity (set-animation entity 'idle)) + (let ((switched (set-animation entity 'walk))) + (test-equal "switches anim-name" 'walk (entity-ref switched #:anim-name)) + (test-equal "resets frame" 0 (entity-ref switched #:anim-frame)) + (test-equal "resets tick" 0 (entity-ref switched #:anim-tick))))) + +(test-group "animate-entity" + (let* ((anims '((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 '((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-end "animation") diff --git a/tests/engine-test.scm b/tests/engine-test.scm index 2c443cc..67b9942 100644 --- a/tests/engine-test.scm +++ b/tests/engine-test.scm @@ -1,4 +1,4 @@ -(import scheme (chicken base) (chicken keyword) srfi-64 defstruct) +(import scheme (chicken base) (chicken keyword) srfi-64 defstruct (srfi 69)) ;; --- Mocks --- @@ -171,4 +171,31 @@ cam (game-camera g)))) +(test-group "make-game-state" + (let ((s (make-game-state create: (lambda (g) 'created) + update: (lambda (g dt) 'updated) + render: (lambda (g) 'rendered)))) + (test-assert "state has create hook" (state-hook s #:create)) + (test-assert "state has update hook" (state-hook s #:update)) + (test-assert "state has render hook" (state-hook s #:render))) + (let ((s (make-game-state))) + (test-equal "default state hooks are #f" #f (state-hook s #:create)) + (test-equal "default state update is #f" #f (state-hook s #:update)))) + +(test-group "game-add-state! and game-start-state!" + (let* ((created? #f) + (game (make-game)) + (state (make-game-state + create: (lambda (g) (set! created? #t))))) + (game-add-state! game 'play state) + (test-equal "active-state defaults to #f" #f (game-active-state game)) + (game-start-state! game 'play) + (test-equal "active-state set after start" 'play (game-active-state game)) + (test-assert "create hook called on start" created?))) + +(test-group "game states defaults" + (let ((game (make-game))) + (test-assert "states is a hash-table" (hash-table? (game-states game))) + (test-equal "active-state defaults to #f" #f (game-active-state game)))) + (test-end "engine") diff --git a/tests/input-test.scm b/tests/input-test.scm index 9153671..7eae12f 100644 --- a/tests/input-test.scm +++ b/tests/input-test.scm @@ -3,7 +3,7 @@ (chicken base) (chicken format) (only srfi-1 any filter fold alist-delete) - (only srfi-13 string-join) + (only srfi-13 string-join string-contains) (only srfi-197 chain) (prefix sdl2 sdl2:) simple-logger diff --git a/tests/world-test.scm b/tests/world-test.scm index 38005b2..c4fd887 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -236,4 +236,35 @@ 'player (entity-ref (car (scene-entities scene)) #:type #f)))) + (test-group "camera-follow!" + (let* ((cam (make-camera x: 0 y: 0)) + (entity (list #:type 'player #:x 400 #:y 300 #:width 16 #:height 16))) + (camera-follow! cam entity 600 400) + (test-equal "centers camera x on entity" 100 (camera-x cam)) + (test-equal "centers camera y on entity" 100 (camera-y cam))) + (let* ((cam (make-camera x: 0 y: 0)) + (entity (list #:type 'player #:x 50 #:y 30 #:width 16 #:height 16))) + (camera-follow! cam entity 600 400) + (test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam)) + (test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam)))) + + (test-group "scene-find-tagged" + (let* ((p (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) + (e (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(enemy npc))) + (s (make-scene entities: (list p e) tilemap: #f + camera: (make-camera x: 0 y: 0) tileset-texture: #f))) + (test-equal "finds entity with matching tag" p (scene-find-tagged s 'player)) + (test-equal "finds enemy by 'enemy tag" e (scene-find-tagged s 'enemy)) + (test-equal "finds entity with second tag in list" e (scene-find-tagged s 'npc)) + (test-equal "returns #f when tag not found" #f (scene-find-tagged s 'boss)))) + + (test-group "scene-find-all-tagged" + (let* ((p1 (list #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player friendly))) + (p2 (list #:type 'ally #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(ally friendly))) + (e (list #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(enemy))) + (s (make-scene entities: (list p1 p2 e) tilemap: #f + camera: (make-camera x: 0 y: 0) tileset-texture: #f))) + (test-equal "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) + (test-equal "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) + (test-end "world-module") |