-(define (join-systems . systems)
- (lambda (entities components)
- (let ((changes
- (let run ((s systems) (e (alist-copy entities)) (c (alist-copy components)) (res '()))
- (cond ((null? s)
- res)
- (else
- (let ((r ((car s) e c)))
- (receive (e2 c2) (r)
- (run (cdr s) e2 c2 (cons r res)))))))))
- (lambda* (#:optional (entities2 #f) (components2 #f))
- (let modify ((e (if (and entities2 components2) entities2 entities))
- (c (if (and entities2 components2) components2 components))
- (ch (reverse changes)))
- (cond ((null? ch)
- (values e c))
- (else
- (receive (e2 c2) ((car ch) e c)
- (modify e2 c2 (cdr ch))))))))))
-
-(define (threaded-systems . systems)
- (lambda (entities components)
- (let ((changes
- (let run-wait ((thd
- (map (lambda (s)
- (call-with-new-thread
- (lambda () (s entities components))))
- systems))
- (res '()))
- (cond ((null? thd)
- res)
- (else
- (run-wait (cdr thd) (cons (join-thread (car thd)) res)))))))
- (lambda* (#:optional (entities2 #f) (components2 #f))
- (let modify ((e (if (and entities2 components2) entities2 entities))
- (c (if (and entities2 components2) components2 components))
- (ch changes))
- (cond ((null? ch)
- (values e c))
- (else
- (receive (e2 c2) ((car ch) e c)
- (modify e2 c2 (cdr ch))))))))))
-
-(define (group-systems . systems)
- (cond ((null? systems)
- (make-system ()))
- ((= (length systems) 1)
- (car systems))
- (else
- (apply join-systems systems))))
+(define (composed-systems-result results)
+ (let ((changes (filter (lambda (r) (entities-changes? r)) results)))
+ (cond ((null? changes)
+ (car results))
+ (else
+ (append-changes changes)))))