new! object instantiation macro (resolves #10)
This commit is contained in:
parent
38447b2c7e
commit
8d70a235db
GPG Key ID:
5BEBEEAB2C73D520
|
|
@ -10,11 +10,13 @@
|
|||
:components
|
||||
((:module "wh-engine"
|
||||
:components ((:file "package")
|
||||
(:file "main")
|
||||
(:file "global")
|
||||
(:file "serialization")
|
||||
(:file "actor")
|
||||
(:file "component")
|
||||
(:file "actor-macros")
|
||||
(:file "scene")
|
||||
(:file "render/drawable")
|
||||
(:file "render/view"))
|
||||
(:file "render/view")
|
||||
(:file "main"))
|
||||
)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,66 @@
|
|||
;;;; 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))
|
||||
|#
|
||||
|
|
@ -0,0 +1,157 @@
|
|||
;;;; wh-engine/global.lisp
|
||||
;;;; global variables and utility functions
|
||||
(in-package wh-engine)
|
||||
|
||||
;; FIXME this should be a defconst
|
||||
(defvar +version+ (list 0 1 0)
|
||||
"Engine version.")
|
||||
|
||||
(defun ensure-version (expected-version)
|
||||
"Ensure this version of wh-engine is compatible with the expected version."
|
||||
(if (= (nth 0 +version+) 0)
|
||||
(unless (equal +version+ expected-version)
|
||||
(error "engine version ~S incompatible with expected-version ~S (pre-1.0 mismatch)"
|
||||
+version+ expected-version))
|
||||
(progn
|
||||
(unless (= (nth 0 +version+) (nth 0 expected-version))
|
||||
(error "engine version ~S incompatible with expected-version ~S (major-version mismatch)"
|
||||
+version+ expected-version))
|
||||
(unless (>= (nth 1 +version+) (nth 1 expected-version))
|
||||
(error "engine version ~S incompatible with expected-version ~S (minor-version too low)"
|
||||
+version+ expected-version))
|
||||
(unless (equal +version+ expected-version)
|
||||
(warn "engine version ~S differs from expected-version ~S, but is still compatible"
|
||||
+version+ expected-version)))))
|
||||
|
||||
(declaim (inline deref-pointer))
|
||||
(defun deref-pointer (ptr)
|
||||
"Dereference ptr if it's non-nil."
|
||||
(declare (type (or weak-pointer null) ptr))
|
||||
(when ptr (weak-pointer-value ptr)))
|
||||
|
||||
(defun points-to (ptr obj)
|
||||
"Return true if ptr points to obj."
|
||||
(declare (type weak-pointer ptr))
|
||||
|
||||
(eq (weak-pointer-value ptr) obj))
|
||||
|
||||
(defun ensure-live (obj)
|
||||
"Ensure obj is live (non-destroyed)."
|
||||
(when (o! obj destroyed-p)
|
||||
(error "~S was used after it was destroyed" obj))
|
||||
obj)
|
||||
|
||||
(declaim (inline vxy1))
|
||||
(defun vxy1 (vector)
|
||||
"Convert vector to a vec3, with a Z component of 1."
|
||||
(declare (type vec2 vector))
|
||||
(vec3 (vx2 vector) (vy2 vector) 1))
|
||||
|
||||
(declaim (inline vxy-trunc))
|
||||
(defun vxy-trunc (vector)
|
||||
"Convert vector to a vec2 and truncate its X and Y components to the nearest integer."
|
||||
(declare (type vec3 vector))
|
||||
(vec2 (ftruncate (vx3 vector)) (ftruncate (vy3 vector))))
|
||||
|
||||
(defun opengl-matrix (matrix)
|
||||
(declare (type mat3 matrix))
|
||||
(with-fast-matref (m matrix 3)
|
||||
(make-array '(16) :initial-contents
|
||||
`(,(m 0 0) ,(m 0 1) 0.0 ,(m 0 2)
|
||||
,(m 1 0) ,(m 1 1) 0.0 ,(m 1 2)
|
||||
0.0 0.0 1.0 0.0
|
||||
,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
|
||||
)))
|
||||
|
||||
(defvar *id-counter* 0
|
||||
"Counter for assigning unique IDs.")
|
||||
|
||||
(defun make-id ()
|
||||
"Return a unique ID."
|
||||
(setf *id-counter* (+ *id-counter* 1)))
|
||||
|
||||
(defun fixed-id (id)
|
||||
"Ensure the given ID won't be returned by make-id."
|
||||
(declare (type fixnum id))
|
||||
|
||||
(when (>= id *id-counter*)
|
||||
(setf *id-counter* (+ id 1)))
|
||||
id)
|
||||
|
||||
(defstruct id-ref
|
||||
(scene 0 :type fixnum)
|
||||
(actor nil :type (or fixnum null))
|
||||
(component nil :type (or symbol null)))
|
||||
|
||||
(deftype pointer () '(or id-ref weak-pointer null))
|
||||
|
||||
(declaim (inline deref-sus-pointer))
|
||||
(defun deref-sus-pointer (val)
|
||||
"Dereference val, and warn if it's suspended."
|
||||
(declare (type pointer val))
|
||||
(etypecase val
|
||||
(weak-pointer (weak-pointer-value val))
|
||||
(id-ref (warn "dereferencing sus pointer ~S" val)
|
||||
(weak-pointer-value (pointerize val)))
|
||||
(null nil)))
|
||||
|
||||
(defun referize (ptr)
|
||||
"Convert ptr into an id-ref."
|
||||
|
||||
(let ((target (etypecase ptr
|
||||
(weak-pointer (weak-pointer-value ptr))
|
||||
((or scene actor component) ptr))))
|
||||
(etypecase target
|
||||
(scene
|
||||
(make-id-ref :scene (o! target id)))
|
||||
(actor
|
||||
(make-id-ref :scene (etypecase (o! target :slot scene)
|
||||
(weak-pointer (o! target scene id))
|
||||
(id-ref (id-ref-scene (o! target :slot scene))))
|
||||
:actor (o! target id)))
|
||||
(component
|
||||
(make-id-ref :scene (etypecase (o! target :slot actor)
|
||||
(weak-pointer (o! target scene id))
|
||||
(id-ref (id-ref-scene (o! target :slot actor))))
|
||||
:actor (etypecase (o! target :slot actor)
|
||||
(weak-pointer (o! target actor id))
|
||||
(id-ref (id-ref-actor (o! target :slot actor))))
|
||||
:component (class-name (class-of target))))
|
||||
)))
|
||||
|
||||
(defun dereferize (ref)
|
||||
"Return the object specified by id-ref ref."
|
||||
(declare (type id-ref ref))
|
||||
|
||||
(let ((scene (get-scene (id-ref-scene ref))) actor component)
|
||||
(unless scene
|
||||
(error "can't dereferize ~S (scene not found)" ref))
|
||||
(if (id-ref-actor ref)
|
||||
(if (setf actor (o! scene (get-actor (id-ref-actor ref))))
|
||||
(if (id-ref-component ref)
|
||||
(if (setf component (o! actor (get-component (find-class (id-ref-component ref)))))
|
||||
component
|
||||
(error "can't dereferize ~S (component not found)" ref))
|
||||
actor)
|
||||
(error "can't dereferize ~S (actor not found)" ref))
|
||||
scene)))
|
||||
|
||||
(defun pointerize (ref)
|
||||
"Convert id-ref ref into a weak-pointer."
|
||||
(declare (type id-ref ref))
|
||||
|
||||
(make-weak-pointer (dereferize ref)))
|
||||
|
||||
(defmacro referize-setf (place)
|
||||
`(when (typep ,place 'weak-pointer)
|
||||
(setf ,place (referize ,place))))
|
||||
(defmacro pointerize-setf (place)
|
||||
`(when (typep ,place 'id-ref)
|
||||
(setf ,place (pointerize ,place))))
|
||||
|
||||
(defvar *world-scenes* ()
|
||||
"List of all running scenes.")
|
||||
|
||||
(defun get-scene (scene-id)
|
||||
"Get a scene by its ID."
|
||||
(find-if (lambda (scene) (eq (o! scene id) scene-id)) *world-scenes*))
|
||||
|
|
@ -1,85 +1,6 @@
|
|||
;;;; wh-engine/main.lisp
|
||||
(in-package wh-engine)
|
||||
|
||||
;; FIXME this should be a defconst
|
||||
(defvar +version+ (list 0 1 0)
|
||||
"Engine version.")
|
||||
|
||||
(defun ensure-version (expected-version)
|
||||
"Ensure this version of wh-engine is compatible with the expected version."
|
||||
(if (= (nth 0 +version+) 0)
|
||||
(unless (equal +version+ expected-version)
|
||||
(error "engine version ~S incompatible with expected-version ~S (pre-1.0 mismatch)"
|
||||
+version+ expected-version))
|
||||
(progn
|
||||
(unless (= (nth 0 +version+) (nth 0 expected-version))
|
||||
(error "engine version ~S incompatible with expected-version ~S (major-version mismatch)"
|
||||
+version+ expected-version))
|
||||
(unless (>= (nth 1 +version+) (nth 1 expected-version))
|
||||
(error "engine version ~S incompatible with expected-version ~S (minor-version too low)"
|
||||
+version+ expected-version))
|
||||
(unless (equal +version+ expected-version)
|
||||
(warn "engine version ~S differs from expected-version ~S, but is still compatible"
|
||||
+version+ expected-version)))))
|
||||
|
||||
(declaim (inline deref-pointer))
|
||||
(defun deref-pointer (ptr)
|
||||
"Dereference ptr if it's non-nil."
|
||||
(declare (type (or weak-pointer null) ptr))
|
||||
(when ptr (weak-pointer-value ptr)))
|
||||
|
||||
(defun points-to (ptr obj)
|
||||
"Return true if ptr points to obj."
|
||||
(declare (type weak-pointer ptr))
|
||||
|
||||
(eq (weak-pointer-value ptr) obj))
|
||||
|
||||
(defun ensure-live (obj)
|
||||
"Ensure obj is live (non-destroyed)."
|
||||
(when (o! obj destroyed-p)
|
||||
(error "~S was used after it was destroyed" obj))
|
||||
obj)
|
||||
|
||||
(declaim (inline vxy1))
|
||||
(defun vxy1 (vector)
|
||||
"Convert vector to a vec3, with a Z component of 1."
|
||||
(declare (type vec2 vector))
|
||||
(vec3 (vx2 vector) (vy2 vector) 1))
|
||||
|
||||
(declaim (inline vxy-trunc))
|
||||
(defun vxy-trunc (vector)
|
||||
"Convert vector to a vec2 and truncate its X and Y components to the nearest integer."
|
||||
(declare (type vec3 vector))
|
||||
(vec2 (ftruncate (vx3 vector)) (ftruncate (vy3 vector))))
|
||||
|
||||
(defun opengl-matrix (matrix)
|
||||
(declare (type mat3 matrix))
|
||||
(with-fast-matref (m matrix 3)
|
||||
(make-array '(16) :initial-contents
|
||||
`(,(m 0 0) ,(m 0 1) 0.0 ,(m 0 2)
|
||||
,(m 1 0) ,(m 1 1) 0.0 ,(m 1 2)
|
||||
0.0 0.0 1.0 0.0
|
||||
,(m 2 0) ,(m 2 1) 0.0 ,(m 2 2))
|
||||
)))
|
||||
|
||||
(defvar *id-counter* 0
|
||||
"Counter for assigning unique IDs.")
|
||||
|
||||
(defun make-id ()
|
||||
"Return a unique ID."
|
||||
(setf *id-counter* (+ *id-counter* 1)))
|
||||
|
||||
(defun fixed-id (id)
|
||||
"Ensure the given ID won't be returned by make-id."
|
||||
(declare (type fixnum id))
|
||||
|
||||
(when (>= id *id-counter*)
|
||||
(setf *id-counter* (+ id 1)))
|
||||
id)
|
||||
|
||||
(defvar *world-scenes* ()
|
||||
"List of all running scenes.")
|
||||
|
||||
(defun add-scene (scene)
|
||||
"Add a scene to the list of running scenes."
|
||||
(declare (type scene scene))
|
||||
|
|
@ -94,10 +15,6 @@
|
|||
(setf *world-scenes* (remove scene *world-scenes*))
|
||||
scene)
|
||||
|
||||
(defun get-scene (scene-id)
|
||||
"Get a scene by its ID."
|
||||
(find-if (lambda (scene) (eq (o! scene id) scene-id)) *world-scenes*))
|
||||
|
||||
(defun initialize-actors-in (scene &rest actors)
|
||||
"Properly attach actors and their descendents to scene, and initialize them."
|
||||
(loop for actor in actors
|
||||
|
|
@ -127,62 +44,36 @@
|
|||
(defvar *world-views* nil
|
||||
"List of all known views.")
|
||||
|
||||
(defvar *delta-time* 0.0
|
||||
"Time in seconds since the last game tick.")
|
||||
|
||||
(defun register-test-scene ()
|
||||
(let (test-scene test-actor test-drawable test-actor-2 camera-actor camera-view child-actor grandchild-actor)
|
||||
(setf test-scene (make-instance 'scene
|
||||
:id -1
|
||||
:name "Test scene"))
|
||||
(let ((test-scene (new! scene :id -1 :name "Test scene")))
|
||||
(add-scene test-scene)
|
||||
|
||||
(setf test-actor (make-instance 'actor
|
||||
:name "Actor"))
|
||||
;; (o! test-scene (add-actor test-actor))
|
||||
|
||||
(setf test-drawable (make-instance 'drawable-test))
|
||||
(o! test-actor (add-component test-drawable))
|
||||
|
||||
(setf test-actor-2 (make-instance 'actor
|
||||
:name "Actor 2"
|
||||
:location (vec2 0.5 0.5)
|
||||
:rotation (coerce (/ pi 4) 'single-float)
|
||||
:z-layer -1))
|
||||
;; (o! test-scene (add-actor test-actor-2))
|
||||
|
||||
(o! test-actor-2 (add-component (make-instance 'drawable-test
|
||||
:colour (vec4 0.0 1.0 0.0 1.0))))
|
||||
|
||||
(setf child-actor (make-instance 'actor
|
||||
:name "Child Actor"
|
||||
:location (vec2 0 0.5)
|
||||
:z-layer -2))
|
||||
;; (o! test-scene (add-actor child-actor))
|
||||
(o! test-actor-2 (add-child child-actor))
|
||||
|
||||
(o! child-actor (add-component (make-instance 'drawable-test
|
||||
:colour (vec4 0.0 1.0 1.0 1.0))))
|
||||
|
||||
(setf grandchild-actor (make-instance 'actor
|
||||
:name "Grandchild Actor"
|
||||
:location (vec2 0 1)
|
||||
:scale (vec2 0.25 0.25)
|
||||
:z-layer 1))
|
||||
;; (o! test-scene (add-actor grandchild-actor))
|
||||
(o! child-actor (add-child grandchild-actor))
|
||||
|
||||
(o! grandchild-actor (add-component (make-instance 'drawable-test
|
||||
:colour (vec4 1.0 1.0 0.0 0.0))))
|
||||
|
||||
(setf camera-actor (make-instance 'actor
|
||||
:name "Camera"))
|
||||
;; (o! test-scene (add-actor camera-actor))
|
||||
|
||||
(setf camera-view (make-instance 'view))
|
||||
(o! camera-actor (add-component camera-view))
|
||||
|
||||
;;(sb-ext:gc)
|
||||
(initialize-actors-in test-scene
|
||||
test-actor test-actor-2 camera-actor)
|
||||
|
||||
(new! actor
|
||||
:name "Actor"
|
||||
:component (new! drawable-test))
|
||||
(new! actor
|
||||
:name "Actor 2"
|
||||
:location (vec2 0.5 0.5)
|
||||
:rotation (coerce (/ pi 4) 'single-float)
|
||||
:z-layer -1
|
||||
:component (new! drawable-test :colour (vec4 0 1 0 1))
|
||||
:child (new! actor
|
||||
:name "Child Actor"
|
||||
:location (vec2 0 0.5)
|
||||
:z-layer -2
|
||||
:component (new! drawable-test :colour (vec4 0 1 1 1))
|
||||
:child (new! actor
|
||||
:name "Grandchild Actor"
|
||||
:location (vec2 0 1)
|
||||
:scale (vec2 0.25 0.25)
|
||||
:z-layer 1
|
||||
:component (new! drawable-test :colour (vec4 1 1 0 1)))))
|
||||
(new! actor
|
||||
:name "Camera"
|
||||
:component (new! view)))
|
||||
test-scene))
|
||||
|
||||
(defun run ()
|
||||
|
|
@ -203,7 +94,11 @@
|
|||
(renderbuf (gl:gen-renderbuffer))
|
||||
(render-texture (gl:gen-texture))
|
||||
(win-width (nth-value 0 (sdl2:get-window-size win)))
|
||||
(win-height (nth-value 1 (sdl2:get-window-size win))))
|
||||
(win-height (nth-value 1 (sdl2:get-window-size win)))
|
||||
(prev-tick (sdl2:get-ticks))
|
||||
(this-tick (sdl2:get-ticks))
|
||||
(prev-profiling-tick (sdl2:get-performance-counter))
|
||||
(profiling-scale (/ (sdl2:get-performance-frequency) 1000.0)))
|
||||
;; set up framebuffer
|
||||
(gl:bind-framebuffer :framebuffer framebuf)
|
||||
|
||||
|
|
@ -244,9 +139,16 @@
|
|||
(sdl2:with-event-loop (:method :poll)
|
||||
(:quit () t)
|
||||
(:idle ()
|
||||
(setf prev-profiling-tick (sdl2:get-performance-counter))
|
||||
;; calculate delta-time
|
||||
(setf this-tick (sdl2:get-ticks))
|
||||
(setf *delta-time* (* (- this-tick prev-tick) 0.001))
|
||||
(setf prev-tick this-tick)
|
||||
(format t "Δt = ~S (~S FPS)~%" *delta-time* (/ 1.0 *delta-time*))
|
||||
;; update
|
||||
(loop for scene in *world-scenes*
|
||||
do (o! scene (update)))
|
||||
(format t "game=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
|
||||
;; draw to render texture
|
||||
(gl:bind-framebuffer :framebuffer framebuf)
|
||||
(gl:viewport 0 0 *view-width* *view-height*)
|
||||
|
|
@ -261,6 +163,8 @@
|
|||
(setf render-pass (o! view render-pass))
|
||||
(gl:clear :depth-buffer))
|
||||
(o! view (render-view *world-drawables*)))))
|
||||
(gl:flush)
|
||||
(format t "draw=~S " (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
|
||||
|
||||
;; now draw to window
|
||||
(gl:bind-framebuffer :framebuffer 0)
|
||||
|
|
@ -272,7 +176,7 @@
|
|||
(gl:matrix-mode :modelview)
|
||||
(gl:load-identity)
|
||||
|
||||
(gl:with-primitive :quads
|
||||
(gl:with-primitives :quads
|
||||
(gl:color 1.0 1.0 1.0 1.0)
|
||||
(gl:tex-coord 0.0 0.0)
|
||||
(gl:vertex 0.0 0.0)
|
||||
|
|
@ -286,5 +190,6 @@
|
|||
(gl:disable :texture-2d)
|
||||
|
||||
(gl:flush)
|
||||
(format t "blit=~S~%" (/ (- (sdl2:get-performance-counter) prev-profiling-tick) profiling-scale))
|
||||
(sdl2:gl-swap-window win)))
|
||||
)))))
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@
|
|||
*view-width* *view-height* *view-ppu* *pixel-scale*
|
||||
register-test-scene
|
||||
run
|
||||
*delta-time*
|
||||
|
||||
;; serialization.lisp
|
||||
id-ref make-id-ref
|
||||
|
|
@ -68,6 +69,10 @@
|
|||
start update
|
||||
destroy
|
||||
|
||||
;; actor-macros.lisp
|
||||
new!
|
||||
define-new!-impl
|
||||
|
||||
;; scene.lisp
|
||||
scene
|
||||
; properties
|
||||
|
|
|
|||
|
|
@ -1,77 +1,6 @@
|
|||
;;;; wh-engine/serialization.lisp
|
||||
(in-package wh-engine)
|
||||
|
||||
(defstruct id-ref
|
||||
(scene 0 :type fixnum)
|
||||
(actor nil :type (or fixnum null))
|
||||
(component nil :type (or symbol null)))
|
||||
|
||||
(deftype pointer () '(or id-ref weak-pointer null))
|
||||
|
||||
(declaim (inline deref-sus-pointer))
|
||||
(defun deref-sus-pointer (val)
|
||||
"Dereference val, and warn if it's suspended."
|
||||
(declare (type pointer val))
|
||||
(etypecase val
|
||||
(weak-pointer (weak-pointer-value val))
|
||||
(id-ref (warn "dereferencing sus pointer ~S" val)
|
||||
(weak-pointer-value (pointerize val)))
|
||||
(null nil)))
|
||||
|
||||
(defun referize (ptr)
|
||||
"Convert ptr into an id-ref."
|
||||
|
||||
(let ((target (etypecase ptr
|
||||
(weak-pointer (weak-pointer-value ptr))
|
||||
((or scene actor component) ptr))))
|
||||
(etypecase target
|
||||
(scene
|
||||
(make-id-ref :scene (o! target id)))
|
||||
(actor
|
||||
(make-id-ref :scene (etypecase (o! target :slot scene)
|
||||
(weak-pointer (o! target scene id))
|
||||
(id-ref (id-ref-scene (o! target :slot scene))))
|
||||
:actor (o! target id)))
|
||||
(component
|
||||
(make-id-ref :scene (etypecase (o! target :slot actor)
|
||||
(weak-pointer (o! target scene id))
|
||||
(id-ref (id-ref-scene (o! target :slot actor))))
|
||||
:actor (etypecase (o! target :slot actor)
|
||||
(weak-pointer (o! target actor id))
|
||||
(id-ref (id-ref-actor (o! target :slot actor))))
|
||||
:component (class-name (class-of target))))
|
||||
)))
|
||||
|
||||
(defun dereferize (ref)
|
||||
"Return the object specified by id-ref ref."
|
||||
(declare (type id-ref ref))
|
||||
|
||||
(let ((scene (get-scene (id-ref-scene ref))) actor component)
|
||||
(unless scene
|
||||
(error "can't dereferize ~S (scene not found)" ref))
|
||||
(if (id-ref-actor ref)
|
||||
(if (setf actor (o! scene (get-actor (id-ref-actor ref))))
|
||||
(if (id-ref-component ref)
|
||||
(if (setf component (o! actor (get-component (find-class (id-ref-component ref)))))
|
||||
component
|
||||
(error "can't dereferize ~S (component not found)" ref))
|
||||
actor)
|
||||
(error "can't dereferize ~S (actor not found)" ref))
|
||||
scene)))
|
||||
|
||||
(defun pointerize (ref)
|
||||
"Convert id-ref ref into a weak-pointer."
|
||||
(declare (type id-ref ref))
|
||||
|
||||
(make-weak-pointer (dereferize ref)))
|
||||
|
||||
(defmacro referize-setf (place)
|
||||
`(when (typep ,place 'weak-pointer)
|
||||
(setf ,place (referize ,place))))
|
||||
(defmacro pointerize-setf (place)
|
||||
`(when (typep ,place 'id-ref)
|
||||
(setf ,place (pointerize ,place))))
|
||||
|
||||
(defun replace-in-tree (tree atom-fun)
|
||||
(if (consp (car tree))
|
||||
(replace-in-tree (car tree) atom-fun)
|
||||
|
|
|
|||
Loading…
Reference in New Issue