From 89384d39e57e438e6711fc06d9242f8efb7890a8 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Thu, 22 Aug 2013 11:05:28 +0200 Subject: [PATCH] More verbose mode for working with entities and components; assoc lists no more needed * src/system.scm: entities/components functions now return a function for changing the entity/component structure * src/test.scm: functions testing adapted to new scheme --- src/system.scm | 109 ++++++++++++++++++++++++++----------------------- src/test.scm | 52 +++++++++++------------ 2 files changed, 84 insertions(+), 77 deletions(-) diff --git a/src/system.scm b/src/system.scm index 3c84548..9ad9ef0 100644 --- a/src/system.scm +++ b/src/system.scm @@ -97,63 +97,70 @@ (else (assoc-set! clist type elist)))))))) -(define (new-entity new-components entities components) - (let ((key (gensym)) - (nc (normalize-components new-components))) - (values - (acons key nc entities) - (register-components key - (map (lambda (c) (car c)) nc) - components) - key))) - -(define (remove-entity key entities components) - (let ((clist (map (lambda (c) (car c)) (assoc-ref entities key)))) - (values - (assoc-remove! entities key) - (unregister-components key clist components)))) - -(define (set-entity key new-components entities components) - (let* ((nc (normalize-components new-components)) - (clist (map (lambda (c) (car c)) (assoc-ref entities key))) - (nclist (map (lambda (c) (car c)) nc))) - (values - (assoc-set! entities key nc) - (register-components key (lset-difference eq? nclist clist) - (unregister-components key (lset-difference eq? clist nclist) components))))) - -(define (set-entity-components key new-components entities components) - (define (set-components clist new-components) - (cond ((null? new-components) - clist) - (else - (set-components - (if (cdar new-components) - (assoc-set! clist (caar new-components) (cdar new-components)) - (assoc-remove! clist (caar new-components))) - (cdr new-components))))) - (set-entity key (set-components (alist-copy (assoc-ref entities key)) (normalize-components new-components)) entities components)) - -(define (set-entities new-entities entities components) - (cond ((null? new-entities) +(define (new-entity . new-components) + (lambda (entities components) + (let ((key (gensym)) + (nc (normalize-components new-components))) + (values + (acons key nc entities) + (register-components key + (map (lambda (c) (car c)) nc) + components) + key)))) + +(define (remove-entity key) + (lambda (entities components) + (let ((clist (map (lambda (c) (car c)) (assoc-ref entities key)))) + (values + (assoc-remove! entities key) + (unregister-components key clist components))))) + +(define (set-entity key . new-components) + (lambda (entities components) + (let* ((nc (normalize-components new-components)) + (clist (map (lambda (c) (car c)) (assoc-ref entities key))) + (nclist (map (lambda (c) (car c)) nc))) + (values + (assoc-set! entities key nc) + (register-components key (lset-difference eq? nclist clist) + (unregister-components key (lset-difference eq? clist nclist) components)))))) + +(define (set-entity-components key . new-components) + (lambda (entities components) + (let ((nc (normalize-components new-components)) + (clist (alist-copy (assoc-ref entities key)))) + (for-each + (lambda (c) + (assoc-set! clist (car c) (cdr c))) + nc) + (values + (assoc-set! entities key clist) + (register-components key (map (lambda (c) (car c)) nc) components))))) + +(define (remove-entity-components key . old-components) + (lambda (entities components) + (let ((clist (alist-copy (assoc-ref entities key)))) + (for-each + (lambda (c) + (assoc-remove! clist c)) + old-components) + (values + (assoc-set! entities key clist) + (unregister-components key old-components components))))) + +(define (modify-entities changes entities components) + (cond ((null? changes) (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))))))) - - + (receive (e c) ((car changes) entities components) + (modify-entities (cdr changes) e c))))) + (export new-entity remove-entity set-entity set-entity-components - set-entities) + remove-entity-components + modify-entities) ;;; Making systems diff --git a/src/test.scm b/src/test.scm index 45bdef5..fc710f2 100644 --- a/src/test.scm +++ b/src/test.scm @@ -30,44 +30,44 @@ (let ((entities '()) (components '()) (key #f)) - (receive (e c k) (new-entity (list (make-a 1 2) (make-b)) entities components) - (set! entities e) - (set! components c) - (set! key k) - (display k) (newline)) + (receive (e c k) ((new-entity (make-a 1 2) (make-b)) entities components) + (set! entities e) + (set! components c) + (set! key k) + (display k) (newline)) (format #t "New entity with a and b:~%~a~%~a~%~%" entities components) - (receive (e c k) (new-entity (list (make-a 10 20)) entities components) - (set! entities e) - (set! components c) - (display k) (newline)) + (receive (e c k) ((new-entity (make-a 10 20)) entities components) + (set! entities e) + (set! components c) + (display k) (newline)) (format #t "New entity with a:~%~a~%~a~%~%" entities components) - (receive (e c) (set-entity-components key `((b . #f) ,(make-a 50 50)) entities components) - (set! entities e) - (set! components c)) + (receive (e c) (modify-entities (list (set-entity-components key (make-a 50 50)) (remove-entity-components key 'b)) entities components) + (set! entities e) + (set! components c)) (format #t "First entity removes b and changes a:~%~a~%~a~%~%" entities components) - (receive (e c) (remove-entity key entities components) - (set! entities e) - (set! components c)) + (receive (e c) ((remove-entity key) entities components) + (set! entities e) + (set! components c)) (format #t "Removes first entity:~%~a~%~a~%~%" entities components) - (receive (e c k) (new-entity (list (make-a 1 2) (make-b)) entities components) - (set! entities e) - (set! components c) - (set! key k) - (display k) (newline)) + (receive (e c k) ((new-entity (make-a 1 2) (make-b)) entities components) + (set! entities e) + (set! components c) + (set! key k) + (display k) (newline)) (format #t "New entity with a and b:~%~a~%~a~%~%" entities components) - (receive (e c) (set-entities `((,key . ((b . #f) ,(make-a 50 50))) (#f . (,(make-a 1000 1000)))) entities components) - (set! entities e) - (set! components c)) + (receive (e c) (modify-entities (list (set-entity-components key (make-a 50 50)) (remove-entity-components key 'b) (new-entity (make-a 1000 1000))) entities components) + (set! entities e) + (set! components c)) (format #t "Last entity removes b and changes a, and new entity with a:~%~a~%~a~%~%" entities components) - (receive (e c) (set-entities `((,key . #f)) entities components) - (set! entities e) - (set! components c)) + (receive (e c) (modify-entities (list (remove-entity key)) entities components) + (set! entities e) + (set! components c)) (format #t "Remove last entity:~%~a~%~a~%~%" entities components) )) -- 2.39.5