(in-package "CL-USER")

(defpackage "GRAPH-APP"

  (:use "COMMON-LISP")
  (:nicknames "GAPP" "GRAPP")
  
  (:export

   graph-app))


(in-package "GRAPH-APP")
 

(defvar *roots-graph* nil)


(defvar *graph-hash* (make-hash-table))

(defvar *expr-hash* (make-hash-table))


(defun children-graph (parent)

  (multiple-value-bind (val in) (gethash parent *graph-hash*)

    (if (null in)

        nil

      val)))


(defun display-graph (data interface)

  (let (newroots)

    (clrhash *graph-hash*)

    (clrhash *expr-hash*)

    (setf newroots (make-graph-hash *form* *graph-hash* *expr-hash*))

    (if (not (null newroots))

        (setf *roots-graph* (list newroots)) 

      (setf *roots-graph* nil))

    (setf (capi:graph-pane-roots (gop interface)) *roots-graph*)

    (capi:redisplay-interface interface)))





(defun get-graph-desc (data interface)

  (let ((form (capi:prompt-for-form "Enter a form: " :evaluate nil)))

    (setf *form* form)))






(defparameter *myform* '(A 1 2 (B 3 4 (C 5 6 "XX") 7 W) 2))

(defvar *form*)



(defun to-unique-string (x)

  (format nil "~S" x))


(defun to-unique-string-fun (x)

  (format nil "< ~S >" x))



(defun make-graph-hash (form ght eht)

    (if (null form) nil (make-graph-hash1 form ght eht)))


(defun make-graph-hash1 (form ght eht)

  (cond

   ((and (listp form) (not (null form)))

    (let* ((lead (car form))

           (lead1 (to-unique-string-fun lead)) 

           (children (loop

                      with val = nil

                      with expr-in-hash = nil

                      with child-str = nil

                      with acc = nil

                      for x in (cdr form)

                      finally (return (reverse acc))

                      do

                      (setf child-str (make-graph-hash1 x ght eht))

                      (push child-str acc)

                      (multiple-value-setq (val expr-in-hash)
                          
                          (gethash child-str eht))
                      
                      (if (not expr-in-hash)
                          (setf (gethash child-str eht) x)))))

      (setf (gethash lead1 ght) children)
      
      (setf (gethash lead1 eht) form)

      lead1))

   (t (to-unique-string form))))



(defvar *selected-node*)

(defun show-select (data interface)

  (let ((text-line (tx-lin interface))

        (out-expr (gethash *selected-node* *expr-hash*)))

    (setf (capi:text-input-pane-text text-line) (format nil "~S" out-expr))))
    




(defun gop-node-selected (data interface)

  (setf *selected-node* data))



(defun remove-tree (e tree &key (test #'eq))

  (cond 

   ((funcall test e tree) (values nil t))

   (t (values tree nil))))







(capi:define-interface graph-test ()

()

(:panes


 (input-button

  capi:push-button

  :text "Input Graph"

  :selection-callback 'get-graph-desc)


 (display-button
  
  capi:push-button

  :text "Display Graph"

  :selection-callback 'display-graph)

 (show-select-button
  
  capi:push-button

  :text "Show Select"

  :selection-callback 'show-select)

 (text-line

  capi:text-input-pane

  :text ""

  :callback 'text-line-return

  :accessor tx-lin)


 (graph-out-pane

  capi:graph-pane

  :interaction :extended-selection

  :roots *roots-graph*
  
  :children-function 'children-graph

  :selection-callback 'gop-node-selected

  :accessor gop))

 
(:layouts

 (button-row

  capi:row-layout

  '(input-button display-button show-select-button))

 (graph-out-pane-row

  capi:row-layout

  '(graph-out-pane))

 (text-line-row

  capi:row-layout

  '(text-line))

 (main-layout

  capi:column-layout

  '(button-row text-line-row graph-out-pane-row)))

(:default-initargs

 :layout 'main-layout

 :title "Graph-Demo"

 :best-height 400

 :best-width 500))





(defun graph-app (test-graph)

  (let ((app (make-instance 'graph-test)))

    (setf *form* test-graph)
      
    (display-graph nil app)
  
    (capi:display app)))


(defun test-setup ()

  (setf *roots-graph* '(a))

  (make-graph-hash *myform* *graph-hash*))