;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: ao-display.lsp
;;;;    System: BotE/FIRE 
;;;;    Author: Praveen Paritosh
;;;;   Created: June 5, 2002 12:10:37
;;;;   Purpose: Displaying the AND/OR graph 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Friday, April 16, 2004 at 15:38:18 by paritosh
;;;; ---------------------------------------------------------------------------

(in-package :fire)

(defun make-link (label start-indx end-indx vertices-list vertices text-color 
                        &key (thickness 0) (style :solid) (edge-color cg:black))
  ;; start and end are indices into my list vertices-list - rather than 
  ;;  having to write out all the vertex data again
  (let ((start (nth start-indx vertices-list))
        (end (nth end-indx vertices-list)))
    (zgraph:make-edge :element-label label
                      :element-data (list label start end)
                      :directed-edge? t
                      :edge-style style
                      :edge-thickness thickness
                      :text-color text-color
                      :curve-color edge-color
                      :edge-origin (find start vertices :key #'zgraph:element-data) 
                      :edge-terminus (find end vertices :key #'zgraph:element-data))))

(defun make-vertices (vertex-list)
  (mapcar #'(lambda (elem)
              (zgraph:make-vertex :vertex-type 'sample-vertex
                                  :element-label elem
                                  :element-data elem))))

(defun make-ao-graph (ao-tree)
  (let ((vertices (make-vertices (list (form (root-node ao-tree)))))
        (edges nil))
    (

(defun display-ao-graph (ao-graph)
  (let ((g (make-ao-zgraph ao-graph)))
    (run-zpane g)))

;; Until Shawn provides another function, this is run-zpane-sample
(defun run-zpane (g &key (layout-style :rooted-tree-layout))
  (let ((win (cg:make-window :zpane-sample :class 'zpane::zpane-sample-window)))
    (zpane::set-zgraph-pane-graph (cg:frame-child win) g :layout-style layout-style)
    (zgraph::in-current-zpane win)
    win))


(defun make-ao-zgraph (ao-graph)
  (let* ((vertex-table (make-vertex-table ao-graph))
         (vertex-list (list-vals-of-table vertex-table))
         (edges (make-ao-graph-edges (start-node ao-graph) vertex-table ao-graph))
         (graph-name (format nil "~A" (name (start-node ao-graph)))))
    (gos:make-graph graph-name
                    :graph-type 'gos:directed-graph
                    :initial-vertices vertex-list
                    :initial-edges *edges*)))

(defun list-keys-of-table (ht)
  (let ((keys nil))
    (maphash #'(lambda (key val)
                 (push key keys)) ht)
    (values keys)))

(defun list-vals-of-table (ht)
  (let ((vals nil))
    (maphash #'(lambda (key val)
                 (push val vals)) ht)
    (values vals)))

(defun make-vertex-table (ao-graph)
  "For each of the nodes in the ao-graph, makes a zgraph vertex
   object, and then pushes these all into a hash table that 
   maps from the nodes to the zgraph vertex objects. The hash 
   table is returned back"
  (let ((vertex-table (make-hash-table :test 'equal)))
    (maphash #'(lambda (key val)
                 (setf (gethash val vertex-table) (make-vertex-for-ao-node val)))
             (node-table ao-graph))
    (values vertex-table)))

;; It will be a good idea to draw the sug-node and goal-node so that they look different. 
(defmethod make-vertex-for-ao-node ((node sug-node))
  (let ((data `(,(name node) 
                  (NS ,(node-status node) CS ,(control-status node) SS ,(solution-status node))
                  (RESULT-STEPS ,(result-steps node))
                  (BINDINGS ,(bindings node))
                  (SUBGOALS-LIST ,(subgoals-list node))
                  (CUR-BMARKER-LIST ,(cur-bmarker-list node))
                  (MAX-BMARKER-LIST ,(max-bmarker-list node)))))                      
    (gos:make-vertex (format nil "~A" (name node)) data)))

(defmethod make-vertex-for-ao-node ((node goal-node))
  (let ((data `(,(name node) 
                  (NS ,(node-status node) CS ,(control-status node) SS ,(solution-status node))
                  (BINDINGS ,(bindings node))
                  (VARIABLES ,(variables node))
                  (NUM-SOLUTIONS ,(num-solutions node)))))
    (gos:make-vertex (format nil "~A" (name node)) data)))

(defparameter *edges* nil)

(defun make-ao-graph-edges (node vertex-table &optional (ao-graph *ao-graph*) (visited nil))
  (when (and (not (null node)) 
             (not (member node visited)))
    (push node visited)
    (dolist (child (children node))
      (when (not (null child))
        (push (make-ao-graph-edge (gethash node vertex-table) (gethash child vertex-table)) *edges*)
        (make-ao-graph-edges child vertex-table ao-graph visited)
        ))))

(defun make-ao-graph-edge (start-vertex end-vertex)
  (gos:make-edge "link"
                 'link-label
                 :origin start-vertex
                 :terminus end-vertex
                 :edge-type 'gos:directed-edge))

;;;(defun build-ao-graph (node ao-graph &optional (visited nil))
;;;  "Traverses the graph, keeping track of visited nodes. Instantiates nodes
;;;   and vertices as it goes along"
;;;  (cond ((null node) (return-from build-ao-graph))
;;;        ((member node visited) (return-from build-ao-graph))
;;;        ;; We are at a node that we havent seen before. 
;;;        (t  (let ((ao-display-node (make-ao-display-node node)))
;;;              (push node visited)
;;;              (dolist (child (children node))
;;;                (make-ao-display-edge 
;;;                (make-not-open-subgraph child ao-graph visited)))))
;;;           )))
;;;
;;;(defun display-ao-graph (&optional (ao-graph *ao-graph*))
;;;  "Display the and/or graph"
;;;  (let ((ao-display-graph (z-graph-gos:make-graph "AO Display"
;;;                                                  :graph-type 'zgraph-gos::directed-zgraph)))
;;;    (build-ao-graph ao-display-graph (start-node ao-graph))))