From f8cc4a748bb8b6431a1023a876745b1bb473eb19 Mon Sep 17 00:00:00 2001
From: Gene Pasquet <dev@etenil.net>
Date: Wed, 8 Apr 2026 00:30:11 +0100
Subject: Support entity groups

---
 tests/prefabs-test.scm | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

(limited to 'tests/prefabs-test.scm')

diff --git a/tests/prefabs-test.scm b/tests/prefabs-test.scm
index 6ccc473..8a1e5b0 100644
--- a/tests/prefabs-test.scm
+++ b/tests/prefabs-test.scm
@@ -152,6 +152,7 @@
                   prefabs:            (list (cons 'proc-hooked
                                                  (list #:type 'proc-hooked
                                                        #:on-instantiate hook-proc)))
+                  group-prefabs:      '()
                   file:               "/dev/null"
                   engine-mixin-table: '()
                   user-hooks:         '()
@@ -215,4 +216,43 @@
     (test-equal "reloaded registry has #:value 42" 42 (entity-ref e2 #:value))
     (test-equal "original registry unchanged after reload" 1 (entity-ref e1 #:value))))
 
+(test-group "group-prefabs"
+  (define (with-group-prefab-data str thunk)
+    (let ((tmp "/tmp/test-group-prefabs.scm"))
+      (with-output-to-file tmp (lambda () (display str)))
+      (thunk (load-prefabs tmp (engine-mixins) '()))))
+
+  (with-group-prefab-data
+    "((mixins) (prefabs)
+      (group-prefabs
+        (two-block #:pose-only-origin? #t #:static-parts? #t #:type-members segment
+          #:parts ((#:local-x 0 #:local-y 0 #:width 10 #:height 8 #:tile-id 1)
+                   (#:local-x 10 #:local-y 0 #:width 10 #:height 8 #:tile-id 2)))))"
+    (lambda (reg)
+      (test-assert "instantiate-group-prefab unknown → #f"
+        (not (instantiate-group-prefab reg 'nope 0 0)))
+      (let ((lst (instantiate-group-prefab reg 'two-block 100 50)))
+        (test-equal "returns list of origin + 2 members" 3 (length lst))
+        (let ((origin (car lst))
+              (a (cadr lst))
+              (b (caddr lst)))
+          (test-equal "pose-only origin skip-render" #t (entity-ref origin #:skip-render))
+          (test-equal "origin group-origin?" #t (entity-ref origin #:group-origin?))
+          (test-equal "member a world x" 100 (entity-ref a #:x))
+          (test-equal "member b world x" 110 (entity-ref b #:x))
+          (test-equal "member a local x" 0 (entity-ref a #:group-local-x))
+          (test-equal "member b local x" 10 (entity-ref b #:group-local-x))
+          (test-equal "shared group-id" (entity-ref origin #:group-id) (entity-ref a #:group-id))))))
+
+  (with-group-prefab-data
+    "((mixins) (prefabs)
+      (group-prefabs
+        (falling-asm #:pose-only-origin? #f #:static-parts? #t #:type-members part
+          #:parts ((#:local-x 0 #:local-y 0 #:width 4 #:height 4 #:tile-id 1)))))"
+    (lambda (reg)
+      (let ((origin (car (instantiate-group-prefab reg 'falling-asm 0 0))))
+        (test-equal "physics origin has gravity" #t (entity-ref origin #:gravity?))
+        (test-assert "physics origin has no #:skip-pipelines (pipelines run)"
+          (eq? 'absent (entity-ref origin #:skip-pipelines 'absent)))))))
+
 (test-end "prefabs")
-- 
cgit v1.2.3