Remove useless make-player-entity

7 files changed, 68 insertions, 91 deletions

diff --git a/entity.scm b/entity.scm
index 891fbde..dab2e83 100644
--- a/entity.scm
+++ b/entity.scm
@@ -7,8 +7,11 @@
 
   ;; Entities = plists with shared keys (#:type, #:x, #:y, #:width, #:height, ...).
 
-  (define (entity-ref entity key #!optional default)
-    (get-keyword key entity (if (procedure? default) default (lambda () default))))
+(define (make-entity x y w h)
+  (list #:type 'none #:x x #:y y #:width w #:height h))
+
+(define (entity-ref entity key #!optional default)
+  (get-keyword key entity (if (procedure? default) default (lambda () default))))
 
   (define (entity-type entity)
     (entity-ref entity #:type #f))
@@ -36,57 +39,43 @@
     (let ((skips (entity-ref entity #:skip-pipelines '())))
       (and (pair? skips) (memq step skips))))
 
-  ;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the
-  ;; binding from THIS module — works across compiled unit boundaries.
-  ;;
-  ;; Syntax:
-  ;;   (define-pipeline (name skip-sym) (entity-formal ...)
-  ;;     guard: guard-expr     ;; optional — entity returned unchanged when #f
-  ;;     body ...)
-  (define-syntax define-pipeline
-    (er-macro-transformer
-      (lambda (form rename _compare)
-        (let* ((name-skip (cadr form))
-               (name     (car name-skip))
-               (skip     (cadr name-skip))
-               (formals  (caddr form))
-               (f1       (car formals))
-               (rest     (cdddr form))
-               (has-guard? (and (pair? rest) (pair? (cdr rest))
-                                (eq? (car rest) guard:)))
-               (guard-expr (and has-guard? (cadr rest)))
-               (body       (if has-guard? (cddr rest) rest))
-               (%define  (rename 'define))
-               (%if      (rename 'if))
-               (%let     (rename 'let))
-               (%not     (rename 'not))
-               (%quote   (rename 'quote))
-               (%skip?   (rename 'entity-skips-pipeline?)))
-          (if has-guard?
-              `(,%define (,name ,@formals)
-                 (,%if (,%skip? ,f1 (,%quote ,skip))
-                       ,f1
-                       (,%if (,%not ,guard-expr)
-                             ,f1
-                             (,%let () ,@body))))
-              `(,%define (,name ,@formals)
-                 (,%if (,%skip? ,f1 (,%quote ,skip))
-                       ,f1
-                       (,%let () ,@body))))))))
+;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the
+;; binding from THIS module — works across compiled unit boundaries.
+;;
+;; Syntax:
+;;   (define-pipeline (name skip-sym) (entity-formal ...)
+;;     guard: guard-expr     ;; optional — entity returned unchanged when #f
+;;     body ...)
+(define-syntax define-pipeline
+  (er-macro-transformer
+   (lambda (form rename _compare)
+     (let* ((name-skip (cadr form))
+            (name     (car name-skip))
+            (skip     (cadr name-skip))
+            (formals  (caddr form))
+            (f1       (car formals))
+            (rest     (cdddr form))
+            (has-guard? (and (pair? rest) (pair? (cdr rest))
+                             (eq? (car rest) guard:)))
+            (guard-expr (and has-guard? (cadr rest)))
+            (body       (if has-guard? (cddr rest) rest))
+            (%define  (rename 'define))
+            (%if      (rename 'if))
+            (%let     (rename 'let))
+            (%not     (rename 'not))
+            (%quote   (rename 'quote))
+            (%skip?   (rename 'entity-skips-pipeline?)))
+       (if has-guard?
+           `(,%define (,name ,@formals)
+                      (,%if (,%skip? ,f1 (,%quote ,skip))
+			    ,f1
+			    (,%if (,%not ,guard-expr)
+				  ,f1
+				  (,%let () ,@body))))
+           `(,%define (,name ,@formals)
+                      (,%if (,%skip? ,f1 (,%quote ,skip))
+			    ,f1
+			    (,%let () ,@body))))))))
 
-  (define (make-player-entity x y width height)
-    (list #:type 'player
-	  #:x x
-	  #:y y
-	  #:width width
-	  #:height height
-	  #:vx 0
-	  #:vy 0
-	  #:gravity? #t
-	  #:on-ground? #f
-	  #:tile-id 29
-	  #:input-map '((left  . (-2 .  0))
-	                (right . ( 2 .  0))
-	                (down  . ( 0 .  2)))))
-)
+) ;; End of entity
 
diff --git a/prefabs.scm b/prefabs.scm
index 585d4b5..798375a 100644
--- a/prefabs.scm
+++ b/prefabs.scm
@@ -114,7 +114,7 @@
           (if (not entry)
               #f
               ;; instance fields prepended → highest priority
-              (let* ((base (append (list #:x x #:y y #:width w #:height h)
+              (let* ((base (append (make-entity x y w h)
                                    (cdr entry)))
                      (hook-val (entity-ref base #:on-instantiate #f))
                      (handler
diff --git a/tests/entity-test.scm b/tests/entity-test.scm
index 795aa1c..270555c 100644
--- a/tests/entity-test.scm
+++ b/tests/entity-test.scm
@@ -29,6 +29,15 @@
                 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))
@@ -38,19 +47,8 @@
 
   (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))))
+      #f
+      (entity-type no-type))))
 
 ;; Test: complex entity with multiple properties
 (test-group "complex-entity"
@@ -100,19 +98,6 @@
     (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-group "entity-skips-pipeline?"
   (test-assert "absent skip list"
     (not (entity-skips-pipeline? '(#:type a) 'gravity)))
diff --git a/tests/input-test.scm b/tests/input-test.scm
index 2173f61..44af6e8 100644
--- a/tests/input-test.scm
+++ b/tests/input-test.scm
@@ -125,35 +125,35 @@
       (test-equal "entity returned as-is" e out)))
 
   (test-group "no actions held: velocity is zero"
-    (let* ((e   (make-player-entity 0 0 16 16))
+    (let* ((e   (make-entity 0 0 16 16))
            (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-player-entity 0 0 16 16))
+    (let* ((e   (make-entity 0 0 16 16))
            (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-player-entity 0 0 16 16))
+    (let* ((e   (make-entity 0 0 16 16))
            (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-player-entity 0 0 16 16))
+    (let* ((e   (make-entity 0 0 16 16))
            (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-player-entity 0 0 16 16))
+    (let* ((e   (make-entity 0 0 16 16))
            (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-player-entity 0 0 16 16) #:facing 1))
+    (let* ((e   (entity-set (make-entity 0 0 16 16) #: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/physics-test.scm b/tests/physics-test.scm
index 6d1da86..88ddcce 100644
--- a/tests/physics-test.scm
+++ b/tests/physics-test.scm
@@ -341,7 +341,7 @@
            (solid-row (make-list 15 1))
            (rows (append (make-list 24 empty-row) (list solid-row)))
            (tm (make-test-tilemap rows))
-           (e0 (make-player-entity 182 350.5 16 16)))
+           (e0 (make-entity 182 350.5 16 16)))
       ;; Should not crash
       (let loop ((e e0) (n 5))
         (if (= n 0)
diff --git a/tests/prefabs-test.scm b/tests/prefabs-test.scm
index 8a1e5b0..f8cec0a 100644
--- a/tests/prefabs-test.scm
+++ b/tests/prefabs-test.scm
@@ -31,6 +31,9 @@
 (import downstroke-ai)
 
 ;; Load module under test
+(include "entity.scm")
+(import downstroke-entity)
+
 (include "prefabs.scm")
 (import downstroke-prefabs)
 
diff --git a/tests/world-test.scm b/tests/world-test.scm
index 48f492a..557a121 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-player-entity 100 100 16 16))
+  (let* ((player (make-entity 100 100 16 16))
          (enemy '(#:type enemy #:x 200 #:y 200))
          (tilemap "mock-tilemap")
          (scene (make-scene entities: (list player enemy)
@@ -128,7 +128,7 @@
 
 ;; Test: scene-add-entity adds entity to scene
 (test-group "scene-add-entity"
-  (let* ((player (make-player-entity 100 100 16 16))
+  (let* ((player (make-entity 100 100 16 16))
          (scene (make-scene entities: (list player) tilemap: #f camera-target: #f))
          (enemy '(#:type enemy #:x 200 #:y 200)))
 
@@ -194,7 +194,7 @@
 ;; Test: scene chaining (was mutation test)
 (test-group "scene-chaining"
   (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f))
-         (player (make-player-entity 10 20 16 16))
+         (player (make-entity 10 20 16 16))
          (scene (scene-add-entity scene player)))
 
     (test-equal "entity added" 1 (length (scene-entities scene)))