(import srfi-64) (include "entity.scm") (include "tilemap.scm") (include "world.scm") (include "animation.scm") (import downstroke-entity downstroke-world downstroke-animation) (test-begin "animation") (test-group "frame->tile-id" (test-group "tile IDs only" (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)" 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)) (test-equal "wraps around" 100 (frame->duration '((0 100) (1 200)) 2)) (test-equal "frame 1 of (27 28)" 200 (frame->duration '((27 100) (28 200)) 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" (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")