Making systems with macros instead functions. Now, we have define-system and make...

diff --git a/src/examples/composing-systems.scm b/src/examples/composing-systems.scm
index feecee360b45957a06a639611841c13fba3549cd..5af39c07ed88f8cec6d0f02466f32383ef90fbee 100644 (file)
--- a/src/examples/composing-systems.scm
+++ b/src/examples/composing-systems.scm
@@ -20,23 +20,21 @@
   #:use-module (ice-9 receive))
 
 
-(define s1
-  (make-system '(l)
-    (lambda (e)
-      (sleep 3)
-      (map
-       (lambda (e1)
-        (set-entity-components (car e1) `(l . ,(cons 1 (cdadr e1)))))
-       e))))
+(define-system (s1 l)
+  (lambda (e)
+    (sleep 3)
+    (map
+     (lambda (e1)
+       (set-entity-components (car e1) `(l . ,(cons 1 (cdadr e1)))))
+     e)))
 
-(define s2
-  (make-system '(l)
-    (lambda (e)
-      (sleep 4)
-      (map
-       (lambda (e1)
-        (set-entity-components (car e1) `(l . ,(cons 2 (cdadr e1)))))
-       e))))
+(define-system (s2 l)
+  (lambda (e)
+    (sleep 4)
+    (map
+     (lambda (e1)
+       (set-entity-components (car e1) `(l . ,(cons 2 (cdadr e1)))))
+     e)))
 
 (define (composing-with-join)
   (let ((entities '())

diff --git a/src/examples/making-systems.scm b/src/examples/making-systems.scm
index b3f381decc2fe998b48df3f767909159ba4e3506..37097191fd5387e888b2752fc989d19f69c6eed7 100644 (file)
--- a/src/examples/making-systems.scm
+++ b/src/examples/making-systems.scm
@@ -25,11 +25,11 @@
 (define (making-systems)
   (let ((entities '())
        (components '()))
-    (receive (e c) (((make-system '() (lambda (e) (list (new-entity (make-a 1 2)) (new-entity (make-a 10 20))))) entities components))
+    (receive (e c) (((make-system () (lambda (e) (list (new-entity (make-a 1 2)) (new-entity (make-a 10 20))))) entities components))
             (set! entities e)
             (set! components c))
     (format #t "Two new entities with a:~%~a~%~a~%~%" entities components)
 
-    (((make-system '(a) (lambda (e) (display e) (newline) '())) entities components))))
+    (((make-system (a) (lambda (e) (display e) (newline) '())) entities components))))
 
 (export making-systems)

diff --git a/src/system.scm b/src/system.scm
index 502ccd60beca405ef8a8d19908fcadb37d0f42df..2a9365b708530d33e558b2d714d0cb142ce5e8be 100644 (file)
--- 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)