X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fexamples%2Fcomposing-systems.scm;h=1d775c1a9717b4e1e111badd89c7d2eb7d7a53d1;hb=b1ade28aa0eab723292491d20d5841e4cb8da37c;hp=feecee360b45957a06a639611841c13fba3549cd;hpb=2b3814bf3f335a56c17b733caf90c17dbe229e91;p=gacela.git diff --git a/src/examples/composing-systems.scm b/src/examples/composing-systems.scm index feecee3..1d775c1 100644 --- a/src/examples/composing-systems.scm +++ b/src/examples/composing-systems.scm @@ -20,55 +20,45 @@ #:use-module (ice-9 receive)) -(define s1 - (make-system '(l) - (lambda (e) - (sleep 3) - (map - (lambda (e1) - (set-entity-components (car e1) `(l . ,(cons 1 (cdadr e1))))) - e)))) +(define-system s1 ((with-l (l))) + (sleep 3) + (entities-changes + (map (lambda (e) + (set-entity-components (get-key e) '(l1 . 1))) + with-l))) -(define s2 - (make-system '(l) - (lambda (e) - (sleep 4) - (map - (lambda (e1) - (set-entity-components (car e1) `(l . ,(cons 2 (cdadr e1))))) - e)))) +(define-system s2 ((with-l (l))) + (sleep 4) + (entities-changes + (map (lambda (e) + (set-entity-components (get-key e) '(l2 . 2))) + with-l))) (define (composing-with-join) - (let ((entities '()) - (components '())) - (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) - ((join-systems s1 s2) e c)))) + (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f))))) + (set! entities (modify-entities entities (get-entities-changes ((join-systems s1 s2) entities)))) + (entity-list entities))) (export composing-with-join) -(define (composing-with-threaded) - (let ((entities '()) - (components '())) - (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) - ((threaded-systems s1 s2) e c)))) +(define (composing-with-thread) + (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f))))) + (set! entities (modify-entities entities (get-entities-changes ((thread-systems s1 s2) entities)))) + (entity-list entities))) + +(export composing-with-thread) -(export composing-with-threaded) - -(define (join-vs-threaded) - (let ((entities '()) - (components '()) +(define (join-vs-thread) + (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f)))) (t (current-time))) - (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) - (receive (e c) ((join-systems s1 s2) e c) - (format #t "~a~%~a~%Time: ~a~%~%" e c (- (current-time) t))))) + (set! entities (modify-entities entities (get-entities-changes ((join-systems s1 s2) entities)))) + (format #t "~a~%Time: ~a~%~%" entities (- (current-time) t))) - (let ((entities '()) - (components '()) + (let ((entities (make-entity-set (new-entity '(l . ())) (new-entity '(l . ())) (new-entity '(a . #f)))) (t (current-time))) - (receive (e c) (modify-entities (list (new-entity '(l . ())) (new-entity '(l . ()))) entities components) - (receive (e c) ((threaded-systems s1 s2) e c) - (format #t "~a~%~a~%Time: ~a~%~%" e c (- (current-time) t)))))) + (set! entities (modify-entities entities (get-entities-changes ((thread-systems s1 s2) entities)))) + (format #t "~a~%Time: ~a~%~%" entities (- (current-time) t)))) -(export join-vs-threaded) +(export join-vs-thread)