# HG changeset patch # User Steve Losh # Date 1470766204 0 # Node ID dfc719d3ed025a22b202870e42c4cfa36e990c1e # Parent 19f3ffd6181e119b72c18f7592e0f3805e395b40 Fix package exports and don't use init instance diff -r 19f3ffd6181e -r dfc719d3ed02 beast.lisp --- a/beast.lisp Tue Aug 09 03:50:31 2016 +0000 +++ b/beast.lisp Tue Aug 09 18:10:04 2016 +0000 @@ -71,33 +71,43 @@ :do (setf (gethash id argument-index) entity))))) -(defmethod initialize-instance :after ((e entity) &key) - (index-entity e) - (index-entity-aspects e) - (index-entity-systems e)) +(defun unindex-entity (id) + (remhash id *entity-index*)) + +(defun unindex-entity-aspects (id) + (loop + :for index :being :the hash-values :of *aspect-index* + :do (remhash id index))) + +(defun unindex-entity-systems (id) + (loop + :for argument-indexes :being :the hash-values :of *system-index* + :do (loop :for index :in argument-indexes + :do (remhash id index)))) (defgeneric entity-created (entity) - (:method ((entity entity)) entity)) + (:method ((entity entity)) nil)) (defgeneric entity-destroyed (entity) - (:method ((entity entity)) entity)) + (:method ((entity entity)) nil)) (defun create-entity (class &rest initargs) - (entity-created (apply #'make-instance class initargs))) + (let ((entity (apply #'make-instance class initargs))) + (index-entity entity) + (index-entity-aspects entity) + (index-entity-systems entity) + (entity-created entity) + entity)) (defun destroy-entity (entity) (let ((id (entity-id entity))) - (remhash id *entity-index*) - (loop - :for index :being :the hash-values :of *aspect-index* - :do (remhash id index)) - (loop - :for argument-indexes :being :the hash-values :of *system-index* - :do (loop :for index :in argument-indexes - :do (remhash id index)))) - (entity-destroyed entity)) + (unindex-entity id) + (unindex-entity-aspects id) + (unindex-entity-systems id)) + (entity-destroyed entity) + entity) (defmacro define-entity (name aspects &rest slots) @@ -117,7 +127,6 @@ (when (not (hash-table-key-exists-p *aspect-index* name)) (setf (gethash name *aspect-index*) (make-hash-table)))) - (defmacro define-aspect (name &rest fields) (flet ((clean-field (f) (etypecase f @@ -155,22 +164,21 @@ :collect (make-hash-table)))) -(defun system-type-signature (arglist) - `(function (,@(mapcar (lambda (arg) - `(and entity ,@(cdr arg))) - arglist)) - (values null &optional))) +(defmacro define-system (name arglist &body body) + (flet ((system-type-signature (arglist) + `(function (,@(mapcar (lambda (arg) + `(and entity ,@(cdr arg))) + arglist)) + (values null &optional)))) + `(progn + (declaim (ftype ,(system-type-signature arglist) ,name)) + (defun ,name (,@(mapcar #'car arglist)) + ,@body + nil) -(defmacro define-system (name arglist &body body) - `(progn - (declaim (ftype ,(system-type-signature arglist) ,name)) - (defun ,name (,@(mapcar #'car arglist)) - ,@body - nil) + (initialize-system-index ',name #',name ',arglist) - (initialize-system-index ',name #',name ',arglist) - - ',name)) + ',name))) (defun run-system (system) diff -r 19f3ffd6181e -r dfc719d3ed02 package.lisp --- a/package.lisp Tue Aug 09 03:50:31 2016 +0000 +++ b/package.lisp Tue Aug 09 18:10:04 2016 +0000 @@ -6,6 +6,10 @@ #:entity #:entity-id + #:define-entity + + #:create-entity + #:destroy-entity #:get-entity #:map-entities #:clear-entities @@ -13,8 +17,6 @@ #:entity-created #:entity-destroyed - #:define-entity - #:define-aspect #:define-system