;; -*- Mode: LISP; Syntax: Common-Lisp; Package: (USER); -*-
;***************************************************************
;*
;*  NATURAL LANGUAGE / MULTI-MODAL PARSING / TKB / DKB
;*
;*  This module contains knowledge-based functions.
;*
;*  Kris R. Thorisson 
;*  HISTORY:  Begin 5/9 '95
;*            continue 2/96
;*
;***************************************************************
;*
;* Explanation
;* This file combines parts of TK and a DK. 
;* It is basically a DKB with a small TKB thrown in.
;*
;* SOME IMPORTANT VARIABLES:
;*   *parse-list* :templates that have been partially filled
;*   *ACTS*       :graphics commands that have been generated from words
;*   *speech-templates* :template collection used to parse incoming words
;*   *KB-msgs-types*    :a list of all messages that can be posted to *KB-msgs*
;*                      :-a related list is available for all possible BB messages
;*
;* SOME IMPORTANT FUNCTIONS:
;*   init-speech            :opens socket, sends "!"
;*   make-speech-templates  :fills up the *speech-templates* list
;*   parse        :takes *speech-templates* as arg, tries to get a valid parse
;*   parse-speech :calls parse w/*speech-templates* - this func should be called from main
;*   initialize-speech :sets *parse-list* to nil, clears speech buffer

;*
;*    REGION ASSIGNMENTS
;* (specified in gandalf.hg)
;*
;* Region  Utterance type
;*   1:     confirmation
;*   2:     REJECTED
;*   3:     actions
;*   4:     questions
;*   5:     things (moons)
;*   6:     things (planets)
;*   7:     back channel
;*   8:     name
;*   9:     greeting
;*   0:     goodbying
;*

; DEFS

(defvar *old-parses* nil)  ;stores parses that have already "composed".
(defvar *parse-list* nil "Contains all filled templates.")
(defvar *last-harkbeat*  "Stores the time of the last harkbeat received.")
(defvar *KB-msgs* "Timestamped T/DKB actions, status msgs for Process Control system")
(defvar *CURRENT-PLANET* nil "Planet object in focus.")
(defvar *PLANET-IN-VIEW* nil "Planet that was last travelled to.")
(defvar *CURRENT-TOPIC*  'Solar-System "Name of current topic.")

;------------------------------------------
; INITIALIZE
;------------------------------------------


(defun init-speech ()
  (open-speech-sock speech-host-name)
  (send-speech-cmnd "!")
  )

(defvar *ACTS* nil) ;contains TK actions

;------------------------------------------
;            TOPIC KNOWLEDGE (prelim)
;------------------------------------------

; Look at verbs to predict speech act
; Fill in a structure that represents what
; the computer knows how to do, and fill
; the slots for that action.
; Process should be guided by the turn-taking
; process? Yes, of course, but not for now....
;

;---------- CLASS DEFS ----------

;The basic unit of interchange is an executable action.
;After it has been executed it is expected to be out of "linguistic focus".

(defclass cog-act ()
  (
  ;this slot is used by the parser to determine whether incoming utterance
  ;could be refering to this particular action.
   (words :accessor words :type list :initarg :words :initform nil)
   
   ;this slot is used as a measure for how well this action has been "filled"
   ;an int between 0 & 100
   (goodness  :accessor goodness :type integer :initarg :goodness :initform 0)
   ;stamp is the timestamp associated with the instance.
   (stamp :accessor stamp :type integer :initarg :stamp :initform 0)
   (period :accessor period :type list :initarg :period :initform 0)
   ;the symbol used to create a template when relevant word is found.
   (ISA    :accessor ISA   :type symbol :initarg :ISA :initform nil)
   ))

;-------- HIGHER LEVEL NODES --------

(defclass speech-act (cog-act)
  ;high-level parses use lower-level objects to fill their slots
  ())

(defclass World-Act (cog-act)
  ( ;function to be called with above slots.
   (function  :accessor func :initarg :func :initform nil) 
   )
  (:documentation "these parses result in an action in the world."))

(defclass Output-act () ())

(defclass Speech-output (speech-act Output-Act)   ;used for making dialogue output behaviors
  (
   (words :accessor words :initarg :words :initform nil) ;what to say
    ;facial expressions, manual gestures, etc.
   (acts  :accessor acts  :initarg :acts  :initform nil) 
   ))

(defclass DKB-Speech-Output (Speech-Output) ())
(defclass TKB-Speech-Output (Speech-Output) ())

(defclass Action-output (World-Act Output-act)   ;used for making dialogue output behaviors
  (
   (words :accessor words :initarg :words :initform nil) ;what to say
    ;facial expressions, manual gestures, etc.
   (acts  :accessor acts  :initarg :acts  :initform nil)
    ;what to do in the domain
   (domain-act :accessor domain-act :initform nil :initarg :domain-act)
   ))

;It may be wrong to try to force resulting action in
;at the parse stage...YES!!!
;THIS MAKES NO SENSE -- not used
(defclass Ling-Act (speech-act)
  ()
  (:documentation "these parses result in a linguistic act."))

(defclass DKB-act (speech-act)  ())

(defclass Asking-Me (speech-act)
  (
   (words :accessor words :initarg :words :initform '(can which))
    ;"can you [what]?","what is [what]?" - Takes an act.
   (what  :accessor what :initform 'object) 
   ))

(defclass Greeting (DKB-act)
  (
   (words :accessor words :initarg :words :initform '(hello))
   (what  :accessor what  :initform nil) 
   (ISA   :accessor ISA   :initform 'greeting)
   ))

(defclass Greeting-me (Greeting)
  (
   (words :accessor words :initarg :words :initform '(hello))
   (what  :accessor what  :initform 'my-name) 
   (ISA   :accessor ISA   :initform 'greeting-me)
   ))

(defclass Goodbying-me (DKB-act)
  (
   (words :accessor words :initarg :words :initform '(goodbye bye))
   (what  :accessor what  :initform 'nil) 
   (ISA   :accessor ISA   :initform 'goodbying-me)
   ))

(defclass My-Name (DKB-act) ;should be 'my-name
  (
   (words :accessor words :initarg :words :initform '(Gandalf Bilbo Roland))
   (what  :accessor what  :initform nil)
   (ISA   :accessor ISA   :initform 'my-name)
   ))

(defclass TELL-ME (speech-act)
  (
   (words :accessor words :initarg :words :initform '(Tell else aha yeah and))
   (what  :accessor what  :initform 'object)
   (ISA   :accessor ISA   :initform 'speech-act)
   ))

(defclass Ident (speech-act)
  (
   (words :accessor words :initarg :words :initform '(which is))
    ;"can you [what]?","what is [what]?" - Takes an act.
   (what  :accessor what :initform 'object) 
   ))

(defclass TKB-Command (speech-act)
  ( ;This would be generated from the semantic/functional interpretation
    ;func to be called with above slots.
   (function  :accessor func  :initarg :func  :initform nil) 
   (words     :accessor words :initarg :words :initform nil)
    ;do what? -give the class name
   (what      :accessor what  :initarg :what  :initform 'world-act)
   ))

;-------- LOWER LEVEL NODES --------

(defclass OBJECT (cog-act) ;either linguistic or world act.
   ;All objects that the agent knows of, and are "topic-independent"
   ;such as the user, itself, screens, body parts, etc.
   ((words :accessor words
           :initform 
           '(hand head arm body screen planet 
             jupiter earth saturn neptune uranus 
             pluto venus mars marcury sun alphacentauri))
    (det :accessor det :initarg :det :initform nil)
    (ISA :accessor ISA :initarg :ISA :initform 'object)
    ))

(defclass IT (object)
  ;which one is that/which planet is that/tilt it
  ((words :initform '(it planet one)))) 

(defclass MORE (object)
  ((words :initform '(and else yeah more)))) ;inherits the ISA

(defclass SEE (world-act)
  ((words :initform '(see notice))
   (what  :accessor what :initform 'object)))

(defclass HEAR (world-act)
  ((words :initform '(hear))
   (what  :accessor what :initform 'object)))
 
(defclass Look-At (world-act)
  ((words :initform '(look-at))
   (what  :accessor what :initform 'object)))

(defclass HARK-beat ()
  ((val :accessor val :initform nil)))

;----MAKE OBJECT----
(defun make-object (type)(make-instance `,type))

(defvar *speech-templates* nil)

(defun make-speech-templates ()
  (setf *speech-templates* nil)
  (push (make-instance 'goodbying-me) *speech-templates*)
  (push (make-instance 'it)           *speech-templates*)
  (push (make-instance 'tilt)         *speech-templates*)
  (push (make-instance 'more)         *speech-templates*)
  (push (make-instance 'direction)    *speech-templates*)
  (push (make-instance 'tell-me)      *speech-templates*)
  (push (make-instance 'move)         *speech-templates*)
  (push (make-instance 'change)       *speech-templates*)
  (push (make-instance 'view-point)   *speech-templates*)
  (push (make-instance 'greeting)     *speech-templates*)
  (push (make-instance 'greeting-me)  *speech-templates*)
  (push (make-instance 'my-name)      *speech-templates*)
  (push (make-instance 'ident) *speech-templates*)
;  (setf zoom (make-instance 'zoom
;			    :ISA   'world-act
;			    :words '(zoom)
;			    :func  'Zoom))
;  (push (setf zoom-in (make-instance 'zoom-in
;                                     :ISA   'world-act
;                                     :words '(zoom-in zoom)
;                                     :func  'Zoom-in)) *speech-templates*)
  (push (make-instance 'zoom) *speech-templates*)
  (push (make-instance 'hear) *speech-templates*)
  (push (make-instance 'see
                       :words '(see))     *speech-templates*)
  (push (make-instance 'look-at
                       :words '(look-at)) *speech-templates*)
  (push (make-instance 'asking-me)        *speech-templates*)
;  (push (make-instance 'hark-beat)       *speech-templates*)
  (push (make-instance 'move-x-to-y)      *speech-templates*)
  (push (make-instance 'object) *speech-templates*)
;  (push (make-instance 'TKB-command ;don't know if we need this, really
;                       :what 'world-act) *speech-templates*))
  )


;------- Temporary TKB --------

(defclass ZOOM (world-act)
  ((object    :accessor obj :initform nil) ;Optional slot for use in zoom-in.
   (direction :accessor dir :initform nil) ;Optional slot for use in zoom-in.
   (what      :accessor what :initform 'view-point)
   (look-for  :accessor look-for :initform 'direction)
   (where     :accessor where :initform nil)
   (words     :accessor words :initform '(zoom-in zoom move-closer-to))
   (function  :accessor func :initform 'Zoom) ;function to be called with above slots.
   ))

#|
(defclass ZOOM-IN (world-act)
  (
   ;Words could be listed from best to worst...later
   (what      :accessor what  :initform 'view-point)
   (where     :accessor where :initform 'direction)
   (words     :accessor words :initform '(zoom-in zoom move-closer-to))
   (function  :accessor func :initform 'Zoom) ;function to be called with above slots.
   (ISA       :initform 'world-act)
   ))

(defclass ZOOM-OUT (world-act)
  (
   ;Words could be listed from best to worst...later
   (what      :accessor what  :initform 'view-point)
   (where     :accessor where :initform 'direction)
   (words     :accessor words :initform '(zoom-out zoom away))
   (function  :accessor func :initform 'Zoom) ;function to be called with above slots.
   (ISA       :initform 'world-act)
   ))
|#

(defclass CHANGE (world-act)
  (
   (what      :accessor what :initform 'object)
;   (words     :accessor words :initform '(move))
   (function  :accessor func :initform 'Zoom-out) ;function to be called with above slots.
   (ISA       :initform 'world-act)
   ))

(defclass MOVE (world-act)
  (
   (words     :accessor words :initform '(move))
   (what      :accessor what :initform  'object)
   (new-state :accessor new-state :initform nil)
   (function  :accessor func :initform  'Move-it) ;function to be called with above slots.
   (Isa       :initform 'world-act)
   ))

(defclass MOVE-X-TO-Y (world-act)
  (
   (what   :accessor what  :initform 'view-point)
   (where  :accessor where  :initform nil)
   (look-for  :accessor look-for :initform 'object)
   (function  :accessor func :initform 'go-to)
   (words  :accessor words :initform  '(go take show))
   (ISA    :accessor ISA   :initform  'world-act)
   ))

(defclass TILT (world-act)
  (
   (what   :accessor what   :initform 'object)
   (where  :accessor where  :initform nil)
   (look-for  :accessor look-for :initform 'object)
   (gesture   :accessor gesture  :initform 'iconic)
   (function  :accessor func :initform 'tilt-planet)
   (words  :accessor words   :initform '(tilt))
   (ISA    :accessor ISA     :initform 'world-act)
   ))
  
(defclass movable-object (object)  ())

(defclass VIEW-POINT (movable-object)
  (
   (ISA   :accessor ISA   :initform 'object)
   (pos   :accessor pos   :initform  nil)
   (words :accessor words :initform '(view look))
   ))

(defclass DIRECTION (world-act)
  ((words :initform '(in out))
   (ISA  :initform 'direction)
   (what  :accessor what :initform nil)))


(make-speech-templates)


;--------- CLASS METHODS ---------

;The method for zoom-in (or rather the method for incoming
;speech?) would try to bridge between speech
;already collected from user, to the zoom function.
;For this it would use "allowed words"

;The idea is that more than one control (beh) module can
;put templates on the parse-list, e.g. a strong indication
;of a question would put "asking-me" onto the list even when
;lacking actual words...

;Parse will be called from the main loop with the template list *speech-templates*.

(defun parse-now ()  (parse *speech-templates*))

(defmethod parse ((a-list list))
  ;This meth is called with a list of 'template' speech units.
  ;Specific instances of these templates are created if needed.
  (dolist (item a-list)  ;first-level parsing
;    (print item)
    (parse item))
  (dolist (item *parse-list*) ;to do second-level parsing
    (meta-parse item))
  (estimate-goodness *parse-list*)
;  (dolist (item *parse-list*) ;This is done in update-kb 3/16/96
;    (compose item))    
  )

(defmethod parse ((Action cog-act))
  (let ((new-obj nil)
	(new-segments nil))
    (setf new-segments (find-speech-segments Action))
    (dolist (segment new-segments)
      (unless (already-made Action segment)
	(push (make-instance (type-of action)
			     :words segment
			     :stamp  (get-speech-time-stamp segment))
	      *parse-list*))) ;Later put it on a slot in a "this-turn object."
    ))

#|
(defmethod parse ((Action SEE))
  ;This meth fills in words, objects into slots.
  ;If the "parse" is full, put action on dialogue action list.
   (let ((new-obj nil)
         (new-segments nil))
     (setf new-segments (find-speech-segments Action))
     (dolist (segment new-segments)
       (unless (already-made Action segment)
         (push (make-instance 'see
                              :words segment
                              :stamp  (get-speech-time-stamp segment)
                              )
               *parse-list*))) ;Later put it on a slot in a "this-turn object."
     ))
|#

(defmethod parse ((Item More))
  (let ((new-obj nil)
        (new-segments nil))
    (setf new-segments (find-speech-segments Item))
    (dolist (segment new-segments)
    ;  (print  (already-made Item segment))
      (unless (already-made Item segment)
        (push (make-instance 'object
                             :words (list (name *CURRENT-PLANET*)
                                          (get-speech-time-stamp segment))
                             :stamp (get-speech-time-stamp segment)
                             )
              *parse-list*)))
    ))

(defmethod parse ((it IT))
  (let ((new-obj nil)
        (new-segments nil))
    (setf new-segments (find-speech-segments it))
    (dolist (segment new-segments)
      (unless (already-made it segment)
        (push (make-instance 'object
                             :words (list (name *CURRENT-PLANET*)
					  (get-speech-time-stamp segment))
                             :stamp (get-speech-time-stamp segment)
                             )
              *parse-list*)))
    ))

(defmethod parse ((template HARK-beat))  ())

#|
(defmethod parse ((act ling-act))  ())

(defmethod parse ((obj object))  ())

(defmethod parse (foo)  ())
|#

(defmethod parse ((Act world-act))
  ;look for things that can be put into the slots
  (let ((new-obj nil)
        (the-name (isa act))
	(curr-segments nil))
    (setf curr-segments (find-speech-segments Act))
    (if curr-segments
        (dolist (segment curr-segments)
          (unless (already-made Act segment)
            (setf new-obj (make-instance (type-of Act)
			                 :words segment
			                 :stamp  (get-speech-time-stamp segment)
			                 ))
            (push new-obj *parse-list*))
          ))
    ))

#|
(defmethod parse ((Act speech-act))
  ;receive high-level nodes, try to find active low-level nodes
  ;that fit in...
  (let ((new-obj nil)
        (the-name (isa act))
	(curr-segments nil))
    (print (isa act))
    (setf curr-obj (find-speech-objects Act))
    (print curr-obj)
    (dolist (obj curr-obj)
      (unless (already-made Act obj)
        (setf new-obj (make-instance (type-of Act)
				     :what   obj
				     :stamp  (stamp obj)
				     ))
	(push new-obj *parse-list*) ;Later put it on a slot in a "this-turn object."
	))
    ))
|#

(defmethod parse (foo)  ())

(defmethod meta-parse ((lis list))
  (dolist (item lis)
    (meta-parse item))
  )

(defmethod meta-parse ((Act world-act))
  ;only already-created world-acts are meta-parsed.
;  (setf (what Act) (find-candidates *parse-list* (where Act)))
;  (print "I just can't do that right now.")
  )

(defmethod meta-parse ((Act move-x-to-y))
  (let ((candidates (find-candidates *parse-list* (look-for Act))))
    (if candidates
	(dolist (cand candidates)
	  (unless (member cand (where Act))
            (push cand (where Act))))
      )
    ))

(defmethod meta-parse ((Act Zoom))
  (let ((candidates (find-candidates *parse-list* (look-for Act))))
    (if candidates
	(dolist (cand candidates)
	  (unless (member cand (where Act))
            (push cand (where Act))))
      )
    ))

(defmethod meta-parse ((Act Tilt))
  (let ((candidates (find-candidates *parse-list* (look-for Act))))
    (if candidates
	(dolist (cand candidates)
	  (unless (member cand (where Act))
            (push cand (where Act))))
      )
    ))

(defmethod meta-parse (foo)
  ;only already-created world-acts are meta-parsed.
  ())

(defmethod meta-parse ((Act Speech-act))
  (let ((candidates nil)
        (new-act nil))
    (if (what Act) ;if it has a nil in the what slot, it doesn't take anything.
        (setf candidates (find-candidates *parse-list* (what Act))))
    (if candidates
        (dolist (cand candidates)
          (unless (member cand (what Act))
            (setf (what Act)  cand))
          ))
    ))

(defmethod find-candidates ((lis list) slot-candidate)
  (let ((obj-lst nil))
    (dolist (item lis)
;      (describe item)
      (if (equal (ISA item) slot-candidate) ;slot-cand could be an OR-list
          (push item obj-lst)))
    obj-lst))
  

;------------ GOODNESS ----------------

(defmethod estimate-goodness ((lis list))
  (dolist (item lis)
    (estimate-goodness item)))

(defmethod estimate-goodness ((Act World-Act))
  (if (what act) (setf (goodness act) 1))
  )

(defmethod estimate-goodness ((Act move-x-to-y))
;  (describe Act)
  (let ((count 0))
    (if (what act)  (setf count (+ 0.5 count)))
    (if (where act) (setf count (+ 0.5 count)))
    (setf (goodness Act) count)
  ))

(defmethod estimate-goodness ((Act Zoom))
;  (describe Act)
  (let ((count 0))
    (if (what act)  (setf count (+ 0.5 count)))
    (if (where act) (setf count (+ 0.5 count)))
    (setf (goodness Act) count)
  ))

(defmethod estimate-goodness (object) ())

(defmethod estimate-goodness ((Act speech-act)) ;the 'users' speech act
  (let ((count 0))
    (if (not (symbolp (what act))) ;if it's an object
        (setf count (+ 2 count)))
    (if (null (what act)) (setf count 1))
    (setf (goodness Act) count)
    ))


;---------------------------------------;------------------------------------
; Compose will put a complete animation command on the *ACTS* list, or, if
; it is a content question, an utterance for the agent to say.
; As soon as a parse is GOOD and has been used to 'compose', it is taken
; off the current parse list and put on the old-parses list.


(defmethod compose (foo)  ())

(defmethod compose ((parse-list list))
  (dolist (parse parse-list)
    (compose parse))
  )

(defmethod compose ((Act world-act))
  (let ((compo (compose-world-act Act (what Act)))) ;compo is an object!
    (if compo
        (unless (already-created compo)
          (progn
            (post-KB-msgs 'TKB-act-avail 'T)
            (push Act *old-parses*)
            (setf *parse-list* (remove Act *parse-list*))
	    (push compo *ACTS*)
            ))
      )
    ))
   
(defmethod compose-world-act ((act world-act)(obj movable-object))
  (print 'act-on-the-obj))

(defmethod compose-world-act ((act move)(obj movable-object))
  (push "I AM MOVING THE OBJECT" *ACTS*)
  (print "change the pos slot of the obj and send animate command"))

(defmethod compose-world-act ((Act move-x-to-y) obj)
  "Graphics commands will never be composed 'raw'.
   Always use internal intervening functions."
  (let ((world-out-act nil)
        (speech nil)
        (planet-name (first (words (first (where ACT))))))
 ;   (print planet-name)
    (cond ((equal planet-name 'alphacentauri)
           (setf speech "Sorry, now'can'dew")
           (setf world-out-act (make-instance 'TKB-Speech-Output
                                              :words speech
                                              :acts 'manual-hold-it-signal
                                              :stamp (time-stamp)
                                              :goodness (goodness Act)))
           (setf *CURRENT-PLANET* alphacentauri)
           )
	  ((equal planet-name (name *PLANET-IN-VIEW*))
           (setf speech (format nil "This is ~A ~A" planet-name (compose-addressee-name)))
           (setf world-out-act (make-instance 'TKB-Speech-Output
                                              :words speech
                                              :acts 'point-to-big-screen
                                              :stamp (time-stamp)
                                              :goodness (goodness Act)
                                              :domain-act (first (where Act))))
 ;          (print 'hereitis>)(describe world-out-act)
           )
	  ((equal (what Act) 'view-point)           
	   (setf world-out-act (make-instance 'Action-Output
					      :words (compose-acknowledgement)
					      :acts  nil
					      :func  (func Act)
					      :goodness (goodness Act)
					      :stamp (time-stamp)
					      :domain-act (first (where Act))))
	   )
          (T (print "Cannot Compose"))) ;return nil if cannot compose.
    world-out-act
    ))
                              
(defmethod compose-world-act ((act Zoom) obj)
  (let ((world-out-act nil))
    (cond ((equal (what Act) 'view-point)
           (setf world-out-act (make-instance 'Action-Output
                                              :words nil
                                              :acts nil
                                              :func (func Act)
                                              :goodness (goodness Act)
                                              :stamp (time-stamp)
                                              :domain-act (first (where Act))))
           )
          (T nil))
    world-out-act
    ))

(defmethod compose-world-act ((ACT Tilt) obj)
  (let ((world-out-act nil))
    (cond ((equal (what Act) 'object)
           (setf world-out-act (make-instance 'Action-Output
			                      :words (compose-acknowledgement)
                                              :acts  nil
                                              :func (func Act)
                                              :goodness (goodness Act)
                                              :stamp (time-stamp)
                                              :domain-act (first (where Act))))
           )
          (T nil)) ;return nil if cannot compose.
    world-out-act
    ))
    
(defmethod compose-world-act ((act world-act)(obj object))
  (print 'cant-move-stuck-objects))

(defmethod compose-world-act ((act world-act) obj)
  (print 'not-ready))

(defmethod compose ((Act Speech-act)) 
  (let ((composition (compose-TKB-speech-act Act)) ;could be made more general, of course...
        (Out-Act nil))
    (if composition
        (progn
          (setf Out-Act (make-instance 'TKB-Speech-Output
				       :stamp (time-stamp)
                                       :acts  (compose-manual-gesture)
                                       :goodness (goodness Act)
                                       :words composition))
          (unless (already-created Out-Act)
	    (progn
              (push Act *old-parses*)
              (setf *parse-list* (remove Act *parse-list*))
	      (push Out-Act *ACTS*)
              (post-KB-msgs 'TKB-act-avail 'T))
            ))
      )
    ))

(defmethod compose-TKB-speech-act ((Tell Tell-Me))
  (let* ((object (what Tell))
         (speech (make-content-related-to object)))
    (if (equal (first (words object)) 'planet)   ;This is a kludge to allow for 'planet'..
        (setf *CURRENT-PLANET* *PLANET-IN-VIEW*)
      (setf *CURRENT-PLANET* (symbol-value (first (words object)))))
    speech
    ))

(defmethod compose-TKB-speech-act ((Quest Ident))
  (let* ((object (what Quest))
         (speech (first (words object)))
         (obj-ident nil)
         (return "I'm sorry, I'm confused."))
    (cond ((and (equal speech 'planet) 
                (equal (first (words Quest)) 'is))
           (if (not *PLANET-IN-VIEW*)
               (setf return (format nil "I don't see a planet"))
             (progn
               (setf obj-ident (name *PLANET-IN-VIEW*))
	       (setf return (format nil "That is ~A" obj-ident)))
	     ))
	  (T
           (print speech)
           (print (name *planet-in-view*))
	   (if (equal (name *PLANET-IN-VIEW*)
		      speech)
	       (setf return (format nil "Yes, that is ~A" speech))
	     (setf return (format nil "No, that is ~A" (name *PLANET-IN-VIEW*))))
	   )
	  )
    (setf *CURRENT-PLANET* *PLANET-IN-VIEW*)
    return
    ))

(defmethod compose-TKB-speech-act (foo) ())

(defmethod get-pos ((obj Object))
  "These methods receive something and return a location."
  (pos obj))


(defmethod compose ((Act DKB-act))
  (let ((composition (compose-DKB-speech-act Act))
        (Out-Act nil))
    (if composition
        (progn 
          (setf Out-Act (make-instance 'DKB-Speech-Output
                                       :stamp (time-stamp)
                                       :acts 'nil
                                       :goodness (goodness Act)
                                       :words composition))
          (unless (already-created Out-Act)
            (progn
      ;        (describe out-act)
              (push Act *old-parses*)
              (setf *parse-list* (remove Act *parse-list*))
              (push Out-Act *ACTS*)
              (post-kb-msgs 'DKB-act-avail 'T))
            ))
      )
    ))


(defvar greeting-list1    nil)
(defvar greeting-list2    nil)
(defvar name-responses    nil)
(defvar goodbye-responses nil)
(defvar action-acknowledgements  nil)
(defvar manual-beats nil)
(defvar addressee-names nil)

(defun init-greetings ()
  (setf greeting-list1 '("hello there, I am your solar system expert." 
                         "hi, I can take you to the planets." 
                         "hello, I am your guide to the galaxy."))
  (setf greeting-list2 '("hello to you, lets go to a planet."
                         "hello dude"
                         "hello, inhabitant of planet earth."))
  (setf name-responses  '("yes" "yeah" "what?" "what can I do for you?"))
  (setf goodbye-responses  '("good bye" "see you later" "later aligater"))
  (setf action-acknowledgements   '("OK" "okey dokey" "sure" "here we go" "hurray, let's go"
                                         "sure thing pal" "sure thing" "why not"))
  (setf manual-beats '(gest-slow-beat gest-fast-beat nil nil))
  (setf addressee-names '("dude" "my friend" "man"))
  )

(init-greetings)

(defmethod compose-DKB-speech-act ((Act greeting))
  (let ((rnd (random (length greeting-list1))))
    (nth rnd greeting-list1)
    ))

(defmethod compose-DKB-speech-act ((Act greeting-me))
  (let ((rnd (random (length greeting-list2))))
    (nth rnd greeting-list2)
    ))

(defmethod compose-DKB-speech-act ((Act goodbying-me))
  (let ((rnd (random (length goodbye-responses))))
    (nth rnd goodbye-responses)
    ))

(defmethod compose-DKB-speech-act ((Act my-name))
  (let ((rnd (random (length name-responses))))
    (nth rnd name-responses)
    ))

(defmethod compose-acknowledgement ()
  (let ((rnd (random (length action-acknowledgements))))
    (nth rnd action-acknowledgements)
    ))

(defmethod compose-addressee-name ()
  (let ((rnd (random (length addressee-names))))
    (nth rnd addressee-names)
    ))

(defmethod compose-manual-gesture ()
  (let ((rnd (random (length manual-beats))))
    (nth rnd manual-beats)
    ))

;---------- INTERNALLY MOTIVATED OUTPUTS ----------
; things like 'what was that?' etc.

(defmethod compose-DKB-trouble-report (data)
  (let ((out-act nil)
        (speech (compose-DKB-trouble data)))
    (cond ((equal data 'no-words)
    ;       (rem-spch-to-others) ;sets *acts* and *parse-list* to nil
           (setf out-act (make-instance 'DKB-Speech-Output
					:words speech
					:acts nil
					:stamp (time-stamp)
					:goodness 1.0
					:isa 'no-words))
	   )
          )
;    (describe out-act)(print *parse-list*)
    (post-out-act out-act)
    ))

(defmethod post-out-act ((out-act DKB-Speech-Output))
  (unless (already-created out-act)
    (push out-act *ACTS*)
    (post-KB-msgs 'DKB-act-avail 'T))
  )

(defmethod compose-DKB-trouble (data)
  (let ((return nil)
        (rnd nil))
    (cond ((equal data 'no-words)
           (setf rnd (random (length no-words-responses)))
           (setf return (nth rnd no-words-responses)))
          (T "problem in compose-dkb-trouble")
          )
    return
    ))
      
(defvar no-words-responses '("I am sorry, could you repeat?"
                             "I am afraid I did not get that"
                             "I did not get that"))

;---------- Supporting functions ----------

(defmethod already-created (foo) ())

(defmethod already-created ((act DKB-Speech-Output))
  (let ((return nil))
    (dolist (recent-act *ACTS*)
      (if (compare-them act recent-act)
          (setf return T))
      )
    return
    ))

(defmethod already-created ((act Speech-Output))
  (let ((return nil))
    (dolist (recent-act *ACTS*)
      (if (compare-them act recent-act)
          (setf return T))
      )
    return
    ))
    
(defmethod already-created ((act Action-Output))
  (let ((return nil))
    (dolist (recent-act *ACTS*)
      (if (compare-them act recent-act)
          (setf return T))
      )
    return
    ))
    
(defmethod compare-them ((act DKB-Speech-Output)(recent-act DKB-Speech-Output))
  (equal (isa act) (isa recent-act)))

(defmethod compare-them ((act Action-Output)(recent-act Action-Output))
  (equal (domain-act act) (domain-act recent-act)))

(defmethod compare-them ((act Speech-Output)(recent-act Speech-Output))
  (equal (words act) (words recent-act)))

(defmethod compare-them (foo foo2) nil)

(defmethod already-made ((template world-act) spch-seg)
  (let ((time1 (get-speech-time-stamp Spch-seg))
        (return nil))
    (dolist (obj *parse-list*) 
;      (print obj)
;      (print (type-of obj))(print (type-of template))
;      (print time1)(print (stamp obj))
      (if (and (equal (type-of obj)(type-of template))
               (equal time1 (stamp obj)))
	  (setf return t))
      )
    return))

(defmethod already-made ((template object) spch-seg)
  (let ((time1 (get-speech-time-stamp spch-seg))
        (return nil))
    (dolist (obj *parse-list*)
;      (describe obj)
;      (print (type-of obj))(print (type-of template))
;      (print time1)(print (stamp obj))
      (if (equal time1 (stamp obj))
	  (setf return t))
      )
    return
    ))

(defmethod already-made ((act speech-act) spch-seg)
  (let ((time1 (get-speech-time-stamp spch-seg))
        (return nil))
    (dolist (obj *parse-list*)
      (if (and (equal time1 (stamp obj))
               (equal (type-of act) (type-of obj)))
          (setf return t))
      )
    return
    ))


(defmethod already-made (whatever whatever) ())


(defmethod find-speech-segments ((act cog-act))
  ;"Receive a template object, return all speech seg where template applies,
  ; returns a list of all relevant speech segments."
  ;For now, limit word search within a turn...
  ;Later modify to return the position of word in the list...
  (let* (;(users-last-turn-began (call-bb-stamp-t 'give-turn))  ;Get all speech from when user started.
         (this-turn ;(get-speech-after users-last-turn-began))
          (speech-data *socket-obj1*))
         (find-word? nil)
         (new-word-time-pair nil))
    (dolist (word (words act))
      (dolist (speech-segment this-turn)
;        (print this-turn)
;        (princ (get-speech-token speech-segment))
;        (print word)
        (if (equal word (get-speech-token speech-segment))
	    (push speech-segment find-word?))))  ;Collect all segments containing word.
    (reverse find-word?)))
          
(defun get-speech-after (time-stamp)
  (let ((stamp2 (get-speech-time-stamp (first (speech-data *socket-obj1*))))
	(spch-data (speech-data *socket-obj1*)))
    (unless (null stamp2)
      (loop while (< stamp2 time-stamp)
            collect (pop spch-data)
            do (unless
	           (setf stamp2 (get-speech-time-stamp (first spch-data)))
	         (setf stamp2 time-stamp))
            ))
    spch-data
    ))

(defun get-speech-time-stamp (speech-segment)
  (third speech-segment))

(defun get-speech-token (speech-segment)
  (first speech-segment)) ;order: word,region,timestamp
             

;------------------------------------------
; PROCESS SPEECH
;------------------------------------------

;Prefer simple parse to complex parse.
;Prefer to continue a parse than start a new one (unless
;utterance features indicate a restart).

(defun PARSE-SPEECH ()  (parse *speech-templates*))

(defun initialize-Speech ()
  (Setf *parse-list* nil)
;  (make-speech-templates)  ;taken out 3/10/96
  (setf (speech-data *socket-obj1*) nil)
  (setf (old-speech-data *socket-obj1*) nil) ;added 4/10/96
  )

(defun initialize-kb-msgs ()
  (let ((t1 (time-stamp)))
    (setf *kb-msgs* 
          (list (list 'CL-ACT-AVAIL       'NIL t1)
		(list 'TKB-EXE-WORLD-ACT  'NIL t1)
                (list 'TKB-EXE-SPEECH-ACT 'NIL t1)
		(list 'TKB-ACT-AVAIL      'NIL t1)
		(list 'KB-SUCC-PARSE      'NIL t1)
		(list 'SPCH-DATA-AVAIL    'NIL t1)
		(list 'KB-PARSING         'NIL t1) 
		(list 'DKB-ACT-AVAIL      'NIL t1)
		(list 'DKB-EXE-ACT        'NIL t1))
	  ))
  )
;; This appears to be an extra right paran (6-19)
;)

;------------------------------------------
;                  TK
;------------------------------------------

(defun init-kb ()  (kb-init))

(defun KB-init ()
  (make-speech-templates) ;parse templates
  (setf *parse-list* nil)
  (setf *old-parses* nil)
  (setf *KB-msgs* nil)
;  (let ((t1 (time-stamp)))
;    (setf *KB-msgs* (list (list 'KB-parsing 'nil t1))))
;  (if (streamp 'graphics-stream)
;      (progn
;        (make-solar-system)
;	(load-graphics init)    ;Graphics database
;        )
;    )
  (init-greetings)
  (init-planet-knowledge)
  (initialize-kb-msgs)
  )

(defclass jupiter-info (planet)
  (
   (isa     :accessor isa     :initform  '(T "planet")) ;T changes to nil after use...
   (order   :accessor order   :initform  '(nil "fifth"))
   (moons#  :accessor moons#  :initform  '(T "sixteen moons"))
   (dist-from-sun :accessor dist-from-sun 
                  :initform '(nil "seven hundred seventy eight million kilometers"))
   (size    :accessor size    :initform  '(nil "one hundred fourty thousand kilometers"))
   (done    :accessor done    :initform  'nil)
   (free-1  :accessor free-1  :initform  '(T "jupiter is mostly gas"))
   (free-2  :accessor free-2  :initform  '(T "jupiter is really big"))
   ))

(defclass saturn-info (planet)
  (
   (isa     :accessor isa    :initform  '(T "planet")) ;T changes to nil after use...
   (order   :accessor order  :initform  '(nil "sixth"))
   (moons#  :accessor moons#  :initform '(nil "at least fifteen moons"))
   (dist-from-sun :accessor dist-from-sun :initform 
                  '(nil "one point four billion kilometers"))
   (size    :accessor size   :initform  
            '(nil "one hundred twenty thousand kilometers"))
   (done    :accessor done   :initform  'nil)
   (free-1  :accessor free-1 :initform  '(T "saturn has three rings."))
   (free-2  :accessor free-2 :initform  '(T "the rings are made from rocks."))
   ))

(defclass earth-info (planet)
  (
   (isa     :accessor isa    :initform   '(T "planet")) ;T changes to nil after use...
   (order   :accessor order  :initform   '(T "third"))
   (moons#  :accessor moons# :initform   '(T "one moon"))
   (dist-from-sun :accessor dist-from-sun :initform 
                  '(T "one hundred fifty million kilometers"))
   (size    :accessor size   :initform   '(T "12 thousand kilometers"))
   (done    :accessor done   :initform   'nil)
   (free-1  :accessor free-1 :initform   '(T "the surface is mostly water"))
   (free-2  :accessor free-2 :initform   '(T "I like earth."))
   ))

(defclass mars-info (planet)
  (
   (isa     :accessor isa    :initform   '(T "planet")) ;T changes to nil after use...
   (order   :accessor order  :initform   '(T "fourth"))
   (moons#  :accessor moons# :initform   '(T "two moons"))
   (dist-from-sun :accessor dist-from-sun :initform 
                  '(T "two hundred thirty million kilometers"))
   (size    :accessor size   :initform   '(T "six thousand kilometers"))
   (done    :accessor done   :initform   'nil)
   (free-1  :accessor free-1 :initform   '(T "mars is a cool planet"))
   (free-2  :accessor free-2 :initform   '(T "perhaps someday humans will move there"))
   ))

(defclass default-info (planet)
  (
   (isa     :accessor isa     :initform  '(nil "sun")) ;T changes to nil after use...
   (order   :accessor order   :initform  '(nil "six"))
   (moons#  :accessor moons#  :initform  '(nil "sixteen"))
   (dist-from-sun :accessor dist-from-sun :initform '(nil "two million kilometers"))
   (size    :accessor size    :initform  '(nil "two thousand kilometers"))
   (done    :accessor done    :initform  'nil)
   (free-1  :accessor free-1  :initform  '(nil "saturn has three rings."))
   (free-2  :accessor free-2  :initform  '(T "I can't tell you anything about that."))
   ))

(defclass sun-info (planet)
  (
   (isa     :accessor isa     :initform '(nil "the sun")) ;T changes to nil after use...
   (order   :accessor order   :initform '(nil "six"))
   (moons#  :accessor moons#  :initform '(nil "sixteen"))
   (size    :accessor size    :initform '(nil "two thousand kilometers"))
   (done    :accessor done    :initform 'nil)
   (free-1  :accessor free-1  :initform '(T "The sun is in the center of the solar system"))
   (free-2  :accessor free-2  :initform '(T "it's really a sphere of luminous gas."))
   (free-3  :accessor free-3  :initform '(T "Thats all I know about the sun"))
   ))

(defun init-planet-knowledge ()
  (setf jupiter-info (make-instance 'jupiter-info))
  (setf saturn-info  (make-instance 'saturn-info))
  (setf sun-info     (make-instance 'sun-info))
  (setf earth-info   (make-instance 'earth-info))
  (setf mars-info    (make-instance 'mars-info))
  (setf venus-info   (make-instance 'default-info))
  (setf default-info (make-instance 'default-info))
  (setf alphacentauri-info 
        (make-instance 'alphacentauri-info))
  )

(defclass alphacentauri-info (planet)
  (
   (isa     :accessor isa    :initform   '(T "planet")) ;T changes to nil after use...
   (order   :accessor order  :initform   '(nil "a long way"))
   (moons#  :accessor moons# :initform   '(nil "two moons"))
   (dist-from-sun :accessor dist-from-sun :initform '(T "a long way"))
   (size    :accessor size   :initform   '(nil "six thousand kilometers"))
   (done    :accessor done   :initform   'nil)
   (free-1  :accessor free-1 :initform   '(T "alpha cent'auri is a star."))
   (free-2  :accessor free-2 :initform   '(T "perhaps there are aliens there?"))
   (free-3  :accessor free-3 :initform   '(T "that's all about alpha cent'auri"))
   ))

(init-planet-knowledge)

(defmethod make-content-related-to ((World-Obj Object))
  (let* ((obj-name (first (words world-obj)))
         (obj-info (read-from-string (format nil "~A~A" obj-name '-info)))
         (speech nil)
         (object-type 'planet)
         (obj nil))
    (if (equal obj-name 'planet)          ;This probably doesn't belong here, but... :-)
        (progn
	  (setf obj-name (name *PLANET-IN-VIEW*))
          (setf obj-info (read-from-string (format nil "~A~A" obj-name '-info)))
          ))
    (if (boundp obj-info)
        (setf obj-info (symbol-value obj-info))
      (setf obj-info default-info))
    (cond ((equal obj-name 'alphacentauri)
           (setf object-type 'star))
          ((equal obj-name 'sun)
           (setf object-type 'star)))
    (print ">>>>")(princ obj-name)(princ object-type)
    (if (equal object-type 'star)
	(cond ((first (free-1 obj-info))
	       (setf speech (second (free-1 obj-info)))
	       (setf (free-1 obj-info) nil))
	      ((first (free-2 obj-info))
	       (setf speech (second (free-2 obj-info)))
	       (setf (free-2 obj-info) nil))
	      ((first (free-3 obj-info))
	       (setf speech (second (free-3 obj-info)))
	       (setf (free-3 obj-info) nil))
	      (T (setf speech "I don't know anything else about that star.")))
      (cond ((first (order obj-info))
	     (setf speech (format nil "~A is ~A from the sun" 
				  obj-name (second (order obj-info))))
	     (setf (order obj-info) nil))
	    ((first (moons# obj-info))
	     (setf speech (format nil "~A has ~A" 
				  obj-name (second (moons# obj-info))))
	     (setf (moons# obj-info) nil))
	    ((first (size obj-info))
	     (setf speech (format nil "~A is ~A in diameter" 
				  obj-name (second (size obj-info))))
	     (setf (size obj-info) nil))
	    ((first (free-1 obj-info))
	     (setf speech (second (free-1 obj-info)))
	     (setf (free-1 obj-info) nil))
	    ((first (free-2 obj-info))
	     (setf speech (second (free-2 obj-info)))
	     (setf (free-2 obj-info) nil))
          ;Eventually all slots will have been used.
	    (T (setf speech (format nil "I told you all I know about that ~A." object-type)))
	    ))
    speech
    ))


;---------------------------------------
;
;           ACTION KNOWLEDGE
;
;---------------------------------------

;(Defmethod Move-x-to-y ((obj go-to))
;  ;what  = what should be operated on - has to be movable-obj
;  ;where = object[loc]
;  (


; 2/27/96: Notice that if we post all TKB actions onto *acts*
; then we don't need to check for TK problems -- the action
; to execute *will be* a problem action.
(defun TK-problems? ()
  (let ((return nil))
    (dolist (action *pending-behaviors*)
      (if (equal (type-of action) 'missing-info)
          (setf return t))
      )
    return))

(defvar *last-cmnd-issued*   0) ;this is set to the graphics clock when cmnd is given.
(defvar *cmnd-exe-time*    nil) ;stores the time the cmnd should take.

#| 3/2/96
(defun execute-TKB-action ()
  ;This func will send the created command to the Animation Module.
  (let ((world-act (world-acts-pending *pending-behaviors*)) ;used to be just *ACTS*
        (object nil))
    (if world-act 
	(if (subtypep 
             (type-of (setf real-world-object (get-KB-obj (words arg))))
	     'object)
	    (progn
              (setf *last-cmnd-issued* (get-graphics-time))
              (funcall func real-world-object)
              (setf (speech-data *socket-obj1*) nil) ;this should be done with a dial-beh
              (post-msgs 'TKB-exe-act 'T)
;              (setf *acts* nil)
              (setf *parse-list* nil)
              )
          (print "Don't know that object"))
      (post-msgs 'TKB-exe-act 'nil)
      )
    ))
|#


;3/2/96
;(defun world-acts-pending (pending-behavs)
;  (let ((return nil))
;    (dolist (act (reverse pending-behavs)) ;reverse to get the most recent one first.
;      (if (equal (type-of act) 'action-output)
;          (setf return act)))
;    return
;    ))

(defun get-KB-obj (words)
  (let ((name (first words)))
    (eval name)))

(defun exec-graphics? ()
  (let ((graph-time (get-graphics-time)))
    (if graph-time
        (< (- (get-graphics-time) 100) *last-cmnd-issued*) ;for now use constant of 100
      nil)
    ))


;------------------------------------------
;      DKB->INTERPRETER CONNECTION
;------------------------------------------

#| 3/2/96
(defun update-SPEECH ()
  "Gives one round of cycle time to the CL."
  (if (speech-status *socket-obj1*) (read-speech-data)) ;do this with a dial-beh, later
  (if (speech-data *socket-obj1*)
      (progn
	(post-msgs 'KB-parsing 'T)
        (parse-speech)
        )
    (progn    ;else...
      (post-msgs 'KB-parsing 'nil)
      (post-msgs 'KB-succ-parse 'nil)) 
    )
  (if *parse-list*
      (dolist (parse *parse-list*)
        (if (<= 1.0 (goodness parse))
            (progn
              (post-msgs 'KB-succ-parse 'T)
	      (compose parse))
          )
        ))
  (if (not (exec-graphics?))
      (post-msgs 'KB-exe-act 'nil)) ;to let know nothing is executing.
  )
|#

(defun UPDATE-KB ()
  (if (speech-status *socket-obj1*)
      (read-speech-data))
;  (Update-KB-Status)  ; <-- really should use int-cont-rea-beh for this!
  (if (call-kb-msgs 'SPCH-data-avail)
      (parse-speech))
  (Update-KB-Status)   ; <-- really should use int-cont-rea-beh for this!
;  (if (call-kb-msgs 'TKB-exe-world-act) ;added 4/9/96
;      (setf *parse-list* nil))
  (if (call-kb-msgs 'KB-parsing)
      (dolist (parse *parse-list*)
	(if (<= 1.0 (goodness parse))
            (progn
              (post-kb-msgs 'KB-succ-parse 'T)
              (unpost-words parse)
	      (compose parse))
          )
      ;    (post-KB-msgs 'KB-succ-parse 'nil))
	))
  ) 

(defmethod unpost-words ((a-parse cog-act)) ;i.e. any parse at all
  "makes sure that same words won't be parsed again and used for the same act again..."
  (let ((main-word (words a-parse)))
    (setf (speech-data *socket-obj1*)
          (remove main-word (speech-data *socket-obj1*)))
    ))

; 3/3/96
;(defun try-to-parse ()
;  (if *parse-list*      
;      (dolist (parse *parse-list*)
;        (if (<= 1.0 (goodness parse))
;            (progn
;              (post-kb-msgs 'KB-succ-parse 'T)
;	      (compose parse))
;          )
;        ))
;  (if (not (exec-graphics?))
;      (post-kb-msgs 'KB-exe-act 'nil)) ;to let know nothing is executing.
;  )


(defmethod post-kb-msgs ((msgs symbol)(state symbol))
  (unless (already-posted msgs state)
    (push (list msgs state (time-stamp)) *KB-msgs*))
  )

(defmethod already-posted ((msgs symbol)(state symbol))
  (let ((return nil)
;3/6/96        (last-turn (call-bb-stamp 'give-turn))
;        (curr-stamp (time-stamp))
        (temp-list *KB-msgs*)
        (temp-item nil))
    ;find the last posting of msgs
    (loop until (or (null temp-list) (equal (first temp-item) msgs)) ;(> curr-stamp last-turn)) do
	  do
          (setf temp-item (pop temp-list))
         ; (setf curr-stamp (third temp-item)) ;will only look at this-turn
          )
    (if (and temp-list (equal state (second temp-item)))
        T
      nil)
    ))

(defmethod call-KB-msgs ((msgs symbol))
  (let* ((return nil)          ;default is nil
         (temp-list (copy-list *KB-msgs*))
         (temp-msgs 'init)     ;msgs-name
         (temp-item nil))      ;whole msgs list
    (loop while (and (not (equal msgs temp-msgs)) temp-list)  do
          (setf temp-msgs (first (setf temp-item (pop temp-list))))
          (setf return (second temp-item))
          )
    return
    ))

(defmethod call-KB-msgs ((msgs list))
  "takes a funcall list instead of a condition."
;  (princ '/)
  (eval msgs)
  )


#| ;commented out because time-since should only
   ;return the posting age ...
(defmethod kb-time-since ((msgs symbol)(duration integer))
  (let ((temp-kb-msgs *kb-msgs*)
        (found-node nil)
        (node-name nil)
        (time-now (time-stamp)))
    (loop until (or (equal node-name msgs)(null temp-kb-msgs)) do
          (setf a-node (pop temp-kb-msgs))
          (setf node-name (first a-node)))
    (if (second a-node) ;the node is true and state is ongoing...
        nil
      ;otherwise, check to see how long ago the state became nil:
      (< (+ duration (third a-node)) time-now))
    ))
|#

(defmethod call-kb-stamp ((msgs symbol))
  (let ((temp-kb-msgs (copy-list *kb-msgs*))
        (a-node nil)
        (node-name nil)
        (node-state nil))
    (loop until (or (equal node-name msgs)
                    (null temp-kb-msgs)) do
          (setf a-node (pop temp-kb-msgs))
          (setf node-name (first a-node))
          (setf node-state (second a-node)))
    (third a-node)
    ))

(defmethod kb-time-since ((msgs symbol) time)
  "Returns T if behavior/node was posted 
   longer ago than (current-time - TIME)."
  (if (> (time-stamp) (+ (call-KB-stamp msgs) TIME))
      T
    nil))

(defun Update-KB-Status ()
  (if (speech-data *socket-obj1*)
      (post-kb-msgs 'SPCH-data-avail 'T)
    (post-kb-msgs 'SPCH-data-avail 'nil))
  (if *parse-list*
      (post-kb-msgs 'KB-parsing 'T)
    (post-kb-msgs 'KB-parsing 'nil))
  (if *ACTS*
      (post-kb-msgs 'CL-act-avail 'T)
    (post-kb-msgs 'CL-act-avail 'nil))
  (if *real-world-act-list*
      (post-KB-msgs 'TKB-exe-world-act 'T))
  (if (and (call-kb-msgs 'DKB-exe-act)         ;added 4/10/96
           (kb-time-since 'DKB-exe-act 150))   ;1.5 sec = average DKB act duration
      (post-kb-msgs 'DKB-exe-act 'nil))
  (if (and (call-kb-msgs 'TKB-exe-speech-act)  ;added 4/10/96
           (kb-time-since 'TKB-exe-speech-act 250)) ;2.5 sec = average TKB speech dur
      (post-kb-msgs 'TKB-exe-speech-act 'nil))
  (if (or (call-kb-msgs 'TKB-exe-speech-act)
          (call-kb-msgs 'TKB-exe-world-act)
          (call-kb-msgs 'DKB-exe-act))
      (post-kb-msgs 'KB-exe-act 'T)
    (post-kb-msgs 'KB-exe-act 'nil))
  (if (call-bb 'taking-turn)
      (post-kb-msgs 'KB-succ-parse 'nil))
  )

(defmethod clear-spch-buffs ()
  (setf (speech-data *socket-obj1*) nil)
  (setf (inton-data  *socket-obj1*) nil)
  )

(defmethod syntax-complete (foo)
  (call-kb-msgs 'KB-succ-parse))

(defmethod grammar-complete (foo)
  (call-kb-msgs 'KB-succ-parse))

(defmethod pragmatically-complete (foo)
  (call-kb-msgs 'TKB-act-avail))

(defmethod rem-spch-to-others ()
  (if *acts* (setf *acts* nil))
  (rem-part-parses))

(defmethod rem-part-parses ()
;  (print *parse-list*)
  (if *parse-list*
      (setf *parse-list* nil))
  )


;------------------------------------------------------
;
;            LOW-LEVEL SPEECH FUNCTIONS
;
;        (moved from Sockread1.lisp 2/17/96)
;
;------------------------------------------------------

(defun read-speech-data ()
  "Read all data in speech socket and store in a buffer."
  (let ((temp nil)
        (sock (speech-stream *socket-obj1*)))
    (loop (unless (listen sock) (return))
;     (unless (setf temp (peek-char sock)) (return))
     (setf temp (peek-char nil sock))
     (if 1 ;(equal temp #\$)
         (progn
           (let ((in (coerce (read-line sock) 'list)))
  ;           (print in)            ; prints the raw character input.
             (if in 
                 (progn
		   (post-KB-msgs 'RCV-SPCH T)
	           (clean-speech-data in)
                   ))
             ))
       ))
    (post-KB-msgs 'RCV-SPCH nil)
    nil
    ))

(defun purge (sock)
  (loop while (read-char sock)))

(defun clean-speech-data (a-list)
  "Receives a list of characters, cleans and sorts words/timestamps,
   and stores in global speech buffer. Notice that the fourth element
   in a speech item is the current time stamp, which should always be
   higher than the word time stamp. (added 4/4/96)."
  (let ((new-buf nil)
        (words nil)
        (zone nil)
        (timestamp nil))
    (unless (null a-list)
      (if (check-if-valid a-list) ;See if starts with $$.
	  (progn
	    (setf new-buf (read-after (read-after a-list #\$) #\$)) ;Strip $$
	    (setf zone (read-from-string                      ;Read zone
			(coerce (list (first new-buf)) 'string))) 
	    (setf new-buf (read-after a-list  #\Space))       ;Read words
	    (setf words (read-before new-buf  #\!))           ;Could be more than one word.
	    (setf words (clean-words words))
	    (setf new-buf (read-after new-buf #\!))
	    (setf new-buf (read-after new-buf #\Space))
	    (setf timestamp (read-from-string                 ;Read time
			     (coerce new-buf 'string)))
            (if (equal (first words) '[SILENCE])              ;strip out silences
                (princ ",")
	      (progn
                (princ ".")
		(setf (speech-data *socket-obj1*)             ;Make list
		      (append (speech-data *socket-obj1*) 
			      (list (list (first words) zone timestamp (time-stamp)))))
		(push (list (first words) zone timestamp (time-stamp)) 
		      (old-speech-data *socket-obj1*))
		(princ (list (first words) zone timestamp (time-stamp)))
		))
            ;if words is ever more than one, change (first words) to words.
	    )
        (progn
	  (print "Error: Readline from speech returned non-valid sequence.")
          (post-kb-msgs 'TKB-invalid-spch 'T))
	))
    )
  )

(defun clean-words (words)
  "Receives a list of characters, returns a list of word tokens."
  (let ((new-list nil)
        (temp-list nil))
    (loop while words do    ;While words is not empty
          (progn
            (if (not (setf temp-list (read-before words #\Space)))
                (setf temp-list words))
            (setf words (read-after words #\Space))
            (setf temp-list (coerce temp-list 'string))
            (push (read-from-string temp-list) new-list)
            ))
    (reverse new-list)))

(defun check-if-valid (a-list)
  "Recieve a list of speech data, check if starts with two $$."
  (if (and (eq #\$ (first a-list))
           (eq #\$ (second a-list)))
      T
    (progn  ;this should purge any errors from the stream....but it doesn't
      (print "HOLD ON .... PURGING INVALID SPEECH ... ")
      (loop while (listen (speech-stream *socket-obj1*)) do
	    (print (read-char (speech-stream *socket-obj1*))))
      nil)
    ))

(defun read-after (a-list char) 
  "Takes in a list and returns whatever comes after char."
  (let ((in (pop a-list)))
    (unless (eq char in)
      (loop
       (setf in (pop a-list))
       (if (eq char in) (return nil))
           (if (null a-list) (progn
                           (setf out nil)
                           (return nil)))))
    a-list))

(defun read-before (a-list char)  ;this function equivalent to read-delimited-list???
  "Takes a list and returns all before char."
  (let ((in (pop a-list))
        (out nil))
    (unless (eq in char)
      (loop
       (push in out)
       (setf in (pop a-list))
       (if (eq in char) (return nil))
       (if (null a-list) (progn
                           (setf out nil)
                           (return nil)))))
    (reverse out)))

(defun one-shot-spch ()
  (let ((sock (speech-stream *socket-obj1*)))
    (if (speech-status *socket-obj1*)
        (progn
          (write-line "#" sock)
          (loop while (not (listen sock)))
          (if (equal #\3 (read-char sock))
              (print "Speech: one-shot")
            (print "Command did not return correct value."))
          )
      (print "Speech socket seems to be closed."))
    ))

(defun spch-cont ()
  (let ((sock (speech-stream *socket-obj1*)))
    (if (speech-status *socket-obj1*)
        (progn
          (write-line "!" sock)
          (loop while (not (listen sock)))
          (if (equal #\2 (read-char sock))
              (print "Speech: continuous")
            (print "Command did not return correct value."))
          )
      (print "Speech socket seems to be closed."))
    ))

(defun spch-idle ()
  (let ((sock (speech-stream *socket-obj1*)))
    (write-line "$" sock)
    (loop while (not (listen sock)))
    (if (equal #\1 (read-char sock))
	(print "Speech: idle")
      (print "Command did not return correct value."))
    ))

(defun spch-stat ()
  (let ((sock (speech-stream *socket-obj1*)))
    (if (not (listen sock))
        (progn
          (write-line "s" sock)
          (loop while (not (listen sock)))
          (read-char sock))
      (princ "something is waiting on the stream."))))

(defun region-update (region on-off)
  "Receives a positive or negative value, turns on or off, respectively."
  (let ((sock (speech-stream *socket-obj1*))
        (return nil))
    (if (member region '(0 1 3 4 5 6 7 8 9))
        (cond ((on-off) ;if on-off is T, we should turn region ON
               (setf (aref turn-on 1) region)
	       (print (write-line (format nil "*~A" region) sock))
               (loop while (not (listen sock)))
               (setf return (read-char sock)))
              (T
	       (print (write-line (format nil "-~A" region) sock))
               (loop while (not (listen sock)))
               (setf return (read-char sock)))
              )
      )
    ))


(defmethod speech-cmnd ((cmnd symbol))
;  (print cmnd)
  (let ((sock (speech-stream *socket-obj1*)))
    (when (speech-stream *socket-obj1*)
      (cond ((equal cmnd 'LISTEN) (write-line "#" sock)) ;one-shot?
            ((equal cmnd 'TALK)   (write-line "!" sock)) ;continuous operation
	    ((equal cmnd 'SILENT) (write-line "$" sock)) ;turns listening off
	    ((equal cmnd 'QUIT)   (write-line "Q" sock)) ;closes down Hark
	    (t (print "Legal cmnds: TALK SILENT QUIT LISTEN"))))
    ))


;------------------------------------------
;   SENSOR FUNCTIONS
;------------------------------------------

(defun region-equal (region-num)
  "Receives a region, checks to see if anything has
   come in through speech that is in that region."
  (let ((this-turn nil) ;(get-speech-after-users-last-turn-began))
        (return nil))
    (dolist (segment (speech-data *socket-obj1*))
      (if (equal region-num (second segment))
          (setf return T))
      )
    return
    ))


;------------------------------------------
; DEBUG
;------------------------------------------

(defun spch-cmnd (cmnd)
  (send-speech-cmnd cmnd))

(defun send-speech-cmnd (cmnd)
  (write-line cmnd speech-stream)
  (print cmnd))

(defun read-speech ()
  (print (read-line speech-stream)))


(defun test-it ()
  (initialize-all)
  (init-kb)
  (read-speech-data)
  (setf (speech-data *socket-obj1*) nil)
;  (one-shot)
  (speech-cmnd 'TALK)
  (loop while (not (read-char-no-hang)) do
   (read-speech-data)
   (parse-now)
   (dolist (parse *parse-list*)
     (if (<= 1.0 (goodness parse))
         (execute-TK-action parse))
     )
   ))

(defun exe (pars)
  (compose pars)
  (if *acts*
      (let* ((act  (first (act *acts*)))
             (func (first act))
             (arg  (second act)))
        (funcall func arg))
    ))