X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=blobdiff_plain;f=src%2Fsystem.scm;h=915e51e88ee71f27288e4181f011133e6131b4b7;hp=6f9f8cb355ee33c909e7b3272899b3aa7880f1fa;hb=01f67014fa380838c1db204b29ec83451dc8a03c;hpb=78cc7b19255878a5bd8a29a3af36d3b215bce08d

diff --git a/src/system.scm b/src/system.scm
index 6f9f8cb..915e51e 100644
--- 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