Initial port of macroknight to an engine

1 files changed, 116 insertions, 0 deletions

diff --git a/tests/entity-test.scm b/tests/entity-test.scm
new file mode 100644
index 0000000..3e1f85e
--- /dev/null
+++ b/tests/entity-test.scm
@@ -0,0 +1,116 @@
+(import srfi-64)
+(include "entity.scm")
+(import 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: 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: make-player-entity creates valid player entity
+(test-group "make-player-entity"
+  (let ((player (make-player-entity 50 75 16 16)))
+    (test-assert "returns a list" (list? player))
+    (test-equal "has correct type" 'player (entity-ref player #:type))
+    (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-equal "has initial tile-id" 29 (entity-ref player #:tile-id))))
+
+;; 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: 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: make-player-entity velocity fields
+(test-group "make-player-entity-velocity-fields"
+  (let* ((p   (make-player-entity 5 10 16 16))
+         (imap (entity-ref p #:input-map #f)))
+    (test-equal "vx defaults to 0" 0 (entity-ref p #:vx))
+    (test-equal "vy defaults to 0" 0 (entity-ref p #:vy))
+    (test-assert "input-map is present" imap)
+    ;; Each entry is (action . (dvx . dvy)); assq returns (action . (dvx . dvy))
+    (test-equal "left dvx" -2 (car (cdr (assq 'left  imap))))
+    (test-equal "left dvy"  0 (cdr (cdr (assq 'left  imap))))
+    (test-equal "right dvx" 2 (car (cdr (assq 'right imap))))
+    (test-equal "right dvy" 0 (cdr (cdr (assq 'right imap))))))
+
+(test-end "entity")