;;;; Authors: Zhenrong Qian and Steve Wolfman
;;;;
;;;; This file contains code for visualizing decision
;;;; trees. To visualize a tree, construct it then pass
;;;; it to "setup-viz". Then, Choose Build\Run Window from
;;;; Allegro's menu. A little button saying 
;;;; "Tree-Viz-Dialog" will pop up; click it
;;;; and up comes the visualization. Nodes are folders,
;;;; leaves are files, green leaves answer YES, red leaves
;;;; answer NO.

;;; A visualization system with thanks to Shawna (Zhenrong Qian) for
;;; constructing the model I worked from (and mostly just copied :)

;; Setup-vis is the primary interface function. Pass it a 
;; decision tree then run the window.
(defun setup-viz (decision-tree)
   (setf *viz-node* decision-tree)
   (pushnew 'tree-viz-dialog *loaded-but-uncreated-windows*))

;; Makes an outline node from a decision tree node, recursively
;; constructing subnodes at the same time. The prefix argument
;; should be left blank by the calling function.
(defun make-item (node &optional (prefix ""))
  ;; Establish the "true-prefix"; just tacks on a ": " if there's any
  ;; text at all.
   (let ((true-prefix (if (equalp prefix "")
                         ""
                         (concatenate-strings prefix ": "))))
      (cond ;; If a node is a cons, then it is an interior node in the tree.
            ((consp node) 
		   ;; Verify that the node has the proper form:
		   (assert (feature-p (car node)) ((car node)) "car of tree is not a feature in make-item")
		   (assert (and
				  (listp (cdr node))
				  (every #'(lambda (branch)
						   (and (consp branch)
							   (member (car branch) 
									 (feature-domain (car node)))))
						   (cdr node)))
				 ((cdr node))
				 "branches improperly formed in make-item (not a list of conses with each cons of form (CHOICE . subtree)")
             (let ((children (mapcar 
                                #'(lambda (choice) 
                                     (make-item (cdr choice) (symbol-name (car choice))))
                                (rest node))))
                (make-outline-item (concatenate-strings true-prefix 
                                      (feature-description (first node))) nil :open children)))
             
             ;; Otherwise, if it is T, then the answer at this leaf is YES
             (node 
		    (assert (eq node T))
		    (make-outline-item (concatenate-strings true-prefix "Yes") nil 
						   :open NIL 
						   :foreground-color #S(rgb red 0 green 85 blue 0)))
             
             ;; Otherwise, it is NIL and the answer is NO.
             (T 
		    (assert (null node))
		    (make-outline-item (concatenate-strings true-prefix "No") nil 
						   :open NIL 
						   :foreground-color #S(rgb red 65 green 0 blue 5))))))



; Define the dialog :Dialog-1
 
(in-package :common-lisp-user)
 
(defvar *tree-viz-dialog* nil)
(defvar *viz-node* nil) 

;; Return the window, creating it the first time or when it's closed.
;; Use only this function if you need only one instance.
(defun tree-viz-dialog ()
   (if (windowp *tree-viz-dialog*) *tree-viz-dialog* 
      (setq *tree-viz-dialog* (make-tree-viz-dialog *viz-node*))))
 
;; Create an instance of the window.
;; Use this if you need more than one instance.
(defun make-tree-viz-dialog (node)
   (setq *loaded-but-uncreated-windows* 
      (delete 'tree-viz-dialog *loaded-but-uncreated-windows*))
   (let (window-0 window-1 window-2 window-3 window-4)
      (setq window-0 
         (open-dialog 
            (list 
               (make-dialog-item 
                  :widget 'outline 
                  :name :decision-tree
                  :title "Outline 3" 
                  :value "Decision Tree" 
                  :box (make-box 0 0 500 500) 
                  :tabstop t 
                  :groupstart nil 
                  :background-color 
                  (make-rgb :red 192 :green 192 :blue 192) 
                  :key 'capitalize-object 
                  :range (list (make-item node))
                  :font (make-font nil :arial 16 nil) 
                  :user-scrollable t))
            'dialog *lisp-main-window* 
            :name :tree-viz-dialog
            :title "Decision tree vizualization" 
            :font (make-font :swiss :system 16 '(:bold)) 
            :window-state :shrunk 
            :window-border :frame 
            :left-attachment nil 
            :top-attachment nil 
            :right-attachment nil 
            :bottom-attachment nil 
            :user-movable t 
            :user-resizable t 
            :user-closable t 
            :user-shrinkable t 
            :user-scrollable nil 
            :overlapped nil 
            :background-color (make-rgb :red 192 :green 192 :blue 192) 
            :pop-up-p nil
            :window-interior (make-box 100 100 600 600)))
      (setf (window-editable-p window-0) t)
;;;      (setf (getf (stream-plist window-0) :path) 
;;;         "z:\\qian\\profile\\cse473\\visual\\problem1-v")
      (setf (getf (stream-plist window-0) :startup-state) nil)
      (setf (getf (stream-plist window-0) :top-level-p) nil)
      (setf (help-string window-0) (delete #\Newline nil))
      (setf (getf (stream-plist window-0) :package) nil)
      nil
      (let* ((box (getf *window-exteriors* (object-name window-0))))
         (when box (reshape-window-exterior window-0 box)))
      (show-window window-0 nil)
      window-0))