Add mechanism to delete entities from an entity manager

modules/ces/entity-manager.scm

@@ -16,11 +16,14 @@
   #:use-module (scheme case-lambda)
   #:use-module (ces entity)
   #:export (create-entity-manager
-            set-entity!
             add-entity!
+            reset-entity!
+            delete-entity!
             apply-update-to-entity!
+
             get-current-entities
             get-updated-entities
+            get-deleted-entities
             get-next-generation))
 
 (define-record-type <entity-map>
@@ -32,12 +35,20 @@
   "Creates a new entity-map and returns it."
   (make-entity-map (make-eq-hashtable)))
 
-(define (%get-entity entity-map entity-id)
+(define (%entity-key entity)
+  "Returns the entity id of an entity, or the value itself if it is
+and integer already. Returns false if passed an invalid entity."
+  (cond
+   ((game-entity? entity)) (game-entity-id entity)
+   ((integer? entity) entity)
+   (else #f)))
+
+(define (%get-entity entity-map entity)
   "Returns the entity with the supplied entity-id if one exists.
 Returns false if no entity exists with that id."
-  (hashtable-ref (entity-map-entities entity-map) entity-id #f))
+  (hashtable-ref (entity-map-entities entity-map) (%entity-key entity) #f))
 
-(define (get-entities entity-map criteria?)
+(define (%get-entities entity-map criteria?)
   "Returns a list of all entities which return a truthy value when used as
 an argument for criteria?"
   (let* ((entities (entity-map-entities entity-map))
@@ -51,16 +62,22 @@ an argument for criteria?"
       (hashtable-for-each update-entity-list entities)
       (atomic-box-ref entity-list))))
 
-(define set-entity!
-  ;; Replaces the entity in the entity-map the given entity.
-  ;; Optionally takes an entity-id, which updates the entry with that index.
-  (case-lambda
-    ((entity-map entity) (set-entity! entity-map entity (game-entity-id entity)))
-    ((entity-map entity entity-id) (let ((entity-table (entity-map-entities entity-map)))
-                                     (when (game-entity? entity)
-                                       (hashtable-set! entity-table entity-id entity))))))
+(define (%set-entity! entity-map entity)
+  "Replaces the entity in the entity-map the given entity."
+  (when (and (entity-map? entity-map)
+             (game-entity? entity))
+    (hashtable-set! (entity-map-entities entity-map)
+                    (%entity-key entity)
+                    entity)))
 
-(define (update-entity! entity-map entity-id proc)
+(define (%delete-entity! entity-map entity)
+  "Removes the entity from the entity map"
+  (when (and (entity-map? entity-map)
+             (%get-entity entity-map entity))
+    (hashtable-delete! (entity-map-entities entity-map)
+                       (%entity-key entity))))
+
+(define (%update-entity! entity-map entity-id proc)
   "Applies proc to the entity in entity-map with entity-id, and replaces the entity
 with the result of proc.
 proc must be a proceedure with one argument: the entity to update.
@@ -68,9 +85,9 @@ 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)))
     (when old-entity
-      (set-entity! entity-map entity-id (proc old-entity)))))
+      (%set-entity! entity-map (proc old-entity)))))
 
-(define (update-entity entity-map entity-id proc)
+(define (%update-entity entity-map entity-id proc)
   "Pure update-entity call, does not modify the underlying entity.
 Returns the updated entity, or false if the entity does not exist."
   (let ((old-entity (%get-entity entity-map entity-id)))
@@ -78,65 +95,123 @@ Returns the updated entity, or false if the entity does not exist."
         (proc old-entity)
         #f)))
 
-(define (update-entities! entity-map entities)
+(define (%update-entities! entity-map entities)
   "Updates entity-map using entities. entities can be a list, vector, or entity-map.
 Entities within entity-map are added if they do not already exist, or are replaced if they do."
   (match entities
     ((? entity-map?)
      (let ((new-entities (entity-map-entities entities)))
        (hashtable-for-each (lambda (k v)
-                             (set-entity! k v))
+                             (%set-entity! k v))
                            new-entities)))
     ((? list?)
-     (map set-entity! entities))
+     (map %set-entity! entities))
     ((? vector?)
-     (vector-map set-entity! entities))))
+     (vector-map %set-entity! entities))))
 
 (define-record-type <entity-manager>
-    (make-entity-manager current-entities next-entities)
+    (make-entity-manager current-entities
+                         next-entities
+                         entities-to-delete)
   entity-manager?
   (current-entities entity-manager-current-entities)
-  (next-entities entity-manager-next-entities))
+  (next-entities entity-manager-next-entities)
+  (entities-to-delete entity-manager-deleted-entities))
 
 (define create-entity-manager
   (case-lambda
     (() (create-entity-manager (create-entity-map)))
     ((initial-world-state)
-     (make-entity-manager initial-world-state (create-entity-map)))))
+     (make-entity-manager initial-world-state
+                          (create-entity-map)
+                          (create-entity-map)))))
+
+(define (%valid-em-inputs? entity-manager entity)
+  "Returns true if entity-manager and entity are both
+valid inputs. A valid entity can be either an entity, or
+an integer."
+  (and (entity-manager? entity-manager)
+       (or (game-entity? entity)
+           (integer? entity))))
+
+(define (%entity-check-helper entity-manager entity manager-field)
+  (and (%valid-em-inputs? entity-manager entity)
+       (%get-entity (manager-field entity-manager)
+                    (%entity-key entity))))
+
+(define (%entity-deleted? entity-manager entity)
+  (%entity-check-helper entity-manager entity entity-manager-deleted-entities))
+
+;; Going to want to decouple updates and additions later,
+;; but for now they both check the next-gen table.
+(define (%entity-updated? entity-manager entity)
+  (%entity-check-helper entity-manager entity entity-manager-next-entities))
+(define %entity-added? %entity-updated?)
+
+(define (%entity-currently-exists? entity-manager entity)
+  (%entity-check-helper entity-manager entity entity-manager-current-entities))
+
+(define (%get-em-state-list entity-manager entity)
+  (values (%entity-currently-exists? entity-manager entity)
+          (%entity-added? entity-manager entity)
+          (%entity-updated? entity-manager entity)
+          (%entity-deleted? entity-manager entity)))
+
+(define (%get-em-fields entity-manager)
+  (if (entity-manager? entity-manager)
+      (values (entity-manager-current-entities entity-manager)
+              (entity-manager-next-entities entity-manager)
+              (entity-manager-deleted-entities entity-manager))))
 
 (define (add-entity! entity-manager entity)
-  (when (and (entity-manager? entity-manager)
-             (game-entity? entity))
-    (let ((updated-entities (entity-manager-next-entities entity)))
-      (set-entity! updated-entities entity))))
+  "Adds an entity to the next generation."
+  (when (%valid-em-inputs? entity-manager entity)
+    (let-values (((cur add up del)
+                  (%get-em-state-list entity-manager entity))
+                 ((em-cur em-next em-del)
+                  (%get-em-state-list entity-manager entity))) 
+      (when (not (or cur add))
+        (%set-entity! em-next entity)))))
 
-;; We only want to update the next state, so we check
-;; if the entity already exists in the next state,
-;; otherwise update the current entity.
-(define (%get-map-to-update entity-manager entity-id)
-  (let* ((current-entities (entity-manager-current-entities entity-manager))
-         (next-entities (entity-manager-next-entities entity-manager)))
-    (if (%get-entity next-entities entity-id)
-        next-entities
-        current-entities)))
+(define (delete-entity! entity-manager entity)
+  "Deletes the entity from the next generation."
+  (let-values (((cur add upt del)
+                (%get-em-state-list entity-manager entity))
+               ((em-cur em-next em-del)
+                (%get-em-fields entity-manager)))
+    ;; Only continue if we have not seen this entity before
+    (when (not del)
+      (when add 
+        (%delete-entity! em-cur entity))
+      (when upt
+        (%delete-entity! em-next entity))
+      (when cur
+        (%set-entity! em-del entity)))))
+
+(define (reset-entity! entity-manager entity)
+  "Replaces an entity, either adding it or updating it in the next gen."
+  (when (and (%valid-em-inputs? entity-manager entity)
+             (game-entity? entity))
+    (let-values (((cur add upt del)
+                  (%get-em-state-list entity-manager entity))
+                 ((em-cur em-next em-del)
+                  (%get-em-fields entity-manager)))
+      (begin
+        (when del
+          (%delete-entity! em-del entity))
+        (%set-entity! em-next entity)))))
 
 (define (apply-update-to-entity! entity-manager entity proc)
   "Applies proc to the given entity, and stores the result
 in the updated entities list."
-  (when (game-entity? entity)
-    (let* ((entity-id (game-entity-id entity))
-           (map-to-update (%get-map-to-update entity-manager entity-id))
-           (existing-entity (%get-entity map-to-update entity-id)))
-      (when existing-entity
-        (update-entity! map-to-update entity-id proc)))))
+  (when (%valid-em-inputs? entity-manager entity)
+    (reset-entity! entity-manager (proc entity))))
 
-(define (get-entity entity-manager entity-id)
+(define (get-entity entity-manager entity)
   "Returns the entity with entity-id from the current world state.
 Returns false if the entity does not exist."
-  (if (entity-manager? entity-manager)
-      (%get-entity (entity-manager-current-entities entity-manager)
-                   entity-id)
-      #f))
+  (and (%valid-em-inputs? entity-manager entity)
+       (%get-entity (entity-manager-current-entities entity-manager) entity)))
 
 (define (get-current-entities entity-manager)
   "Returns a vector of every current entity."
@@ -146,6 +221,10 @@ Returns false if the entity does not exist."
   "Returns a vector of the updated-entities"
   (hashtable-entries (entity-manager-next-entities entity-manager)))
 
+(define (get-deleted-entities entity-manager)
+  "Returns a vector of the deleted-entities"
+  (hashtable-entries (entity-manager-deleted-entities entity-manager)))
+
 (define (get-next-generation entity-manager)
   "Returns an entity-manager representing the next generation.
 The new current-entities will be the result of replacing entity-manager's
@@ -154,4 +233,4 @@ current entities with the next-entities."
     (let* ((current-gen (entity-manager-current-entities entity-manager))
            (updates (entity-manager-next-entities entity-manager))
            (next-generation (hashtable-copy current-gen)))
-      (make-entity-manager (update-entities! next-generation updates)))))
+      (make-entity-manager (%update-entities! next-generation updates)))))

modules/ces/system/keyboard-reader.scm

@@ -91,9 +91,8 @@
 
 (define (%set-entity-input-component! entity)
   (begin (set-component! entity 'keyboard-inputs %get-current-input-state)
-         (set-entity! (get-entity-manager)
-                      (game-entity-id entity)
-                      entity)))
+         (reset-entity! (get-entity-manager)
+                        entity)))
 
 (define (create-keyboard-reader current-document keys-to-monitor)
   (begin (%register-callbacks! current-document keys-to-monitor)