(in-package "CASPER")
;;------------------------------------------------------------------------------
;; 
;; File:    MICRO-CASPER.LISP 
;; Created: 11/10/94
;; Author:  Will Fitzgerald
;; 
;; Description: A 'micro' version of the Casper Customer Service Representative
;;              Tutor
;; 
;;------------------------------------------------------------------------------


;;------------------------------------------------------------------------------
;; Packages
;;------------------------------------------------------------------------------

(eval-when (load eval compile)
  (unless (find-package :casper)
    (make-package :casper)))

(in-package :casper)
(use-package :tables)
(use-package :icp)

(export '(clear-statements def-csr def-cust def-response *casper-output* 
          *casper-output* casper))


;;------------------------------------------------------------------------------
;;  Statements and responses
;;------------------------------------------------------------------------------
;; A statement has a symbolic form and an English form. We store these in tables
;; keyed on the symbolic form. The response of a customer is stored in a table
;; keyed on the symbolic form of the CSR.

(defclass statement ()
  ((symbolic-form :initarg :symbolic-form :initform nil :accessor symbolic-form)
   (english-form :initarg :english-form :initform nil :accessor english-form)))

(defmethod print-object ((self statement) stream)
    (print-unreadable-object (self stream :type t :identity t)
      (format stream "~s" (symbolic-form self))))

(defclass csr-statement (statement) ())
(defclass customer-statement (statement) ())

(deftable cust-form-of)
(deftable csr-form-of)
(deftable response-of)

(defun clear-statements ()
  (clear-table (cust-form-of))
  (clear-table (csr-form-of))
  (clear-table (response-of)))

(defun csr->cust (csr-statement)
  "from a CSR statement (symbolic form) to a Customer's response"
  (cust-form-of (response-of csr-statement)))


;;------------------------------------------------------------------------------
;; CSR, Customer and Response definition macros.
;;------------------------------------------------------------------------------

(defmacro def-csr (symbolic-form english-form)
  `(progn
     (setf (csr-form-of ',symbolic-form)
           (make-instance 'csr-statement
          :symbolic-form ',symbolic-form
          :english-form ,english-form)) ',symbolic-form))

(defmacro def-cust (symbolic-form english-form)
  `(progn
     (setf (cust-form-of ',symbolic-form)
           (make-instance 'customer-statement
             :symbolic-form ',symbolic-form
             :english-form ,english-form)) ',symbolic-form))

(defmacro def-response (csr-statement cust-statement)
  `(setf (response-of ',csr-statement) ',cust-statement))

;;------------------------------------------------------------------------------
;; Interface functions. These are very primative.
;;------------------------------------------------------------------------------

(defvar *casper-output* *standard-output*)
(defvar *casper-input* *standard-input*)
(defvar *csr-prompt* "CSR? ")

(defun display-csr-statement (csr-statement)
  (format *casper-output* "~%CSR: ~A" (english-form csr-statement)))

(defun display-cust-statement (cust-statement)
  (format *casper-output* "~%Customer: ~A~%" (english-form cust-statement)))

(defun get-csr-statement ()
  (terpri *casper-output*)
  (princ *csr-prompt* *casper-output*)
  (let ((words (cl-user::->symbols (read-line  *casper-input* "" nil))))
    (icp words)
    (target-concept (choose-best (best-results 7) :key 'what-to-display))))

(defun what-to-display (result)
  (format nil "~4,2F ~S ~A" 
          (score result)
          (target-concept result)
          (let ((csr-statement (csr-form-of (target-concept result))))
            (if csr-statement (english-form csr-statement) ""))))
          
(defun choose-best (list &key (key 'identity))
  (format *casper-output* "~%Choose the best choice (0 for none):")
  (loop for item in list
        for i from 1 doing
        (format t "~%~2,D. ~A" i (funcall key item)))
  (format *casper-output* "~%~A" *csr-prompt*)
  (let ((result (read *casper-input* nil 0)))
    (if (or (not (integerp result)) (= result 0)) nil
        (nth (1- result) list))))

;;------------------------------------------------------------------------------
;; The Casper main loop
;;------------------------------------------------------------------------------
(defun simple-casper-loop (csr-statement-name)
  (let ((csr-statement (csr-form-of csr-statement-name)))
    (when csr-statement
      (display-csr-statement csr-statement)
      (let ((cust-statement (csr->cust csr-statement-name)))
        (when cust-statement
          (display-cust-statement cust-statement)
          (when (eq (symbolic-form cust-statement) 'cl-user::ring-off)
            (return-from simple-casper-loop t))))))
  (simple-casper-loop (get-csr-statement)))

(defun casper ()
  (simple-casper-loop 'cl-user::greet-customer))