Improving engine exit

[gacela.git] / src / engine.scm

diff --git a/src/engine.scm b/src/engine.scm
index 2e3cbd32c1815358bef76f51890d122b96ab6d5f..27c4b4f5e02be70b2417180c7f871ffe1be36a12 100644 (file)
--- a/src/engine.scm
+++ b/src/engine.scm
@@ -16,6 +16,7 @@
 
 
 (define-module (gacela engine)
+  #:use-module (gacela misc)
   #:use-module (gacela system)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 threads)
@@ -56,10 +57,10 @@
 
 ;;; Engine Inner Properties
 
-(define (default-delay) 0.1)
+(define (default-step) 0.1)
 
 (define (default-engine-inner-properties)
-  `(engine-inner-properties (delay . ,(default-delay))))
+  `(engine-inner-properties (step . ,(default-step))))
 
 
 ;;; Engine definitions
@@ -175,29 +176,33 @@
   (cond ((not (engine-running? engine))
         (with-mutex (engine-running-mutex engine)
           (let loop ()
-            (let ((delay 0))
+            (let ((t (current-utime))
+                  (delay 0)
+                  (halt #f))
               (with-engine engine
                 (receive (e c) ((apply (engine-system engine) (engine-entities engine)))
                   (set-engine-entities! engine (list e c)))
-                (set! delay (get-property '(engine-inner-properties delay))))
-              (usleep (inexact->exact (* delay 1000000))))
-            (if (not (engine-stopping? engine #:clean #t))
-                (loop)))))))
+                (set! delay (- (inexact->exact (* (get-property '(engine-inner-properties step)) 1000000))
+                               (- (current-utime) t)))
+                (set! halt (engine-stopping? #:clean #t)))
+              (cond ((not halt)
+                     (cond ((> delay 0)
+                            (usleep delay)))
+                     (loop)))))))))
 
 (define (stop-engine engine)
   (with-engine engine
     (new-entity! '(engine-halt . #t)))
   'engine-halt)
 
-(define* (engine-stopping? engine #:key (clean #f))
+(define* (engine-stopping? #:key (engine (current-engine)) (clean #f))
   (let ((halt #f))
-    (with-engine engine
-      (let halt-engine ((halts (get-entities-by-components '(engine-halt))))
-       (cond ((not (null? halts))
-              (set! halt #t)
-              (cond (clean
-                     (remove-entity! (caar halts))
-                     (halt-engine (cdr halts))))))))
+    (let halt-engine ((halts (get-entities-by-components '(engine-halt))))
+      (cond ((not (null? halts))
+            (set! halt #t)
+            (cond (clean
+                   (remove-entity! (caar halts))
+                   (halt-engine (cdr halts)))))))
     halt))
 
 (export start-engine