From f2cf55b8c51e819bded19f2693aa74ae89abb12b Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Sun, 28 Jul 2013 16:49:26 +0200
Subject: [PATCH] Making systems; systems return a lambda function for process
 modifications at entities and components

* src/system.scm: set-entity
                  set-entity-components

* src/test.scm: system functions testing
---
 src/system.scm | 34 ++++++++++++++++++++++++++++------
 src/test.scm   |  9 +++++++--
 2 files changed, 35 insertions(+), 8 deletions(-)

diff --git a/src/system.scm b/src/system.scm
index 915e51e..ea9476a 100644
--- a/src/system.scm
+++ b/src/system.scm
@@ -91,11 +91,10 @@
 (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)
+     (acons key new-components entities)
+     (register-components key
+			  (map (lambda (c) (car c)) new-components)
+			  components)
      key)))
 
 (define (remove-entity key entities components)
@@ -103,9 +102,32 @@
     (values
      (assoc-remove! entities key)
      (unregister-components key clist components))))
+
+(define (set-entity key new-components entities components)
+  (let ((clist (map (lambda (c) (car c)) (assoc-ref entities key)))
+	(nclist (map (lambda (c) (car c)) new-components)))
+    (values
+     (assoc-set! entities key new-components)
+     (register-components key (lset-difference eq? nclist clist)
+			  (unregister-components key (lset-difference eq? clist nclist) components)))))
+
+(define (set-entity-components key new-components entities components)
+  (define (set-components clist new-components)
+    (cond ((null? new-components)
+	   clist)
+	  (else
+	   (set-components
+	    (if (cdar new-components)
+		(assoc-set! clist (caar new-components) (cdar new-components))
+		(assoc-remove! clist (caar new-components)))
+	    (cdr new-components)))))
+  (set-entity key (set-components (alist-copy (assoc-ref entities key)) new-components) entities components))
+
    
 (export new-entity
-	remove-entity)
+	remove-entity
+	set-entity
+	set-entity-components)
 
 
 ;;; Making systems
diff --git a/src/test.scm b/src/test.scm
index b145284..0570c9b 100644
--- a/src/test.scm
+++ b/src/test.scm
@@ -30,19 +30,24 @@
   (let ((entities '())
 	(components '())
 	(key #f))
-    (receive (e c k) (new-entity `(,(make-a 1 2) ,(make-b)) entities components)
+    (receive (e c k) (new-entity `((a . ,(make-a 1 2)) (b . ,(make-b))) entities components)
 	     (set! entities e)
 	     (set! components c)
 	     (set! key k)
 	     (display k) (newline))
     (format #t "~a~%~a~%~%" entities components)
 
-    (receive (e c k) (new-entity `(,(make-a 10 20)) entities components)
+    (receive (e c k) (new-entity `((a . ,(make-a 10 20))) entities components)
 	     (set! entities e)
 	     (set! components c)
 	     (display k) (newline))
     (format #t "~a~%~a~%~%" entities components)
 
+    (receive (e c) (set-entity-components key `((b . #f) (a . ,(make-a 50 50))) entities components)
+	     (set! entities e)
+	     (set! components c))
+    (format #t "~a~%~a~%~%" entities components)
+
     (receive (e c) (remove-entity key entities components)
 	     (set! entities e)
 	     (set! components c))
-- 
2.39.2