From: Javier Sancho Date: Tue, 7 Jan 2014 05:56:00 +0000 (+0100) Subject: Support for engine properties X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=4a9300c98ab89c99a26887b08e3a1c5bea41eb77;p=gacela.git Support for engine properties * src/engine.scm: new functions get-property and set-property! allow interaction with properties stored in entities --- diff --git a/src/engine.scm b/src/engine.scm index 33c8a6f..2e3cbd3 100644 --- a/src/engine.scm +++ b/src/engine.scm @@ -23,12 +23,46 @@ #:use-module (srfi srfi-9 gnu)) -;;; Engine definitions +;;; Engine Properties + +(define* (get-property property-path #:key (engine (current-engine))) + (let ((entities (get-entities-by-components (list (car property-path)) #:engine engine))) + (cond ((null? entities) + #f) + (else + (let loop ((property (get-component (car property-path) (car entities))) + (path (cdr property-path))) + (cond ((or (null? path) (not property)) + property) + (else + (loop (assoc-ref property (car path)) (cdr path))))))))) + +(define* (set-property! property-path value #:key (engine (current-engine))) + (define (loop property path) + (cond ((null? path) + value) + (else + (assoc-set! (or property '()) (car path) (loop (assoc-ref property (car path)) (cdr path)))))) + + (let ((entities (get-entities-by-components (list (car property-path)) #:engine engine))) + (cond ((null? entities) + (new-entity! `(,(car property-path) . ,(loop '() (cdr property-path))))) + (else + (set-entity-components! (get-key (car entities)) `(,(car property-path) . ,(loop (get-component (car property-path) (car entities)) (cdr property-path)))))))) + +(export get-property + set-property!) + + +;;; Engine Inner Properties (define (default-delay) 0.1) -(define-component engine-inner-properties - delay) +(define (default-engine-inner-properties) + `(engine-inner-properties (delay . ,(default-delay)))) + + +;;; Engine definitions (define-record-type engine (make-engine-record entities mutex running-mutex system) @@ -46,7 +80,7 @@ (define (make-engine . systems) (make-engine-record - (receive (e c) ((new-entity (make-engine-inner-properties (default-delay))) '() '()) + (receive (e c) ((new-entity (default-engine-inner-properties)) '() '()) (list e c)) (make-mutex) (make-mutex) @@ -65,8 +99,6 @@ define-engine engine-running?) -(export-component engine-inner-properties) - ;;; Engine Access Protocol Interface @@ -147,7 +179,7 @@ (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))))))) + (set! delay (get-property '(engine-inner-properties delay)))) (usleep (inexact->exact (* delay 1000000)))) (if (not (engine-stopping? engine #:clean #t)) (loop)))))))