+ define-engine
+ engine-running?)
+
+
+;;; Engine execution
+
+(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
+ (lambda () (system (engine-entities engine)))
+ (lambda vals
+ (let ((changes (car vals)))
+ (cond ((entities-changes? changes)
+ (set-engine-entities! engine
+ (modify-entities (engine-entities engine)
+ (get-entities-changes changes))))))
+ (apply values vals))))
+
+(define-syntax with-engine
+ (syntax-rules ()
+ ((_ engine component-types form ...)
+ (with-mutex (engine-mutex engine)
+ (eval-system (make-system component-types form ...) engine)))))
+
+(define (stop-engine engine)
+ (with-engine engine ()
+ (entities-changes
+ (list
+ (new-entity '(engine-halt . #t)))))
+ 'engine-halt)
+
+(define* (engine-stopping? engine #:key (clean #f))
+ (let ((halts (eval-system
+ (make-system ((halt (engine-halt))) halt)
+ engine)))
+ (cond ((and clean (not (null? halts)))
+ (eval-system
+ (make-system () (entities-changes (map (lambda (h) (remove-entity (car h))) halts)))
+ engine)))
+ (not (null? halts))))
+
+(export start-engine
+ with-engine
+ stop-engine)
+