(import srfi-64) (include "entity.scm") (import downstroke-entity) (test-begin "entity") ;; Test: entity-ref retrieves values from entity plists (test-group "entity-ref" (let ((entity '(#:type player #:x 100 #:y 200 #:width 16 #:height 16))) (test-equal "retrieves type" 'player (entity-ref entity #:type)) (test-equal "retrieves x" 100 (entity-ref entity #:x)) (test-equal "retrieves y" 200 (entity-ref entity #:y)) (test-equal "retrieves width" 16 (entity-ref entity #:width)) (test-equal "retrieves height" 16 (entity-ref entity #:height))) ;; Test with default value (let ((entity '(#:type player))) (test-equal "returns default for missing key" 99 (entity-ref entity #:x 99)) (test-equal "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-equal "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-equal "has correct x" 50 (entity-ref player #:x)) (test-equal "has correct y" 75 (entity-ref player #:y)) (test-equal "has correct width" 16 (entity-ref player #:width)) (test-equal "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-equal "extracts player type" 'player (entity-type player)) (test-equal "extracts enemy type" 'enemy (entity-type enemy))) (let ((no-type '(#:x 100 #:y 200))) (test-equal "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-equal "retrieves numeric property" 50 (entity-ref entity #:health)) (test-equal "retrieves float property" 2.5 (entity-ref entity #:speed)) (test-equal "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-equal "value updated" 15 (entity-ref e #:x)) (test-equal "other key untouched" 20 (entity-ref e #:y)) ;; plist length should shrink from 4 to 4 (same — one pair removed, one added) ;; stronger: verify the list length stays at 4, not 6 (test-equal "no duplicate key: list length unchanged" 4 (length e)))) (test-group "new key is added" (let ((e (entity-set '(#:x 10) #:vx 3))) (test-equal "new key present" 3 (entity-ref e #:vx)) (test-equal "existing key untouched" 10 (entity-ref e #:x)) (test-equal "list grows by one pair" 4 (length e))))) (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" 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" 15 (entity-ref e #:x)) (test-equal "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-equal "#:x is 15" 15 (entity-ref e #:x)) (test-equal "#: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-equal "#: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-equal "#: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-equal "length is 4" 4 (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) (entity-set ent #:x 42)) (test-group "define-pipeline" (let ((e '(#:type t #:x 0))) (test-equal "runs body" 42 (entity-ref (fixture-pipeline e) #:x))) (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) (scene_ ent) 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-equal "runs body when guard passes" 99 (entity-ref (guarded-pipeline e) #:x))) (let ((e '(#:type t #:x 0))) (test-equal "returns entity unchanged when guard fails" 0 (entity-ref (guarded-pipeline e) #:x))) (let ((e '(#:type t #:x 0 #:active? #t #:skip-pipelines (guarded-skip)))) (test-equal "skip-pipelines takes precedence over guard" 0 (entity-ref (guarded-pipeline e) #:x)))) (test-end "entity")