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

nice-syms option in (generate-load-forms)

Browse source
This commit is contained in:
~keith 2021-12-15 18:38:26 +00:00
parent 62ace0204e
commit ea2d68ba57
Signed by: keith
GPG key ID: 5BEBEEAB2C73D520
1 changed files with 18 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
wh-engine/serialization.lisp
View file

@ -13,13 +13,13 @@
(declare (type weak-pointer ptr))
(let ((target (weak-pointer-value ptr)))
(cond
((typep target 'scene)
(typecase target
(scene
(make-id-ref :scene [target id]))
((typep target 'actor)
(actor
(make-id-ref :scene [target scene id]
:actor [target id]))
((typep target 'component)
(component
(make-id-ref :scene [target scene id]
:actor [target actor id]
:component (class-name (class-of target))))
@ -68,11 +68,20 @@
(setf new-cdr (funcall atom-fun new-cdr)))
(cons new-car new-cdr)))
(defun process-load-forms (obj table)
(defun process-load-forms (obj table &key (nice-syms nil))
"Update table with the forms necessary to generate obj."
(multiple-value-bind (cons-form init-form)
(make-load-form obj)
(let ((sym (gensym)))
(let ((sym (if nice-syms
(typecase obj
(scene (gensym (format nil "S~a-G" [obj :slot id])))
(actor (gensym (format nil "A~a-G" [obj :slot id])))
(component (gensym (if (typep [obj :slot actor] 'id-ref)
(format nil "C~a-~a-G"
(id-ref-actor [obj :slot actor]) (class-name (class-of obj)))
(format nil "C-~a-G" (class-name (class-of obj))))))
(t (gensym)))
(gensym))))
(setf (gethash obj table) (cons sym (cons cons-form nil)))
(when init-form
(setf init-form
@ -89,7 +98,7 @@
:component ,(id-ref-component x)))
;; x needs to be run through process-load-forms
((typep x '(or standard-object structure-object condition class))
(process-load-forms x table))
(process-load-forms x table :nice-syms nice-syms))
;; x doesn't need processing
(t x)))))
(setf (gethash obj table) (cons sym (cons cons-form init-form))))
@ -134,14 +143,14 @@
x)))
))
(defun generate-load-forms (obj &key (prune t))
(defun generate-load-forms (obj &key (prune t) (nice-syms nil))
"Generate code that restores the current state of obj."
(declare (type boolean prune))
(let ((table (make-hash-table :test #'eq))
sym init-forms)
;; serialize
(setf sym (process-load-forms obj table))
(setf sym (process-load-forms obj table :nice-syms nice-syms))
;; collect init-forms
(setf init-forms (loop for entry being each hash-value in table
when (cddr entry)