From: Javier Sancho Date: Sun, 17 Nov 2013 07:32:23 +0000 (+0100) Subject: Engine Execution X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=0cf99813777069f2fce8fe895fbbdcaaf98699eb;p=gacela.git Engine Execution * src/engine.scm: Engine execution with inner properties for looping delay and other future parameters. Mutexes are used to prevent accessing entities and engines in an undesired way. --- diff --git a/src/engine.scm b/src/engine.scm index 0770e09..4e311a0 100644 --- a/src/engine.scm +++ b/src/engine.scm @@ -25,21 +25,30 @@ ;;; Engine definitions +(define (default-delay) 0.1) + +(define-component engine-inner-properties + delay) + (define-record-type engine - (make-engine-record entities mutex system) + (make-engine-record entities mutex running-mutex system) engine? (entities engine-entities set-engine-entities!) (mutex engine-mutex set-engine-mutex!) + (running-mutex engine-running-mutex set-engine-running-mutex!) (system engine-system set-engine-system!)) (set-record-type-printer! engine (lambda (record port) - (format port "#<[engine] entities: ~a>" + (format port "#<[engine] state: ~a, entities: ~a>" + (if (engine-running? record) "Running" "Stopped") (length (car (engine-entities record)))))) (define (make-engine . systems) (make-engine-record - '(() ()) + (receive (e c) ((new-entity (make-engine-inner-properties (default-delay))) '() '()) + (list e c)) + (make-mutex) (make-mutex) (if (not (= (length systems) 1)) (join-systems systems) @@ -51,8 +60,14 @@ (define name (make-engine system ...))))) +(define (engine-running? engine) + (mutex-locked? (engine-running-mutex engine))) + (export make-engine - define-engine) + define-engine + engine-running?) + +(export-component engine-inner-properties) ;;; Engine Access Protocol Interface @@ -75,6 +90,11 @@ (define* (get-entity key #:key (engine (current-engine))) (assoc key (car (engine-entities engine)))) +(define* (get-entities-by-components component-types #:key (engine (current-engine))) + (map (lambda (e) + (get-entity e #:engine engine)) + (find-entities-by-components (cadr (engine-entities engine)) component-types))) + (define-syntax define-entity-setter (syntax-rules () ((_ name! name) @@ -105,9 +125,46 @@ (export current-engine set-current-engine! get-entity + get-entities-by-components new-entity! remove-entity! set-entity! set-entity-components! remove-entity-components! with-engine) + + +;;; Engine execution + +(define (start-engine engine) + (cond ((not (engine-running? engine)) + (with-mutex (engine-running-mutex engine) + (let loop () + (let ((delay 0)) + (with-engine engine + (receive (e c) ((apply (engine-system engine) (engine-entities engine))) + (set-engine-entities! engine (list e c))) + (set! delay (engine-inner-properties-delay (get-component 'engine-inner-properties (car (get-entities-by-components '(engine-inner-properties))))))) + (usleep (inexact->exact (* delay 1000000)))) + (if (not (engine-stopping? engine #:clean #t)) + (loop))))))) + +(define (stop-engine engine) + (with-engine engine + (new-entity! '(engine-halt . #t))) + 'engine-halt) + +(define* (engine-stopping? engine #:key (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)))))))) + halt)) + +(export start-engine + stop-engine + engine-stopping?)