]> git.jsancho.org Git - gacela.git/commitdiff
Adding REPL cooperative server to the engine loop
authorJavier Sancho <jsf@jsancho.org>
Fri, 3 Jul 2015 14:58:14 +0000 (16:58 +0200)
committerJavier Sancho <jsf@jsancho.org>
Fri, 3 Jul 2015 14:58:14 +0000 (16:58 +0200)
* src/engine.scm: Function start-engine has an optional socket parameter
                  for starting a REPL and accessing from an external
                  thread

src/engine.scm

index 7831ff373a61c4f578443b7d3382b0a0fc005a08..dd8a8b2c5f45eeb107c400248a938ce628f3baaf 100644 (file)
@@ -21,7 +21,9 @@
   #:use-module (ice-9 receive)
   #:use-module (ice-9 threads)
   #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu))
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (system repl server)
+  #:use-module (system repl coop-server))
 
 
 ;;; Engine Inner Properties
@@ -38,7 +40,6 @@
   (make-engine-record entities mutex running-mutex systems)
   engine?
   (entities engine-entities set-engine-entities!)
-  (mutex engine-mutex set-engine-mutex!)
   (running-mutex engine-running-mutex set-engine-running-mutex!)
   (systems engine-systems set-engine-systems!))
 
@@ -52,7 +53,6 @@
   (make-engine-record
    (make-entity-set (new-entity (default-engine-inner-properties)))
    (make-mutex)
-   (make-mutex)
    systems))
 
 (define-syntax define-engine
 
 ;;; Engine execution
 
-(define (start-engine engine)
-  (cond ((not (engine-running? engine))
-        (with-mutex (engine-running-mutex engine)
-          (let loop ()
-            (let ((t (current-utime))
-                  (delay 0)
-                  (halt #f))
-              (with-mutex (engine-mutex engine)
-                (for-each
-                 (lambda (s) (eval-system s engine))
-                 (engine-systems engine))
-                (set! delay (- (inexact->exact (* (engine-property engine 'step) 1000000))
-                               (- (current-utime) t)))
-                (set! halt (engine-stopping? engine #:clean #t)))
-              (cond ((not halt)
-                     (cond ((> delay 0)
-                            (usleep delay)))
-                     (loop)))))))))
+(define* (start-engine engine #:optional (socket #f))
+  (catch
+   #t
+   (lambda ()
+     (with-mutex (engine-running-mutex engine)
+       (let loop ((coop-server (if socket (spawn-coop-repl-server socket) #f)))
+        (let ((t (current-utime))
+              (delay 0)
+              (halt #f))
+          (for-each
+           (lambda (s) (eval-system s engine))
+           (engine-systems engine))
+          (set! delay (- (inexact->exact (* (engine-property engine 'step) 1000000))
+                         (- (current-utime) t)))
+          (set! halt (engine-stopping? engine #:clean #t))
+          (if coop-server
+              (poll-coop-repl-server coop-server))
+          (cond ((not halt)
+                 (cond ((> delay 0)
+                        (usleep delay)))
+                 (loop coop-server))
+                (else
+                 (if coop-server
+                     (stop-server-and-clients!))))))))
+   (lambda (key args)
+     #f)))
 
 (define (eval-system system engine)
   (call-with-values