From: Javier Sancho Date: Thu, 8 Aug 2013 04:59:48 +0000 (+0200) Subject: Making systems; systems return a lambda function for process X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=1b809e1a58ec2a94903b4b44101d706fd0f27c81;p=gacela.git Making systems; systems return a lambda function for process modifications at entities and components * src/system.scm: set-entities * src/test.scm: system functions testing --- diff --git a/src/system.scm b/src/system.scm index ea9476a..d356665 100644 --- a/src/system.scm +++ b/src/system.scm @@ -16,6 +16,7 @@ (define-module (gacela system) + #:use-module (ice-9 receive) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9)) @@ -123,11 +124,26 @@ (cdr new-components))))) (set-entity key (set-components (alist-copy (assoc-ref entities key)) new-components) entities components)) +(define (set-entities new-entities entities components) + (cond ((null? new-entities) + (values entities components)) + (else + (cond ((not (caar new-entities)) + (receive (e c k) (new-entity (cdar new-entities) entities components) + (set-entities (cdr new-entities) e c))) + ((not (cdar new-entities)) + (receive (e c) (remove-entity (caar new-entities) entities components) + (set-entities (cdr new-entities) e c))) + (else + (receive (e c) (set-entity-components (caar new-entities) (cdar new-entities) entities components) + (set-entities (cdr new-entities) e c))))))) + (export new-entity remove-entity set-entity - set-entity-components) + set-entity-components + set-entities) ;;; Making systems @@ -146,24 +162,13 @@ (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 (get-component-type x) component-types)) (cdr x)))) 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* ((e2 (if (and entities2 components2) - (find-entities-by-components components2 component-types) - e)) - (e2* (if (and entities2 components2) - (map (lambda (x) (assoc x entities2)) e2) - e*)) - (e2** (if (and entities2 components2) - (map (lambda (x) (cons (car x) (filter (lambda (x) (memq (get-component-type x) component-types)) (cdr x)))) e2*) - e**))) - e2**))))) - -; ((1 a b) (2 a b c) (3 c)) -; ((1 a b) (2 a b)) -; ((1 a) (a b)) -; ((1 a) (3 c) (4 a b)) + (let ((e (if (and entities2 components2) entities2 entities)) + (c (if (and entities2 components2) components2 components))) + (set-entities res e c)))))) + (export find-entities-by-components make-system) diff --git a/src/test.scm b/src/test.scm index 0570c9b..8b7723f 100644 --- a/src/test.scm +++ b/src/test.scm @@ -52,6 +52,37 @@ (set! entities e) (set! components c)) (format #t "~a~%~a~%~%" entities components) + + (receive (e c k) (new-entity `((a . ,(make-a 1 2)) (b . ,(make-b))) entities components) + (set! entities e) + (set! components c) + (set! key k) + (display k) (newline)) + (format #t "~a~%~a~%~%" entities components) + + (receive (e c) (set-entities `((,key . ((b . #f) (a . ,(make-a 50 50)))) (#f . ((a . ,(make-a 1000 1000))))) entities components) + (set! entities e) + (set! components c)) + (format #t "~a~%~a~%~%" entities components) + + (receive (e c) (set-entities `((,key . #f)) entities components) + (set! entities e) + (set! components c)) + (format #t "~a~%~a~%~%" entities components) )) (export test1) + + +(define (test2) + (let ((entities '()) + (components '())) + (receive (e c) (((make-system '() (lambda (e) `((#f . ((a . ,(make-a 1 2)))) (#f . ((a . ,(make-a 10 20))))))) entities components)) + (set! entities e) + (set! components c)) + (format #t "~a~%~a~%~%" entities components) + + (((make-system '(a) (lambda (e) (display e) (newline) '())) entities components)) +)) + +(export test2)