wh-engine/wh-engine/actor-macros.lisp

67 lines
2.4 KiB
Common Lisp

;;;; wh-engine/actor-macros.lisp
(in-package wh-engine)
(defvar *new!-impl-alist* ()
"Alist of special implementations for new!")
(defmacro define-new!-impl (class (class-var it-var params-var) &body body)
"Define a special implementation for new!, which returns (values other-forms make-params)."
`(push (cons (find-class ',class)
(lambda (,class-var ,it-var ,params-var) ,@body))
*new!-impl-alist*))
(defmacro new! (class &rest params &key &allow-other-keys)
"Create a new instance of class, as specified by params."
(let ((impl (cdr (assoc-if (lambda (x) (subtypep x class)) *new!-impl-alist*)))
(it (gensym)))
(if impl
(multiple-value-bind (other-forms make-params)
(funcall impl class it params)
`(let ((,it (make-instance ',class ,@make-params))) ,@other-forms ,it))
`(make-instance ',class ,@params))
))
(define-new!-impl actor (class it params)
(declare (ignore class))
(loop for (key value) on params by #'cddr
if (eq key :component)
collect `(o! ,it (add-component ,value)) into other-forms
else
if (eq key :child)
collect `(o! ,it (add-child ,value)) into other-forms
else
if (eq key :parent)
collect `(o! ,value (add-child ,it)) into other-forms
else
nconc `(,key ,value) into make-params
finally (return (values other-forms make-params))))
#|
(define-new!-impl component (class it params)
(loop for (key value) on params by #'cddr
if (eq key :actor)
collect `(o! ,value (add-component ,it)) into other-forms
else
nconc `(,key ,value) into make-params
finally (return (values other-forms make-params))))
|#
#|
(defmacro actor! (class &rest params &key &allow-other-keys)
(let* ((cons-form `(make-instance ',class))
(it (gensym))
(other-forms
(loop for (key value) on params by #'cddr
if (eq key :component)
collect `(o! ,it (add-component ,value))
else
if (eq key :child)
collect `(o! ,it (add-child ,value))
else
do (nconc cons-form `(,key ,value)))))
`(let ((,it ,cons-form)) ,@other-forms ,it)))
(defmacro component! (class &rest params &key &allow-other-keys)
`(make-instance ',class ,@params))
|#