Making systems; systems return a lambda function for process

modifications at entities and components

* src/system.scm: remove-entity

* src/test.scm: system functions testing

diff --git a/src/system.scm b/src/system.scm
index 6f9f8cb355ee33c909e7b3272899b3aa7880f1fa..915e51e88ee71f27288e4181f011133e6131b4b7 100644 (file)
--- a/src/system.scm
+++ b/src/system.scm
@@ -65,17 +65,10 @@
 
 ;;; Entities and components
 
-(define (new-entity new-components entities components)
-  (let ((key (gensym)))
-    (values
-     (acons key (map (lambda (c) `(,(get-component-type c) . ,c)) new-components) entities)
-     (register-components key new-components components)
-     key)))
-
-(define* (register-components entity components clist)
+(define (register-components entity components clist)
   (cond ((null? components) clist)
        (else
-        (let* ((type (get-component-type (car components)))
+        (let* ((type (car components))
                (elist (assoc-ref clist type)))
           (register-components entity (cdr components)
             (assoc-set! clist type
@@ -84,7 +77,35 @@
                     (else
                      (list entity)))))))))
 
-(export new-entity)
+(define (unregister-components entity components clist)
+  (cond ((null? components) clist)
+       (else
+        (let* ((type (car components))
+               (elist (lset-difference eq? (assoc-ref clist type) (list entity))))
+          (unregister-components entity (cdr components)
+            (cond ((null? elist)
+                   (assoc-remove! clist type))
+                  (else
+                   (assoc-set! clist type elist))))))))
+
+(define (new-entity new-components entities components)
+  (let ((key (gensym)))
+    (values
+     (acons key (map (lambda (c) `(,(get-component-type c) . ,c)) new-components) entities)
+     (register-components
+      key
+      (map (lambda (c) (get-component-type c)) new-components)
+      components)
+     key)))
+
+(define (remove-entity key entities components)
+  (let ((clist (map (lambda (c) (car c)) (assoc-ref entities key))))
+    (values
+     (assoc-remove! entities key)
+     (unregister-components key clist components))))
+   
+(export new-entity
+       remove-entity)
 
 
 ;;; Making systems

diff --git a/src/test.scm b/src/test.scm
index ebd17e9e2df77f89e507a42d6f4a3b94437f1b68..b1452841507ae3d50c828c8b70cd651feb5e6cb8 100644 (file)
--- a/src/test.scm
+++ b/src/test.scm
@@ -28,12 +28,25 @@
 
 (define (test1)
   (let ((entities '())
-       (components '()))
-    (receive (e c n) (new-entity `(,(make-a 1 2) ,(make-b)) entities components)
+       (components '())
+       (key #f))
+    (receive (e c k) (new-entity `(,(make-a 1 2) ,(make-b)) entities components)
             (set! entities e)
             (set! components c)
-            (display n) (newline))
-    (display entities) (newline)
-    (display components) (newline)))
+            (set! key k)
+            (display k) (newline))
+    (format #t "~a~%~a~%~%" entities components)
+
+    (receive (e c k) (new-entity `(,(make-a 10 20)) entities components)
+            (set! entities e)
+            (set! components c)
+            (display k) (newline))
+    (format #t "~a~%~a~%~%" entities components)
+
+    (receive (e c) (remove-entity key entities components)
+            (set! entities e)
+            (set! components c))
+    (format #t "~a~%~a~%~%" entities components)
+))
 
 (export test1)