From 01f67014fa380838c1db204b29ec83451dc8a03c Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Mon, 22 Jul 2013 07:27:00 +0200
Subject: [PATCH] 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
---
 src/system.scm | 41 +++++++++++++++++++++++++++++++----------
 src/test.scm   | 23 ++++++++++++++++++-----
 2 files changed, 49 insertions(+), 15 deletions(-)

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
diff --git a/src/test.scm b/src/test.scm
index ebd17e9..b145284 100644
--- 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)
-- 
2.39.5