Component-based programming framework in Common Lisp. Incomplete.

components.lisp

;;;Notes:
;;;Altered message-sending code so that the function associated with message recieves as first argument the recieving component, then the passed arguments from sender.
;;;Also, need to think about issues of components that purely hold data and how they communicate it to other components. Right now, they have to broadcast it every tick(or whatever), which probably causes some overhead.
;;;Lastly, need to actually do some tests.

(defclass component ()
	((parent :initarg parent :accessor parent) ;reference to the entity to which the component belongs
	(message-responses :initform (make-hash-table) :accessor message-responses))) ;should hold functions that are called when various messages are recieved.

(defclass entity ()
	((components :initform nil :accessor components)))

(defgeneric component-message (component message arguments)
	(:documentation "Send message to component with arguments. Generic so you can define your own logic for message-sending if you want, although that really isn't necessary"))

(defmethod component-message ((component component) message arguments)
	(when (gethash message (message-responses component))
		(apply (gethash message (message-responses component)) (push component arguments))))

(defgeneric entity-message (entity message argument)
	(:documentation "Send message to all components of entity with argument. See documentation for component-message"))
	
(defmethod entity-message ((entity entity) message arguments)
	(dolist (component (components entity))
		(component-message component message arguments)))

(defgeneric add-component (entity component)
	(:documentation "Add the component to the entity. Generic, like always, so your special snowflake component/entity types can do additional logic here. Although having special entity types really is against the priciple of component-oriented design, but I'm off on a tangent."))

(defmethod add-component ((entity entity) (component component)) ;that argument list is really weird/hard to understand at first sight. And we've got a lot of them. Might wanna do something about.
	(push component (components entity))
	(setf (parent component) entity))
	
(defgeneric subscribe-message (component message fn)
	(:documentation "Add the function fn as the response for the given component to the given message"))

(defmethod subscribe-message ((component component) message fn)
	(setf (gethash message (message-responses component)) fn))

(defgeneric broadcast-message (component message arguments)
	(:documentation "Send the specified message to the entity that the specified component belongs to"))

(defmethod broadcast-message ((component component) message arguments)
	(entity-message (parent component) message arguments))

;;Define a class of components.
;;Name becomes the name of the class
;;Keywords should be a list, which is spliced into the slot specifier for message-responses in the component class.
;;Each of the forms in responses should be of the form (name (arguments*) body*), where name is the name of the message that will provoke the given response, and arguments and body become the argument list and body of the function used to generate the response.

(defmacro defcomponent (name keywords &body responses)
	`(progn 
		(defclass ,name (component)
			((message-responses ,@keywords)))
		(defmethod initialize-instance :after ((component ,name) &key)
			,@(loop for response in responses collecting `(subscribe-message component ',(first response) (lambda ,@(rest response)))))))

(defmacro defentity (name keywords &body components) ;Like defcomponent, really. Each form in components must return a component when evaluated.
	`(progn
		(defclass ,name (entity)
			((components ,@keywords)))
		(defmethod initialize-instance :after ((entity ,name) &key)
			(setf (components entity) (loop for component in ,components collecting (eval component))))))