From 1a154a9a56acd7945e51a5ca7848ff492f5ff944 Mon Sep 17 00:00:00 2001
From: ~keith <keith@keithhacks.cyou>
Date: Tue, 4 Jan 2022 19:26:29 +0000
Subject: [PATCH] Make slot forms with minimal (quote)ing (resolves #6)

---
 wh-engine/actor.lisp         |  3 ++-
 wh-engine/component.lisp     |  3 ++-
 wh-engine/package.lisp       |  1 +
 wh-engine/scene.lisp         |  3 ++-
 wh-engine/serialization.lisp | 27 +++++++++++++++++++++++++++
 5 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/wh-engine/actor.lisp b/wh-engine/actor.lisp
index a3b58d5..265098b 100644
--- a/wh-engine/actor.lisp
+++ b/wh-engine/actor.lisp
@@ -73,7 +73,8 @@
   (:documentation "Base class for entities in the game."))
 
 (defmethod make-load-form ((this actor) &optional environment)
-  (make-load-form-saving-slots this :environment environment))
+  ;(make-load-form-saving-slots this :environment environment)
+  (make-generic-load-form this :environment environment))
 
 (defmethod scene ((this actor))
   "The scene containing this actor."
diff --git a/wh-engine/component.lisp b/wh-engine/component.lisp
index 8840668..5d9a6f7 100644
--- a/wh-engine/component.lisp
+++ b/wh-engine/component.lisp
@@ -18,7 +18,8 @@
   (:documentation "Base class for components attached to game entities."))
 
 (defmethod make-load-form ((this component) &optional environment)
-  (make-load-form-saving-slots this :environment environment))
+  ;(make-load-form-saving-slots this :environment environment)
+  (make-generic-load-form this :environment environment))
 
 (defmethod actor ((this component))
   "The actor this component belongs to."
diff --git a/wh-engine/package.lisp b/wh-engine/package.lisp
index 6d0d703..32139eb 100644
--- a/wh-engine/package.lisp
+++ b/wh-engine/package.lisp
@@ -24,6 +24,7 @@
    deref-sus-pointer
    referize pointerize
    referize-setf pointerize-setf
+   make-generic-load-form
    generate-load-forms
    dump-scene dump-actors
    load-resume-scene load-resume-actors
diff --git a/wh-engine/scene.lisp b/wh-engine/scene.lisp
index 65deb1d..b30075c 100644
--- a/wh-engine/scene.lisp
+++ b/wh-engine/scene.lisp
@@ -23,7 +23,8 @@
   (:documentation "A scene containing game entities."))
 
 (defmethod make-load-form ((this scene) &optional environment)
-  (make-load-form-saving-slots this :environment environment))
+  ;(make-load-form-saving-slots this :environment environment)
+  (make-generic-load-form this :environment environment))
 
 (defmethod print-object ((this scene) stream)
   (print-unreadable-object (this stream :type t :identity t)
diff --git a/wh-engine/serialization.lisp b/wh-engine/serialization.lisp
index cfe3c43..f58eb9e 100644
--- a/wh-engine/serialization.lisp
+++ b/wh-engine/serialization.lisp
@@ -159,6 +159,33 @@
                            x)))
     ))
 
+(defun make-generic-load-form (obj &key environment)
+  "Make a generic load form that works for most objects."
+  (declare (ignore environment))
+  (values
+   ;; cons form
+   `(sb-kernel::new-instance ,(class-name (class-of obj)))
+   ;; init form
+   (loop for slot in (sb-mop:class-slots (class-of obj))
+         for slot-name = (sb-mop:slot-definition-name slot)
+         collect slot-name into slots
+         collect (make-value-init-form (slot-value obj slot-name))
+           into values
+         finally (return `(sb-pcl::set-slots ,obj ,slots ,@values)))
+   ))
+
+(defun make-value-init-form (x)
+  (typecase x
+    ;; One case for both T and NIL/()
+    (boolean x)
+    ;; this will fail with circular lists. don't serialize circular lists.
+    (list (if (cdr (last x))
+              `(cons ,(make-value-init-form (car x))
+                     ,(make-value-init-form (cdr x)))
+              (cons 'list (loop for y in x collect (make-value-init-form y)))))
+    (symbol `(quote ,x))
+    (t x)))
+
 (defun generate-load-forms (obj &key (prune t) (nice-syms nil))
   "Generate code that restores the current state of obj."
   (declare (type boolean prune nice-syms))