-;;; Engine Access Protocol Interface
-
-(define current-engine-mutex (make-mutex))
-(define current-engine-list '())
-
-(define (current-engine)
- (with-mutex current-engine-mutex
- (assoc-ref current-engine-list (current-thread))))
-
-(define (set-current-engine! engine)
- (with-mutex current-engine-mutex
- (set! current-engine-list
- (cond (engine
- (assoc-set! current-engine-list (current-thread) engine))
- (else
- (assoc-remove! current-engine-list (current-thread)))))))
-
-(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)
- (define (name! . args)
- (let ((f (apply name args))
- (engine (current-engine)))
- (receive (e c r) (f (car (engine-entities engine)) (cadr (engine-entities engine)))
- (set-engine-entities! engine (list e c))
- r))))))
-
-(define-entity-setter new-entity! new-entity)
-(define-entity-setter remove-entity! remove-entity)
-(define-entity-setter set-entity! set-entity)
-(define-entity-setter set-entity-components! set-entity-components)
-(define-entity-setter remove-entity-components! remove-entity-components)
-
-(define-syntax with-engine
- (syntax-rules ()
- ((_ engine body ...)
- (let ((old-engine (current-engine)))
- (set-current-engine! engine)
- (let ((res (with-mutex (engine-mutex engine)
- body
- ...)))
- (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
- get-entities-by-components
- new-entity!
- remove-entity!
- set-entity!
- set-entity-components!
- remove-entity-components!
- with-engine
- set-engine-systems!)
-
-