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

(defun replace-in-tree (tree atom-fun)
  (if (consp (car tree))
      (replace-in-tree (car tree) atom-fun)
      (rplaca tree (funcall atom-fun (car tree))))
  (if (consp (cdr tree))
      (replace-in-tree (cdr tree) atom-fun)
      (rplacd tree (funcall atom-fun (cdr tree))))
  tree)

(defun process-load-forms (obj table)
  (multiple-value-bind (cons-form init-form)
      (make-load-form obj)
    (let ((sym (gensym))
          (output-cons-forms ())
          (output-init-forms ()))
      (setf (gethash obj table) (cons sym cons-form))
      (replace-in-tree init-form (lambda (x)
                                   (cond
                                     ; x has already been processed
                                     ((gethash x table)
                                      (car (gethash x table)))
                                     ; x needs to be run through process-load-forms
                                     ((typep x '(or standard-object structure-object condition class))
                                      (multiple-value-bind (x-cons-forms x-init-forms x-sym)
                                          (process-load-forms x table)
                                        (setf output-cons-forms (nconc output-cons-forms x-cons-forms))
                                        (setf output-init-forms (nconc output-init-forms x-init-forms))
                                        x-sym))
                                     ; x is a type that doesn't need processing
                                     (t x))))
      (setf output-cons-forms (nconc output-cons-forms `((,sym ,cons-form))))
      (setf output-init-forms (nconc output-init-forms `(,init-form)))
      (values output-cons-forms output-init-forms sym))))

(defun generate-load-forms (obj)
  (multiple-value-bind (cons-forms init-forms sym)
      (process-load-forms obj (make-hash-table :test #'eq))
    `(let ,cons-forms
       ,@init-forms
       ,sym)))

(defun serialize-instance (obj)
  "Serialize obj into a Lisp expression that evaluates back to it."
  (let ((obj-sym (gensym)) forms)
    (setf forms `(let ((,obj-sym (make-instance ',(class-name (class-of obj)))))))
    ))

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