;;;; File: text-viewer.lsp
;;; Contains: Text and File Plan / World viewer
;;; Authors: Jeff Dalton, Brian Drabble, Steve Polyak
;;; Created: Wed Mar  4 17:00:03 1992
;;; Updated:Mon Oct  9 01:18:53 1996 by Steve Polyak
;;; Copyright: (c) 1992, 1993, 1994 AIAI, University of Edinburgh

(in-package :oplan-plan-world-viewer)
(use-package :oplan-tgm)

;;; Text/screen world-view

;;; Handles viewer-args:
;;;
;;;  :MODE :SCREEN
;;;  :MODE :FILE
;;;  :OUTPUT-FILE <file name>
;;;

(defun output-text-world (p-v-pairs)
  (print-text-world p-v-pairs)
  (format *window* "~%"))

(defun print-text-world (p-v-pairs &optional (out *window*))
  (let ((*print-case* :downcase)
	(*print-length* nil)
	(*print-level* nil)
	(*package* *viewer-io-package*))
    (format out "~:{  ~S = ~S~%~}" p-v-pairs)))

;;; File world view

(defun output-file-world (p-v-pairs)
  (let* ((name (ask-user :output-file "File for world view"))
	 (temp-name (temp-filename name)))
    (unless (string= name "")
      (with-open-file (out temp-name :direction :output)
	(format out "~&world~%")
	(print-text-world p-v-pairs out)
	(format out "end_world~%~%"))
      (report-action "Wrote ~A." temp-name))))


;;; Text plan view

(defun output-text-plan (nodes &optional (out *window*))
  (let ((*print-case* :downcase)
	(*print-length* nil)
	(*print-level* nil)
	(*package* *viewer-io-package*))
    (dolist (n nodes)
      (format out "Node Number: ~S ~%" (nd-node-name n))
      (format out "    Begin_end Predecessors : ~S ~%"
	                 (flatten-pairs (nd-begin-pre n)))
      (format out "    Begin_end Successors   : ~S ~%"
	                 (flatten-pairs (nd-begin-suc n)))
      (format out "    End_end Predecessors   : ~S ~%"
	                 (flatten-pairs (nd-end-pre n)))
      (format out "    End_end Successors     : ~S ~%"
	                 (flatten-pairs (nd-end-suc n)))
      (format out "    Earliest start time    : ~A ~%"
	                 (plan-time-string (nd-est n)))
      (format out "    Latest start time      : ~A ~%"
	                 (plan-time-string (nd-lst n)))
      (format out "    Earliest finish time   : ~A ~%"
	                 (plan-time-string (nd-eft n)))
      (format out "    Latest finish time     : ~A ~%"
	                 (plan-time-string (nd-lft n)))
      (format out "    Minimum duration       : ~A ~%"
	                 (plan-time-string (nd-min-duration n)))
      (format out "    Maximum duration       : ~A ~%"
	                 (plan-time-string (nd-max-duration n)))
      (format out "    Node_type              : ~S ~%"
	                 (nd-node-type n))
      (format out "    Node_pattern           : ~S ~%"
	                 (nd-pattern n))
    )
    (format out "~%")
  )
)


;;; File plan view

(defun output-file-plan (nodes)
  (let* ((name (ask-user :output "File for plan view"))
	 (temp-name (temp-filename name)))
    (unless (string= name "")
      (with-open-file (out temp-name :direction :output)
	(write-file-plan nodes out))
      (report-action "Wrote ~A." temp-name))))

#| Code to support GOST export.
   GOST entries look like this:
   (GOST <cond-type> <patt> <val> <at-node-end>) =
       ( ... (<contributor> . <satisfaction method>) ... )
   <satisfaction method> = :NONE or :ALWAYS or :ALREADY-SATISFIED or
                           :ALWAYS-WITH-BINDINGS or :BY-BINDINGS or
                           :LINK-NO-BINDINGS or :LINK-WITH-BINDINGS or :EXPAND 
|#

(defun gost-entry (gost-item) 
  (first gost-item))
(defun gost-contributors (gost-item)
  (second gost-item))
(defun map-over-gost (fn)
  (let ((all-gost-items (db-request :get-gost)))
    (do ((gost-items all-gost-items (cdr gost-items)))
	((endp gost-items))
	(let ((gost-item (car gost-items)))
	  (funcall fn (gost-entry gost-item) 
		   (gost-contributors gost-item))))))

#| Code to support TOME export.
   TOME entries look like this:
   (TOME <patt> <tome-at-node-end>) = <val>

   <tome-at-node-end> = :ALWAYS or (<node> <end>) or
                                  (<node> <end> :ALWAYS . <bindings>)
|#
(defun tome-entry (tome-item) 
  (first tome-item))
(defun tome-value (tome-item)
  (second tome-item))
(defun map-over-tome (fn)
  (let ((all-tome-items (db-request :get-tome)))
    (do ((tome-items all-tome-items (cdr tome-items)))
	((endp tome-items))
	(let ((tome-item (car tome-items)))
	  (funcall fn (tome-entry tome-item) 
		   (tome-value tome-item))))))

#| Code to support resource info export.
   Resource entries look like this:
  (defstruct (rrd (:type list))  ; resource record description
    node
    resource
    min
    max
    parent
    children)
|#
(defun resource-node (resource-record) 
  (first resource-record))
(defun resource-value (resource-record)
  (second resource-record))
(defun resource-min (resource-record)
  (third resource-record))
(defun resource-max (resource-record)
  (fourth resource-record))
(defun resource-parent (resource-record)
  (fifth resource-record))
(defun resource-children (resource-record)
  (sixth resource-record))
(defun map-over-resources (fn)
  (let ((all-resource-records (db-request :get-rut)))
    (do ((resource-items all-resource-records (cdr resource-items)))
	((endp resource-items))
	(let ((resource-item (car resource-items)))
	  (funcall fn resource-item)))))

(defun write-file-plan (nodes &optional (out *window*))
  (let ((*print-case* :downcase)
        (*print-length* nil)
        (*print-level* nil)
        (*package* *viewer-io-package*))
    (format out "~&plan~%~%")
    (dolist (n nodes)
      (format out "  node~%")
      (format out "    ~S ~%" (nd-node-name n))
      (format out "    ~S ~%" (flatten-pairs (nd-begin-pre n)))
      (format out "    ~S ~%" (flatten-pairs (nd-begin-suc n)))
      (format out "    ~S ~%" (flatten-pairs (nd-end-pre n)))
      (format out "    ~S ~%" (flatten-pairs (nd-end-suc n)))
      (format out "    ~S ~%" (nd-time-info n))
      (format out "    ~S ~%" (nd-node-type n))
      (format out "    ~S ~%" (nd-pattern n))
      (format out "  end_node~%~%")
    )
    ;;new export of GOST, STP
    (map-over-gost
     #'(lambda (entry contributors)
	 (format out "  gost_entry~%")
	 (format out "    ~S ~%" (tgm-gost-condition-type entry)) 
	 (format out "    \"~S\" ~%" (tgm-gost-pattern entry)) 
	 (format out "    ~S ~%" (tgm-gost-value entry)) 
	 (format out "    ~S ~%" (tgm-gost-node-end entry)) 
	 (format out "    ~S ~%" contributors) 
	 (format out "  end_gost_entry~%~%")))

    ;;new export of TOME, STP
    (map-over-tome
     #'(lambda (entry value)
	 (format out "  tome_entry~%")
	 (format out "    \"~S\" ~%" (tgm-tome-pattern entry)) 
	 (format out "    ~S ~%" (tgm-tome-node-end entry)) 
	 (format out "    \"~S\" ~%" value) 
	 (format out "  end_tome_entry~%~%")))

    ;;new export of resource info, STP
    (map-over-resources
     #'(lambda (record)
	 (format out "  resource_entry~%")
	 (format out "    \"~S\" ~%" (resource-node record)) 
	 (format out "    \"~S\" ~%" (resource-value record)) 
	 (format out "    ~S ~S ~%" (resource-min record)
		 (resource-max record)) 
	 (format out "    ~S ~%" (resource-parent record))
	 (format out "    ~S ~%" (resource-children record))
	 (format out "  end_resource_entry~%~%")))

    (format out "end_plan~%~%"))
  )

;;; ---------------------------- Change History ----------------------------
;;; (Who)   (When) 		     (What)
;;;  STP    1-Oct-98  Added export of GOST and TOME     
;;;  STP    5-Oct-98  Added export of Resources
;;;
;;; (load "{target dir}/source/text-viewer.lsp")

