From ae294fed13cd0a99c87d04ac98db272e87cb289f Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Wed, 11 Sep 2013 07:13:43 +0200 Subject: [PATCH] Making systems with macros instead functions. Now, we have define-system and make-system. --- src/examples/composing-systems.scm | 30 ++++++++++++++---------------- src/examples/making-systems.scm | 4 ++-- src/system.scm | 28 ++++++++++++++++++---------- 3 files changed, 34 insertions(+), 28 deletions(-) diff --git a/src/examples/composing-systems.scm b/src/examples/composing-systems.scm index feecee3..5af39c0 100644 --- a/src/examples/composing-systems.scm +++ b/src/examples/composing-systems.scm @@ -20,23 +20,21 @@ #: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 l) + (lambda (e) + (sleep 3) + (map + (lambda (e1) + (set-entity-components (car e1) `(l . ,(cons 1 (cdadr e1))))) + e))) -(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 l) + (lambda (e) + (sleep 4) + (map + (lambda (e1) + (set-entity-components (car e1) `(l . ,(cons 2 (cdadr e1))))) + e))) (define (composing-with-join) (let ((entities '()) diff --git a/src/examples/making-systems.scm b/src/examples/making-systems.scm index b3f381d..3709719 100644 --- a/src/examples/making-systems.scm +++ b/src/examples/making-systems.scm @@ -25,11 +25,11 @@ (define (making-systems) (let ((entities '()) (components '())) - (receive (e c) (((make-system '() (lambda (e) (list (new-entity (make-a 1 2)) (new-entity (make-a 10 20))))) entities components)) + (receive (e c) (((make-system () (lambda (e) (list (new-entity (make-a 1 2)) (new-entity (make-a 10 20))))) entities components)) (set! entities e) (set! components c)) (format #t "Two new entities with a:~%~a~%~a~%~%" entities components) - (((make-system '(a) (lambda (e) (display e) (newline) '())) entities components)))) + (((make-system (a) (lambda (e) (display e) (newline) '())) entities components)))) (export making-systems) diff --git a/src/system.scm b/src/system.scm index 502ccd6..2a9365b 100644 --- a/src/system.scm +++ b/src/system.scm @@ -175,16 +175,23 @@ (lset-intersection eq? e* (find-entities-by-components c (cdr t))))))))) -(define (make-system component-types system-fun) - (lambda (entities components) - (let* ((e (find-entities-by-components components component-types)) - (e* (map (lambda (x) (assoc x entities)) e)) - (e** (map (lambda (x) (cons (car x) (filter (lambda (x) (memq (car x) component-types)) (cdr x)))) e*)) - (res (system-fun e**))) - (lambda* (#:optional (entities2 #f) (components2 #f)) - (let ((e (if (and entities2 components2) entities2 entities)) - (c (if (and entities2 components2) components2 components))) - (modify-entities res e c)))))) +(define-macro (make-system component-types system-func) + `(let ((func ,system-func)) + (lambda (entities components) + (let* ((e (find-entities-by-components components ',component-types)) + (e* (map (lambda (x) (assoc x entities)) e)) + (e** (map (lambda (x) (cons (car x) (filter (lambda (x) (memq (car x) ',component-types)) (cdr x)))) e*)) + (res (func e**))) + (lambda* (#:optional (entities2 #f) (components2 #f)) + (let ((e (if (and entities2 components2) entities2 entities)) + (c (if (and entities2 components2) components2 components))) + (modify-entities res e c))))))) + + +(define-macro (define-system head system-func) + (let ((name (car head)) + (component-types (cdr head))) + `(define ,name (make-system ,component-types ,system-func)))) (define (join-systems . systems) @@ -214,6 +221,7 @@ (export find-entities-by-components + define-system make-system join-systems threaded-systems) -- 2.39.5