keith
/
wh-engine
1
1
Fork 0
Code Issues 6 Pull Requests Projects Releases Wiki Activity

(suspend) and (resume) pointer conversion (for #3)

This commit is contained in:
~keith 2021-12-14 22:09:44 +00:00
parent 74d2cdc890
commit b3a6fd3f78
Signed by: keith
GPG Key ID: 5BEBEEAB2C73D520
6 changed files with 111 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
wh-engine.asd
View File

@ -11,6 +11,7 @@
((:module "wh-engine"
:components ((:file "package")
(:file "main")
(:file "serialization")
(:file "actor")
(:file "component")
(:file "scene")

30
wh-engine/actor.lisp
View File

@ -14,7 +14,7 @@
:initform "")
(scene :documentation "The scene containing this actor."
:reader scene
:type (or weak-pointer null)
:type pointer
:initform nil)
(tags :documentation "This actor's tags."
:reader tags
@ -30,12 +30,12 @@
:initform nil)
(parent :documentation "This actor's parent."
:reader parent
:type (or weak-pointer null)
:type pointer
:initarg :parent
:initform nil)
(children :documentation "The actors this actor is a parent of."
:reader children
:type (proper-list weak-pointer)
:type (proper-list pointer)
:initform nil)
(components :documentation "The components attached to this actor."
:reader components
@ -181,6 +181,30 @@
(loop for component in [this components]
do [component (parent-activated this)]))
(defmethod resume ((this actor))
"Initialize or restore this actor's state."
; Restore self
(resume-setf [this :slot scene])
(resume-setf [this :slot parent])
(loop for entry on [this :slot children]
when (typep (car entry) 'id-ref)
do (rplaca entry (resume-ptr (car entry))))
; Restore components
(loop for component in [this components]
do [component (resume)]))
(defmethod suspend ((this actor))
"Prepare this actor for serialization."
; Suspend components
(loop for component in [this components]
do [component (suspend)])
; Suspend self
(loop for entry on [this :slot children]
when (typep (car entry) 'weak-pointer)
do (rplaca entry (suspend-ptr (car entry))))
(suspend-setf [this :slot scene])
(suspend-setf [this :slot parent]))
(defmethod update ((this actor))
"Update this actor's components."
(loop for component in [this components]

24
wh-engine/component.lisp
View File

@ -4,7 +4,7 @@
(defclass component ()
((actor :documentation "The actor this component belongs to."
:reader actor
:type (or weak-pointer null)
:type pointer
:initform nil)
(active-p :documentation "Whether or not this component is active."
:reader active-p
@ -54,8 +54,28 @@
"Activate this component."
(setf [this :slot active-p] t))
(defmethod resume ((this component))
"Initialize or restore this component's state."
(loop for slot in (sb-mop:class-slots (class-of this))
for slot-name = (sb-mop:slot-definition-name slot)
when (slot-boundp this slot-name)
do (let ((value (slot-value this slot-name)))
(when (typep value id-ref)
(setf (slot-value this slot-name) (resume-ptr value))))
))
(defmethod suspend ((this component))
"Prepare this component for serialization."
(loop for slot in (sb-mop:class-slots (class-of this))
for slot-name = (sb-mop:slot-definition-name slot)
when (slot-boundp this slot-name)
do (let ((value (slot-value this slot-name)))
(when (typep value weak-pointer)
(setf (slot-value this slot-name) (suspend-ptr value))))
))
(defmethod start ((this component))
"Called before on-update the first time this component is processed."
"Called before (update) the first time this component is processed."
(setf [this :slot started-p] t))
(defmethod update ((this component))

18
wh-engine/main.lisp
View File

@ -183,15 +183,15 @@
(update-all-scenes)
(gl:clear :color-buffer)
(let ((render-pass nil))
(loop for view-ptr in *world-views*
for view = (ensure-live (weak-pointer-value view-ptr))
when (and [view active-p] [view actor tree-active-p])
do (progn
(unless (eq [view render-pass] render-pass)
(setf render-pass [view render-pass])
(gl:clear :depth-buffer)
)
[view (render-view *world-drawables*)])))
(loop for view-ptr in *world-views*
for view = (ensure-live (weak-pointer-value view-ptr))
when (and [view active-p] [view actor tree-active-p])
do (progn
(unless (eq [view render-pass] render-pass)
(setf render-pass [view render-pass])
(gl:clear :depth-buffer)
)
[view (render-view *world-drawables*)])))
(gl:flush)
(sdl2:gl-swap-window win)))
))))

8
wh-engine/package.lisp
View File

@ -18,6 +18,12 @@
register-test-scene
run
;; serialization.lisp
id-ref make-id-ref
pointer
suspend-ptr resume-ptr
suspend-setf resume-setf
;; actor.lisp
actor
; properties
@ -33,6 +39,7 @@
has-tag add-tag remove-tag
parent-deactivated parent-activated parent-changed
deactivate activate
resume suspend
update
destroy
transform-point world-point local-point
@ -49,6 +56,7 @@
attach
parent-deactivated parent-activated parent-changed
deactivate activate
resume suspend
start update
destroy

44
wh-engine/serialization.lisp Normal file
View File

@ -0,0 +1,44 @@
;;;; 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))
(defun suspend-ptr (ptr)
"Convert weak-pointer ptr to an id-ref."
(declare (type weak-pointer ptr))
(let (target (weak-pointer-value ptr))
(cond
((typep target 'scene)
(make-id-ref :scene [target id]))
((typep target 'actor)
(make-id-ref :scene [target scene id]
:actor [target id]))
((typep target 'component)
(make-id-ref :scene [target scene id]
:actor [target actor id]
:component (class-name (class-of target))))
(t ptr))))
(defun resume-ptr (ref)
"Convert id-ref ref to a weak-pointer."
(declare (type id-ref ref))
(let ((scene (get-scene (id-ref-scene ref))) actor component)
(if (setf actor [scene (get-actor (id-ref-actor ref))])
(if (setf component [actor (get-component (find-class (id-ref-component ref)))])
(make-weak-pointer component)
(make-weak-pointer actor))
(make-weak-pointer scene))))
(defmacro suspend-setf (place)
`(when (typep ,place 'weak-pointer)
(setf ,place (suspend-ptr ,place))))
(defmacro resume-setf (place)
`(when (typep ,place 'id-ref)
(setf ,place (resume-ptr ,place))))