47 lines
1.7 KiB
Common Lisp
47 lines
1.7 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)
|
|
(declare (ignore class))
|
|
(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))))
|