;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: case-viewer-window.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: June 24, 2002 09:24:34
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Sunday, November 16, 2003 at 18:24:07 by usher
;;;; ---------------------------------------------------------------------------

(in-package :fire-case-viewer)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The first things in this file are the class definitions for the window 
;;;   objects
;;; The second section is the utilities section
;;; The third is the event handlers
;;; The last is the window creation methods - this ordering is to ensure I can
;;;   compile without having already loaded source...
;;;


(defparameter *supported-case-filetypes* 
  '(("Case Files" . "*.dgr") 
    ("Dehydrated Case Files" . "*.dcf")
    ("All Files" . "*.*")))

(defparameter *supported-no-kb-filetypes* 
  '(("Dehydrated Case Files" . "*.dcf")
    ("All Files" . "*.*")))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Window Class Definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass case-viewer-window (cg:dialog)
  ((case-name 
    :accessor case-name :initform nil :initarg :case-name
    :documentation "The name of the case being viewed in this viewer")
   (reasoner 
    :accessor reasoner :initarg :reasoner
    :initform (or fire:*reasoner* 
                  (fire:make-reasoner "Case Viewer Reasoner"))
    :documentation "The reasoner this viewer is using")
   (case-drawing-dialogs 
    :type list 
    :accessor case-drawing-dialogs :initform nil :initarg :case-drawing-dialogs
    :documentation "This is a list of dialogs. Each is responsible or doing 
                    the display and supporting the few user interaction
                    gestures we support. (see case-display-pane.lsp) This is a 
                    list so that I can support changing displays easily."))
  (:documentation "This is a window representing the case information for a single case"))



(defclass case-name-textbox (cg:editable-text)
  ((user-changed? 
    :accessor user-changed? :initform t
    :documentation "So that I can distinguish between changes to the name that 
                    were user performed, or performed via the code...")))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun add-suported-filetype (string-description extension-string)
  (pushnew (cons string-description extension-string)
           *supported-case-filetypes*))


(defun find-display-pane (predicate viewer-window &key (key #'identity))
  (find-if predicate (case-drawing-dialogs viewer-window) :key key ))


(defun active-display-pane (viewer-window)
  "Returns the currently active display pane for the viewer-window"
  (find-display-pane #'active? viewer-window))


(defun fire-case-name? (casename viewer-window)
  (fire:ask-it `(d::isa ,casename d::Case) 
               :reasoner (reasoner viewer-window)))

(defun assign-case-name (viewer-window casename)
  ;; Sets the casename appropriately for the viewer window and notifies the 
  ;;  display panes.
  (setf (cg:title viewer-window) 
    (if casename 
      (format nil "~A - Case Viewer" casename)
      "Case Viewer"))
  (setf (case-name viewer-window) casename)
  (setf (case-name (active-display-pane viewer-window)) casename))
  

(defmethod change-reasoner ((viewer-window case-viewer-window) new-reasoner)
  (setf (reasoner viewer-window) new-reasoner)
  (dolist (dialog (case-drawing-dialogs viewer-window))
    (change-reasoner dialog new-reasoner))
  (view-case nil viewer-window))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EVENT Handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun set-case-name (viewer-window case)
  (setf (user-changed? (casename-selection-box viewer-window)) nil)
  (assign-case-name viewer-window case)
  (setf (cg:value (casename-selection-box viewer-window)) (or case ""))
  (setf (user-changed? (casename-selection-box viewer-window)) t))
  

(defun view-case (case-name viewer-window)
  (set-case-name viewer-window case-name)
  (cg:with-hourglass
    (display-case case-name (active-display-pane viewer-window))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Case Name Selectionbox
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass casename-selectbox (cg:combo-box)
  ((user-changed? 
    :accessor user-changed? :initform t 
    :documentation "A flag indicating whether the user changed the selection
                    or the system")))



(defun casename-selection-box (viewer-window)
  (cg:find-component :case-name-selection-box viewer-window))


(defun update-loaded-cases (viewer-window)
  (let ((case-name-list (casename-selection-box viewer-window))
        (loaded-cases (fire::list-currently-loaded-cases 
                       :reasoner (reasoner viewer-window))))
    (setf (cg:range case-name-list) (copy-list loaded-cases))))

(defun case-name-selection-on-change (casename-box new-casename old-casename)
  (declare (ignore old-casename))
  (when (user-changed? casename-box)
    (let ((viewer-window (cg:parent casename-box)))
      (assign-case-name viewer-window new-casename)
      (display-case new-casename (active-display-pane viewer-window))))
  (setf (user-changed? casename-box) t)
  t)



(defun get-time ()
  (multiple-value-bind (sec min hr date mo year day daylight-p zone)
      (get-decoded-time)
    (declare (ignore zone daylight-p day))
    (format nil "~A/~A/~A ~A:~A:~A" mo date year hr min sec)))

(defun assert-new-case-facts (viewer-window casename caseauthor)
  (declare (ignore viewer-window caseauthor))
  (let ((creation-time (get-time)))
    (declare (ignore creation-time))
    (fire::add-case-loaded-fact casename :new-case-creation)
    
    ;; comment these out for now till I have a nicer way of dealing with them
    ;;;    (fire::add-case-fact
    ;;;     casename `(d::MyCreator ,casename ,caseauthor))
    ;;;    (fire::add-case-fact 
    ;;;     casename `(d::MyCreationTime ,casename ,creation-time))
    ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Case Control Buttons
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro with-required-case (viewer-window &rest body)
  `(cond ((case-name ,viewer-window)
          ,@body)
         (t
          (cg:pop-up-message-dialog ,viewer-window "No Case Name" 
                                    "Please specify a case name" 
                                    nil "Ok"))))

(defun case-control-buttons (case-control-buttons-group new-value old-value)
  (declare (ignore old-value))
  (let* ((viewer-window (cg:parent case-control-buttons-group)))
    (case (first new-value)
      (:new-case (create-new-case viewer-window))
      (:load-file (load-case-file viewer-window))
      (:load-kb (load-case-kb viewer-window))
      (:save-file (with-required-case viewer-window 
                    (save-case-file viewer-window)))
      (:save-kb (with-required-case viewer-window 
                  (save-case-kb viewer-window)))
      (:clear-case (clear-case viewer-window))
      (:delete-wm-cases (delete-cases-wm viewer-window))
      (:delete-case-kb (with-required-case viewer-window 
                         (delete-case-kb viewer-window)))
      (:summarize-case (with-required-case viewer-window 
                         (summarize-case viewer-window)))
      (:add-to-case-library (add-to-case-library viewer-window))
      (:toggle-display-style (toggle-display-style viewer-window))))
  nil)


(defun copy-current-case (new-casename viewer-window)
  (let ((old-case (case-name viewer-window)))
    (when old-case
      (let ((old-case-facts (fire::case-expressions old-case 
                                                    :reasoner (reasoner viewer-window))))
        (dolist (fact old-case-facts)
          (fire::add-case-fact new-casename fact 
                               :reasoner (reasoner viewer-window)))))))


(defun create-new-case (viewer-window)
  (let ((name-author (case-creation-popup viewer-window)))
    (when (and name-author (= 3 (length name-author)))
      (let ((new-case-name (fire::encase-explicit (first name-author)))
            (new-case-author (second name-author))
            (new-case-copy (third name-author)))
        (when (and new-case-name new-case-author)
          (when new-case-copy 
            (copy-current-case new-case-name viewer-window))
          (clear-case viewer-window)
          (assert-new-case-facts viewer-window new-case-name new-case-author)
          (update-loaded-cases viewer-window)
          (view-case new-case-name viewer-window))))))


(defun load-case-file (viewer-window)
  (let ((chosen-file (cg:ask-user-for-existing-pathname 
                      "Load a Case file" 
                      :multiple-p nil
                      :default-extension "dgr"
                      :change-current-directory-p nil
                      :allowed-types *supported-case-filetypes*
                      :initial-directory (get-case-viewer-path 
                                          :subdirs '("samples")))))
    (when chosen-file
      (let ((c-name (fire::load-case-from-file chosen-file)))
        (update-loaded-cases viewer-window)
        (view-case c-name viewer-window)))))


(defun update-all-viewers-currently-loaded-cases (reasoner 
                                                  &key (cases-to-delete nil))
  (let ((all-viewers (fire:ask-it `(d::registeredCaseViewer ?viewer)
                                  :reasoner reasoner
                                  :effort :wm-only
                                  :response '?viewer)))
    (dolist (viewer-win all-viewers)
      (update-loaded-cases viewer-win)
      (when (and cases-to-delete
                 (member (case-name viewer-win) cases-to-delete :test 'equal))
        (clear-case viewer-win)))))
    


(defun load-case-kb (viewer-window)
  (let ((casename (load-case-popup viewer-window)))
    (when casename
      (fire::load-case-from-KB  casename  :reasoner (reasoner viewer-window)) 
      (update-all-viewers-currently-loaded-cases (reasoner viewer-window))
      (view-case casename viewer-window))))


;;; This no longer exists - all currently loaded cases are listed in the case 
;;;  combo boxes, no need for a popup to switch cases.
;;;(defun load-case-wm (viewer-window)
;;;  (let ((casename (switch-wm-case-popup viewer-window)))
;;;    (when casename
;;;      (view-case casename viewer-window))))






(defun delete-cases-wm (viewer-window)
  (let ((cases-to-delete (wm-case-deletion-popup viewer-window)))
    (dolist (wmcase cases-to-delete)
      (fire::delete-case-from-WM wmcase :reasoner (reasoner viewer-window)))
    (update-all-viewers-currently-loaded-cases 
     (reasoner viewer-window) :cases-to-delete cases-to-delete)
    ))


(defun save-case-file (viewer-window)
  (let ((file-to-save (cg:ask-user-for-new-pathname 
                       "Save Case to File" 
                       :multiple-p nil
                       :default-extension "dgr"
                       :change-current-directory-p nil
                       :allowed-types *supported-case-filetypes*
                       :initial-directory (get-case-viewer-path 
                                           :subdirs '("samples")))))
    (when file-to-save
      (fire::save-case-to-flat-file 
       (case-name viewer-window) file-to-save 
       :reasoner (reasoner viewer-window)))))


(defun save-case-kb (viewer-window)
  (cg:with-hourglass 
    (fire::store-case-in-KB (case-name viewer-window) 
                            :reasoner (reasoner viewer-window)))
  (cg:pop-up-message-dialog viewer-window "Save Case to KB" 
                            "Case Successfully Saved" 
                            nil "Ok"))
  
  
(defmethod clear-case (viewer-window)
  (set-case-name viewer-window nil)
  (display-case nil (active-display-pane viewer-window)))
  

(defun delete-case-kb (viewer-window)
  (cg:with-hourglass
    (fire::delete-case-from-KB (case-name viewer-window)))
  (cg:pop-up-message-dialog viewer-window "Delete Case from KB" 
                            "Case Successfully Deleted" 
                            nil "Ok"))


(defun summarize-case (viewer-window)
  (declare (ignore viewer-window))
  (format t "Summarizing the case~%")
  nil)

(defun toggle-display-style (viewer-window)
  (let* ((currently-active-pos (position (active-display-pane viewer-window) 
                                        (case-drawing-dialogs viewer-window)
                                         :test 'equal))
         (num-displays (length (case-drawing-dialogs viewer-window)))
         (new-pos (mod (incf currently-active-pos) num-displays)))
    (activate-display-viewer new-pos viewer-window))
  nil)



(defun add-to-case-library (viewer-window)
  (case-library-manager :owner viewer-window))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Case Viewer Window Creation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun make-toolbar-row1-buttons ()
  (list (make-instance 'cg:button-info
          :name :new-case
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "clear-case" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Create/Copy New Case"
          :help-string "Create a New Case or Copy an existing one to a new case")
        
        (make-instance 'cg:button-info
          :name :load-file
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "load-file" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Load Case from File"
          :help-string "Load Case from File")
        
        (make-instance 'cg:button-info
          :name :load-kb
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "load-kb" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Load Case from Knowledge Base"
          :help-string "Load Case from Knowledge Base")
        
        (make-instance 'cg:button-info
          :name :clear-case
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "clear-case" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Clear the current Case"
          :help-string "Clear the current Case")
        
        (make-instance 'cg:button-info
          :name :add-to-case-library
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "case-library" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Manage Case Library"
          :help-string "Add case to an existing or new case library for MacFac retrieval")
        
        (make-instance 'cg:button-info
          :name :toggle-display-style
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "toggle-case-display" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Toggle the display of the current case (Not Available Yet)"
          :help-string "Toggle the display of the current case (Not Available Yet)")
   
        ))


(defun make-toolbar-row2-buttons ()
  (list (make-instance 'cg:button-info
          :name :save-file
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "file-save" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Save Case to File"
          :help-string "Save Case to File")
        
        (make-instance 'cg:button-info
          :name :save-kb
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "save-kb" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Save Case to the Knowledge Base"
          :help-string "Save Case to the Knowledge Base")
        
        (make-instance 'cg:button-info
          :name :delete-wm-cases
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "erase-wm" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Delete cases from the working memory"
          :help-string "Delete cases from the working memory")
        
        (make-instance 'cg:button-info
          :name :delete-case-kb
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "erase-kb" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Delete the case from the KB"
          :help-string "Delete the case from the KB")
        
        (make-instance 'cg:button-info
          :name :summarize-case
          :pixmap-source (get-case-viewer-path 
                          :subdirs '("Graphics" "Icons") 
                          :filename "case-summary" 
                          :filetype "bmp")          
          :title nil
          :width 16
          :height 16
          :stretching t
          :tooltip "Summarize the current Case (Not Available Yet)"
          :help-string "Summarize the current Case (Not Available Yet)")
        
        ))


(defun make-case-viewer-window-dialog-items (width height)
  (list (make-instance 'casename-selectbox
            :name :case-name-selection-box
            :left 185
            :top 17
            :width 190
            :on-change 'case-name-selection-on-change
            :right-attachment :scale)
          (make-instance 'cg:static-text
            :name :cv-case-name-label
            :left 145
            :top 17
            :width 60
            :height 30
            :font (cg:make-font nil "Tahoma" 13 '(:bold))
            :wrapping t
            :value "Case Name")          
          (make-instance 'cg:multi-picture-button
            :name :case-tools-row2
            :left 12
            :top 30
            :width 140
            :height 21
            :left-attachment :left
            :right-attachment :left
            :top-attachment :top
            :bottom-attachment :top
            :on-change 'case-control-buttons
            :range (make-toolbar-row2-buttons))
          (make-instance 'cg:multi-picture-button
            :name :case-tools-row1
            :left 12
            :top 9
            :width 140
            :height 20
            :left-attachment :left
            :right-attachment :left
            :top-attachment :top
            :bottom-attachment :top
            :on-change 'case-control-buttons
            :range (make-toolbar-row1-buttons))
          
          (make-instance 'cg:lisp-group-box
            :name :case-name-entry-box
            :font (cg:make-font nil "Tahoma" 15 '(:bold))
            :top 5
            :left 5
            :border :raised
            :width (- width 18)
            :height 50
            :left-attachment :left
            :right-attachment :right
            :top-attachment :top
            :bottom-attachment :top)
          
          (make-instance 'cg:lisp-group-box 
            :name :case-pane-box
            :title nil
            :top 57
            :left 5
            :border :raised
            :width (- width 18)
            :height (- height 88)
            :left-attachment :left
            :right-attachment :right
            :top-attachment :top
            :bottom-attachment :bottom)
          
          ))


(defmethod activate-display-viewer (nth-registered (viewer-window 
                                                    case-viewer-window))
  (let ((new-viewer (nth nth-registered (case-drawing-dialogs viewer-window))))
    (when (active-display-pane viewer-window)
      (setf (cg:state (active-display-pane viewer-window)) :shrunk)
      (setf (active? (active-display-pane viewer-window)) nil))
    (setf (active? new-viewer) t)
    (setf (cg:state new-viewer) :normal)
    (when (case-name viewer-window)
      (view-case (case-name viewer-window) viewer-window))))



(defun make-case-display-dialogs (win)
  (let* ((dialog-container (cg:find-component :case-pane-box win))
         (left (cg:left dialog-container))
         (top (cg:top dialog-container))
         (width (cg:width dialog-container))
         (height (cg:height dialog-container))
         (global-casepane-arguments `(:reasoner ,(reasoner win)
                                      :case-name ,(case-name win)
                                      :owner ,win
                                      :child-p t
                                      :active? nil
                                      :state :shrunk
                                      :border :none
                                      :top ,(+ top 3)
                                      :left ,(+ left 3)
                                      :width ,(- width 8)
                                      :height ,(- height 8)
                                      :right-attachment :right
                                      :bottom-attachment :bottom
                                      :background-color ,(cg:background-color win))))
    (mapcar #'(lambda (registered-display)
                (let ((make-func (constructor-func registered-display))
                      (spec-args `(,(name registered-display)
                                     :class ,(pane-class registered-display))))
                  (apply (if make-func make-func #'cg:make-window)
                         (append spec-args global-casepane-arguments))))
      *registered-case-display-panes*)))



(defun register-case-viewer (viewer)
  (let ((viewer-reasoner (reasoner viewer)))
    (fire::tell-it `(data::registeredCaseViewer ,viewer) 
                   :reasoner viewer-reasoner
                   :reason :viewer-creation 
                   :context :all)))

(defun unregister-case-viewer (viewer)
  (let ((viewer-reasoner (reasoner viewer)))
    (fire:untell `(data::registeredCaseViewer ,viewer) 
                 viewer-reasoner :viewer-creation :all)))


(defmethod update-case-viewer-display ((viewer-window case-viewer-window))
  (view-case (case-name viewer-window) viewer-window))
  


(defmethod initialize-instance :after ((viewer-window case-viewer-window) &key)
  (setf (cg:dialog-items viewer-window)
    (make-case-viewer-window-dialog-items (cg:width viewer-window)
                                          (cg:height viewer-window)))
  (setf (case-drawing-dialogs viewer-window) 
    (make-case-display-dialogs viewer-window))
  (register-case-viewer viewer-window)
  (update-loaded-cases viewer-window)
  (activate-display-viewer 0 viewer-window))


(defmethod close-viewer ((viewer-window case-viewer-window))
  (cg:user-close viewer-window))

(defmethod cg:user-close ((viewer-window case-viewer-window))
  (unregister-case-viewer viewer-window)
  (call-next-method))

(defmacro make-case-viewer (&rest initargs  
                                  &key (name :case-viewer-window)
                                       (background-color cg:light-gray)
                                  &allow-other-keys)
  (let ((other-initargs (qrg:remove-keywords 
                         '(:name :dialog-items :background-color) 
                         initargs)))
    `(cg:make-window ,name 
       :class 'case-viewer-window
       :background-color ,background-color
       ,@other-initargs)))
    
                              




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Testing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun test-case-viewer-window (&key (case-name nil))
  (make-case-viewer :case-name case-name
                    :exterior (cg:make-box 100 100 500 600)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code