floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add components slot to entity for faster retrieval

Browse source
This commit is contained in:
Renaud Casenave-Péré 2016-08-02 19:25:57 +02:00
parent 580bcd9799
commit 9f8990adae
1 changed files with 33 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
core/entity.lisp
View file

@ -49,7 +49,8 @@
(defclass entity ()
((name :initarg :name :reader name)
(object-id :initform 0 :reader object-id))
(object-id :initform 0 :reader object-id)
(components :initform nil))
(:documentation "Class for an entity comprised of a unique identifier."))
(defmethod initialize-instance :after ((entity entity) &key)
@ -83,8 +84,9 @@
(defun all-components (entity)
"Return a list of all entity's components."
(flatten (loop for components-table being the hash-value in *components-table-table*
collect (gethash (object-id entity) components-table))))
(with-slots (components) entity
(flatten (loop for comp-name in components
collect (components entity comp-name)))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *component-subclasses* (make-hash-table)
@ -158,20 +160,33 @@ class OPTIONS are supported together with the option :NEEDS used to define the d
(defun add-component (entity component)
"Add a component to entity."
(let ((components-table (ensure-components-table component)))
(if (allow-multiple-p component)
(push component (gethash (object-id entity) components-table))
(if (gethash (object-id entity) components-table)
(error "A component of the same type already exists for this entity.")
(setf (gethash (object-id entity) components-table) component)))))
(with-slots (components) entity
(let ((components-table (ensure-components-table component)))
(if (allow-multiple-p component)
(progn
(unless (gethash (object-id entity) components-table)
(push (class-name (class-of component)) components))
(push component (gethash (object-id entity) components-table)))
(if (gethash (object-id entity) components-table)
(error "A component of the same type already exists for this entity.")
(progn
(push (class-name (class-of component)) components)
(setf (gethash (object-id entity) components-table) component))))
component)))
(defun remove-component (entity component)
"Remove a component from entity."
(let ((components-table (ensure-components-table component)))
(let ((place (gethash (object-id entity) components-table)))
(with-slots (components) entity
(let* ((components-table (ensure-components-table component))
(place (gethash (object-id entity) components-table)))
(if (allow-multiple-p component)
(setf place (delete component place))
(remhash place components-table)))))
(progn
(setf place (delete component place))
(unless place
(delete (class-name (class-of component)) components)))
(progn
(remhash place components-table)
(delete (class-name (class-of component)) components))))))
(defmethod initialize-instance :after ((comp component) &key owner)
(add-component owner comp))
@ -201,10 +216,10 @@ class OPTIONS are supported together with the option :NEEDS used to define the d
(let ((sorted-specs (resolve-dependencies component-specs)))
(with-gensyms (entity)
`(ret ,entity (make-entity ,name)
,@(loop for specs in sorted-specs
collect (let* ((spec (safe-list specs))
(comp-symb (first spec))
(comp-options (rest spec)))
,@(loop for spec in sorted-specs
collect (let* ((spec-list (safe-list spec))
(comp-symb (first spec-list))
(comp-options (rest spec-list)))
`(make-instance ',comp-symb
,@(if comp-options
(append `(:owner ,entity)
@ -217,7 +232,7 @@ class OPTIONS are supported together with the option :NEEDS used to define the d
(unregister-entity entity))
(defclass entity-system ()
((components :initarg :component)
((components :initarg :components)
(method-arglists :initarg :arglists))
(:documentation "Base class for an entity system."))