Make slot forms with minimal (quote)ing (resolves #6)

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."

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."

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

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)

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))