X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=blobdiff_plain;f=src%2Fsystem.scm;h=4da0b1c91bfdac2c1dd0391e828b58e98db7acdf;hp=b4f48708201e35c6ecbb39ffca74c98013a21331;hb=a365afd7e2a002c533b0463f0778f9c4918a1eb4;hpb=a72b7f4b6526a5ceea28b96a679acd2124ba4ca3

diff --git a/src/system.scm b/src/system.scm
index b4f4870..4da0b1c 100644
--- a/src/system.scm
+++ b/src/system.scm
@@ -16,6 +16,7 @@
 
 
 (define-module (gacela system)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9))
 
 
@@ -45,3 +46,27 @@
 
 (export define-component
 	get-component-type)
+
+
+;;; Making systems
+
+(define* (find-entities-by-components c t)
+  (cond ((null? t) '())
+	(else
+	 (let* ((e (assoc-ref c (car t)))
+		(e* (if e e '())))
+	   (cond ((null? (cdr t)) e*)
+		 (else
+		  (lset-intersection eq? e* (find-entities-by-components c (cdr t)))))))))
+		  
+
+(define (make-system component-types system-fun)
+  (lambda (entities components)
+    (let* ((e (find-entities-by-components components component-types))
+	   (e* (map (lambda (x) (assoc x entities)) e))
+	   (e** (map (lambda (x) (cons (car x) (filter (lambda (x) (memq (get-component-type x) component-types)) (cdr x)))) e*)))
+      e**)))
+
+
+(export find-entities-by-components
+	make-system)