Support entity groups

1 files changed, 35 insertions, 0 deletions

diff --git a/world.scm b/world.scm
index 1230c89..1f1b457 100644
--- a/world.scm
+++ b/world.scm
@@ -80,4 +80,39 @@
   (define (scene-find-all-tagged scene tag)
     (filter (lambda (e) (member tag (entity-ref e #:tags '())))
             (scene-entities scene)))
+
+  ;; First wins: one origin entity per #:group-id (for lookup).
+  (define (group-origin-alist entities)
+    (let loop ((es entities) (acc '()))
+      (if (null? es)
+          acc
+          (let ((e (car es)))
+            (if (and (entity-ref e #:group-origin? #f)
+                     (entity-ref e #:group-id #f))
+                (let ((gid (entity-ref e #:group-id)))
+                  (if (assq gid acc)
+                      (loop (cdr es) acc)
+                      (loop (cdr es) (cons (cons gid e) acc))))
+                (loop (cdr es) acc))))))
+
+  ;; Snap member #:x/#:y to origin + #:group-local-x/y. Call after moving origins (tweens, etc.).
+  (define (scene-sync-groups! scene)
+    (let* ((ents (scene-entities scene))
+           (origins (group-origin-alist ents)))
+      (scene-entities-set! scene
+        (map (lambda (e)
+               (if (and (entity-ref e #:group-id #f)
+                        (not (entity-ref e #:group-origin? #f)))
+                   (let* ((gid (entity-ref e #:group-id))
+                          (o (assq gid origins)))
+                     (if o
+                         (let ((origin (cdr o)))
+                           (entity-set (entity-set e #:x (+ (entity-ref origin #:x 0)
+                                                           (entity-ref e #:group-local-x 0)))
+                                       #:y (+ (entity-ref origin #:y 0)
+                                              (entity-ref e #:group-local-y 0))))
+                         e))
+                   e))
+             ents))
+      scene))
 )