Set engine systems while running

* src/engine.scm: new function set-engine-systems! using engine mutex
                  for avoiding concurrency errors

* src/system.scm: new function group-systems, that returns joined
                  systems or an empty system, depending on arguments

diff --git a/src/engine.scm b/src/engine.scm
index 4e311a0d9db97ca872e2cf9bfa162bca67d9e262..33c8a6f0f190b02ddb3ef4cac12568bc6bfebf13 100644 (file)
--- a/src/engine.scm
+++ b/src/engine.scm
@@ -50,9 +50,7 @@
      (list e c))
    (make-mutex)
    (make-mutex)
-   (if (not (= (length systems) 1))
-       (join-systems systems)
-       (car systems))))
+   (apply group-systems systems)))
 
 (define-syntax define-engine
   (syntax-rules ()
@@ -122,6 +120,10 @@
         (set-current-engine! old-engine)
         res)))))
 
+(define (set-engine-systems! engine . systems)
+  (with-mutex (engine-mutex engine)
+    (set-engine-system! engine (apply group-systems systems))))
+
 (export current-engine
        set-current-engine!
        get-entity
@@ -131,7 +133,8 @@
        set-entity!
        set-entity-components!
        remove-entity-components!
-       with-engine)
+       with-engine
+       set-engine-systems!)
 
 
 ;;; Engine execution

diff --git a/src/system.scm b/src/system.scm
index 3d5cb2b9ea482eaaaf65a81946e337d693cd94bb..2bf05208fefb215eec76c28e3075ce0a3f56e218 100644 (file)
--- a/src/system.scm
+++ b/src/system.scm
@@ -247,11 +247,20 @@
             (receive (e2 c2) ((join-thread (car thd)) e c)
               (run-wait (cdr thd) e2 c2)))))))
 
+(define (group-systems . systems)
+  (cond ((null? systems)
+        (make-system ()))
+       ((= (length systems) 1)
+        (car systems))
+       (else
+        (join-systems systems))))
+
 (export find-entities-by-components
        define-system
        make-system
        join-systems
-       threaded-systems)
+       threaded-systems
+       group-systems)
 
 
 ;;; Entities and components access inside systems