Test and fix entity-map:update-entitites!
This commit is contained in:
parent
e0ddac4e75
commit
9d4c126bfc
2 changed files with 32 additions and 10 deletions
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in a new issue