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

Handle issue where entity-map:update-entity! would try setting an invalid entity

Browse source
This commit is contained in:
TakeV 2024-05-27 00:59:47 -04:00
parent 3729fcac49
commit e0ddac4e75
Signed by: TakeV
GPG key ID: A64F41345C7400AF
2 changed files with 34 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -115,8 +115,9 @@ stored."
(define (delete-entity! entity-map entity)
"Removes the entity from the entity map"
(when (and (entity-map? entity-map)
(get-entity entity-map entity))
(when (and
(entity-map? entity-map)
(get-entity entity-map entity))
(hashtable-delete! (entity-map-entities entity-map)
(entity-key entity))))
@ -126,9 +127,11 @@ with the result of proc.
proc must be a proceedure with one argument: the entity to update.
proc should be free of side effects, as it may be called multiple times.
If the entity does not exist, no change is applied. "
(let ((old-entity (get-entity entity-map entity-id)))
(let ((old-entity (get-entity entity-map entity-id #:default #f)))
(when old-entity
(set-entity! entity-map entity-id (proc old-entity)))))
(let ((updated-entity (proc old-entity)))
(when (game-entity? updated-entity)
(set-entity! entity-map entity-id updated-entity))))))
(define (update-entity entity-map entity-id proc)
"Pure update-entity call, does not modify the underlying entity.

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

@ -87,8 +87,34 @@
(let* ((funky-entity (entity-generator))
(funky-entity-id (game-entity-id funky-entity))
(correct-id (+ 100 funky-entity-id)))
(set-entity! emap-copy correct-id funky-entity)
(test-eqv correct-id (game-entity-id (get-entity emap-copy correct-id)))))
(test-eqv correct-id (game-entity-id (get-entity emap-copy correct-id)))
;; Test deletion
(delete-entity! emap-copy correct-id)
(test-eqv 'notfound (get-entity emap-copy correct-id #:default 'notfound))))
(let* ((emap-original list-constructed)
(emap-copy (copy-entity-map emap-original))
(new-components (create-ihashtable '((a . b))))
(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))))
;; Components updated
(update-entity! emap-copy next-id add-component-proc)
(test-eqv 'b (get-component 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-end)