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