From: Javier Sancho <jsf@jsancho.org>
Date: Sun, 6 Oct 2013 06:53:14 +0000 (+0200)
Subject: More verbose and powerful system definition
X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=commitdiff_plain;h=7daac782bf89c735e87131f8dc9c04a396415d5a

More verbose and powerful system definition

* src/examples/making-systems.scm: Examples redefined

* src/system.scm: System definitions with more than one components grouping
  and without requiring a function directly
---

diff --git a/src/examples/making-systems.scm b/src/examples/making-systems.scm
index 0addc1b..c049a90 100644
--- a/src/examples/making-systems.scm
+++ b/src/examples/making-systems.scm
@@ -22,19 +22,17 @@
 
 (define-component a x y)
 
-(define-system (s1)
-  (lambda (e)
-    (list (new-entity (make-a 1 2))
-	  (new-entity (make-a 10 20)))))
-
-(define-system (s2 a)
-  (lambda (e)
-    (for-each
-     (lambda (e1)
-       (format #t "Key: ~a  Component: ~a~%" (get-key e1) (get-component 'a e1)))
-     e)
-    '()))
-
+(define-system s1 ()
+  (list (new-entity (make-a 1 2))
+	(new-entity (make-a 10 20))))
+
+(define-system s2 ((with-a (a)))
+  (for-each
+   (lambda (e)
+     (format #t "Key: ~a  Component: ~a~%" (get-key e) (get-component 'a e)))
+   with-a)
+  '())
+  
 (define (making-systems)
   (let ((entities '())
 	(components '()))
diff --git a/src/system.scm b/src/system.scm
index 26e31c6..b70bfee 100644
--- a/src/system.scm
+++ b/src/system.scm
@@ -193,21 +193,30 @@
 
 (define-syntax make-system
   (syntax-rules ()
-    ((_ component-types system-func)
+    ((_ ((name (component-type ...)) ...) form ...)
      (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-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))))))))
+       (let ((name (map (lambda (x)
+			  (cons (car x)
+				(filter (lambda (x)
+					  (memq (car x) '(component-type ...)))
+					(cdr x))))
+			(map (lambda (x)
+			       (assoc x entities))
+			     (find-entities-by-components components '(component-type ...)))))
+	     ...)
+	 (let ((res (begin form ...)))
+	   (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-syntax define-system
   (syntax-rules ()
-    ((_ (name . component-types) system-func)
-     (define name (make-system component-types system-func)))))
+    ((_ system-name ((name (component-type ...)) ...) form ...)
+     (define system-name
+       (make-system ((name (component-type ...)) ...)
+         form
+	 ...)))))
 
 (define (join-systems . systems)
   (lambda (entities components)