(define-module (gacela engine)
+ #:use-module (gacela misc)
#:use-module (gacela system)
#:use-module (ice-9 receive)
#:use-module (ice-9 threads)
#: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!)
+
-(define (default-delay) 0.1)
+;;; Engine Inner Properties
-(define-component engine-inner-properties
- delay)
+(define (default-step) 0.1)
+
+(define (default-engine-inner-properties)
+ `(engine-inner-properties (step . ,(default-step))))
+
+
+;;; Engine definitions
(define-record-type engine
(make-engine-record entities mutex running-mutex system)
(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)
- (if (not (= (length systems) 1))
- (join-systems systems)
- (car systems))))
+ (apply group-systems systems)))
(define-syntax define-engine
(syntax-rules ()
define-engine
engine-running?)
-(export-component engine-inner-properties)
-
;;; Engine Access Protocol Interface
(set-current-engine! old-engine)
res)))))
+(define (set-engine-systems! engine . systems)
+ (with-mutex (engine-mutex engine)
+ (set-engine-system! engine (apply group-systems systems))))
+
(export current-engine
set-current-engine!
get-entity
set-entity!
set-entity-components!
remove-entity-components!
- with-engine)
+ with-engine
+ set-engine-systems!)
;;; Engine execution
(cond ((not (engine-running? engine))
(with-mutex (engine-running-mutex engine)
(let loop ()
- (let ((delay 0))
+ (let ((t (current-utime))
+ (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))))
+ (set! delay (- (inexact->exact (* (get-property '(engine-inner-properties step)) 1000000))
+ (- (current-utime) t))))
+ (cond ((> delay 0)
+ (usleep delay))))
(if (not (engine-stopping? engine #:clean #t))
(loop)))))))