X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=blobdiff_plain;f=src%2Fsystem.scm;h=2a9365b708530d33e558b2d714d0cb142ce5e8be;hp=502ccd60beca405ef8a8d19908fcadb37d0f42df;hb=ae294fed13cd0a99c87d04ac98db272e87cb289f;hpb=2b3814bf3f335a56c17b733caf90c17dbe229e91

diff --git a/src/system.scm b/src/system.scm
index 502ccd6..2a9365b 100644
--- a/src/system.scm
+++ b/src/system.scm
@@ -175,16 +175,23 @@
 		  (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 (car x) component-types)) (cdr x)))) e*))
-	   (res (system-fun e**)))
-      (lambda* (#:optional (entities2 #f) (components2 #f))
-	(let ((e (if (and entities2 components2) entities2 entities))
-	      (c (if (and entities2 components2) components2 components)))
-	  (modify-entities res e c))))))
+(define-macro (make-system component-types system-func)
+  `(let ((func ,system-func))
+     (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 (car x) ',component-types)) (cdr x)))) e*))
+	      (res (func e**)))
+	 (lambda* (#:optional (entities2 #f) (components2 #f))
+	   (let ((e (if (and entities2 components2) entities2 entities))
+		 (c (if (and entities2 components2) components2 components)))
+	     (modify-entities res e c)))))))
+
+
+(define-macro (define-system head system-func)
+  (let ((name (car head))
+	(component-types (cdr head)))
+    `(define ,name (make-system ,component-types ,system-func))))
 
 
 (define (join-systems . systems)
@@ -214,6 +221,7 @@
 
 
 (export find-entities-by-components
+	define-system
 	make-system
 	join-systems
 	threaded-systems)