TakeV/lisp-game-jam
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Test and fix entity-map:update-entitites!

Browse source
This commit is contained in:
TakeV 2024-05-27 01:16:36 -04:00
parent e0ddac4e75
commit 9d4c126bfc
Signed by: TakeV
GPG key ID: A64F41345C7400AF
2 changed files with 32 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
modules/ces/entity/entity-map.scm
View file

@ -149,13 +149,13 @@ Returns the updated entity, or false if the entity does not exist."
(error "Invalid input for entity-map:copy-entity-map" entity-map)))
(define (update-entities! entity-map updated-entities-map)
"Updates entity-map using entities. entities can be a list, vector, or entity-map.
"Updates entity-map using a different entity-map, essentially doing a merge.
Entities within entity-map are added if they do not already exist, or are replaced if they do."
(if (and (entity-map? entity-map)
(entity-map? updated-entities-map))
(let ((cur-entity-table (entity-map-entities entity-map))
(update-source-table (entity-map-entities updated-entities-map)))
(hashtable-for-each (lambda (k v)
(set-entity! cur-entity-table k v))
(set-entity! entity-map k v))
update-source-table))
(error "Invalid inputs for update-entities!" entity-map updated-entities-map)))

38
test/tests/entity-map-tests.scm
View file

@ -44,6 +44,12 @@
"Keys:" keys
"\nValues:" (map %make-entity-string val-list))))
(define (get-component emap e-id c-key)
(ihashtable-get
(get-entity-components
(get-entity emap e-id))
c-key))
(test-runner-factory game-engine-test-runner)
(test-begin "test-entity-map")
@ -101,20 +107,36 @@
(add-component-proc (lambda (e)
(set-entity-components e new-components)))
(bad-update-proc (lambda (e)
'this-should-fail))
(get-component (lambda (e-id c-key)
(ihashtable-get
(get-entity-components
(get-entity emap-copy e-id))
c-key))))
'this-should-fail)))
;; Components updated
(update-entity! emap-copy next-id add-component-proc)
(test-eqv 'b (get-component next-id 'a))
(test-eqv 'b (get-component emap-copy next-id 'a))
;; No update on bad input
(update-entity! emap-copy next-id bad-update-proc)
(test-eqv 'b (get-component next-id 'a)))
(test-eqv 'b (get-component emap-copy next-id 'a)))
(let* ((emap-empty (create-entity-map))
(emap-source (copy-entity-map list-constructed))
(new-components (create-ihashtable '((a . b))))
(add-component-proc (lambda (e)
(set-entity-components e new-components))))
(test-eqv 'notfound (get-entity emap-empty next-entity #:default 'notfound))
(update-entities! emap-empty emap-source)
(test-eqv next-entity (get-entity emap-empty next-entity))
(test-eqv empty-entity (get-entity emap-empty empty-entity))
;; Not there yet
(test-eqv #f (get-component emap-empty empty-entity 'a))
(update-entity! emap-source empty-id add-component-proc)
;; Adding to source
(test-eqv 'b (get-component emap-source empty-entity 'a))
;; Merging
(update-entities! emap-empty emap-source)
(test-eqv 'b (get-component emap-empty empty-entity 'a)))
(test-end)