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

diff --git a/src/system.scm b/src/system.scm
index 915e51e88ee71f27288e4181f011133e6131b4b7..ea9476ab51bbd226286865323b095f7d4e688163 100644 (file)
--- 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 b1452841507ae3d50c828c8b70cd651feb5e6cb8..0570c9ba0eb281b889592552e54ff62e18ed252d 100644 (file)
--- 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))