Add a defesystem macro to define entity-systems

core/entity.lisp

@@ -11,12 +11,16 @@
            #:components #:component #:all-components
            #:defcomponent #:with-components
            #:add-component #:remove-component
-           #:create-entity #:destroy-entity))
+           #:create-entity #:destroy-entity
+           #:entity-system #:defesystem
+           #:esystem-initialize #:esystem-finalize
+           #:esystem-update #:run-esystem))
 (in-package :stoe/core/entity)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defvar *entity-array* (make-array 10 :adjustable t :fill-pointer 0))
-  (defvar *components-table-table* (make-hash-table)))
+  (defvar *components-table-table* (make-hash-table))
+  (defvar *system-list* '()))
 
 (let (available-ids)
   (defun get-available-ids ()
@@ -211,3 +215,38 @@ class OPTIONS are supported together with the option :NEEDS used to define the d
   (loop for comp in (all-components entity)
      do (remove-component entity comp))
   (unregister-entity entity))
+
+(defclass entity-system ()
+  ((components :initarg :component)
+   (method-arglists :initarg :arglists))
+  (:documentation "Base class for an entity system."))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun register-entity-system (classname components arglists)
+    (let ((instance (make-instance classname :components components :arglists arglists)))
+      (push instance *system-list*)
+      instance)))
+
+(defgeneric esystem-initialize (system &key &allow-other-keys))
+(defgeneric esystem-finalize (system &key &allow-other-keys))
+(defgeneric esystem-update (system &key entity component &allow-other-keys))
+
+(defmacro defesystem (name (&rest components) slots &body body)
+  (flet ((filter-option (option)
+           (member (first option) '(:default-initargs :documentation :metaclass)))
+         (options-to-arglists (options)
+           (flatten (mapcar (lambda (option)
+                              (list (first option) (second option)))
+                            options))))
+    (let ((esystem-options (remove-if #'filter-option body)))
+      `(progn
+         (defclass ,name (entity-system)
+           ,slots
+           ,@(remove-if-not #'filter-option body))
+         (register-entity-system ',name ',components ,(options-to-arglists esystem-options))))))
+
+(defun run-esystem (system)
+  (with-slots (components) system
+    (loop for classname in components
+       do (loop for component in (gethash classname *components-table-table*)
+             do (esystem-update system :entity (owner component) :component component)))))

test/entity.lisp

@@ -103,6 +103,13 @@
 
 (is (length (all-components ent4)) 3 "all-components 3")
 
+(defesystem render-mesh (mesh-component)
+    ()
+  (:update (component)))
+
+(defmethod esystem-update ((system render-mesh) &key component)
+  (render component))
+
 (destroy-entity ent1)
 (destroy-entity ent2)
 (destroy-entity ent3)