;****************************************************
;*
;*  DIALOGUE BEHAVIORS
;*
;*  PROTOTYPE INTERNAL AND EXTERNAL BEHAVIORS
;* 
;*  BEGIN: June 1, 1995
;*
;****************************************************

(in-package 'USER)

;***********************************
;*      DIALOGUE CLASS DEFS
;***********************************

;PCL = Process Control Layer
;CL  = Content Layer

;The conds in int/ext-PCL-beh are also found in 
;blackboard lists other than those for reactive behaviors
; See behavior classes in Beh3.lisp

(defclass PCL-beh    () ())
(defclass int-PCL-beh (PCL-beh conds one-shot int-beh) ())   ;int & ext-beh inherits basic-beh
(defclass ext-PCL-beh (PCL-beh conds one-shot ext-beh) ())   ;All PCL are one-shot
(defclass PCL-state-beh  (PCL-beh state int-beh conds) ())
(defclass ext-spatial-PCL-beh (ext-PCL-beh)            ())

(defclass CL-beh     () ())
(defclass ext-CL-beh (CL-beh ext-beh one-shot conds)   ())             
  ;These allow graphic actions to be executed and
  ;make sure the face's behaviors are in accordance 
  ;with what is happening on the big screen.



;***************************************
;* Make-PROCESS-CONTROL-LAYER-Behaviors
;***************************************

(defun prepare-PCL-state-behaviors (node-list)
  (loop for (name type posting next-state pos-c neg-c active-d init-state) in node-list
        collect `(defparameter      ,name
                    (make-instance  ',type
                      :msgs         ',posting   ;what state to post into turn-history.
                      :next         ',next-state
                      :pos-cond     ',pos-c
                      :neg-cond     ',neg-c
                      :active-descr ',active-d
                      :active       ',init-state))))
 
(defmacro make-PCL-state-behaviors (node-list)
  (let ((forms (prepare-PCL-state-behaviors (symbol-value node-list))))
    `(progn ,@forms)))

(defun prepare-ext-PCL-beh (node-list)
  (loop for (name type extent msgs pos-c neg-c pos-r neg-r init-state) in node-list
        collect `(defparameter       ,name
                     (make-instance  ',type
                       :extent       ',extent
                       :msgs         ',msgs   ;what state to post into turn-history.
                       :pos-cond     ',pos-c
                       :neg-cond     ',neg-c
                       :pos-restr-cond     ',pos-r
                       :neg-restr-cond     ',neg-r
                       :active       ',init-state))
        ))
 
(defmacro make-ext-PCL-behaviors (node-list)
  (let ((forms (prepare-ext-PCL-beh (symbol-value node-list))))
    `(progn ,@forms)))


(defun prepare-int-PCL-beh (node-list)
  (loop for (name type extent msgs pos-c neg-c pos-r neg-r init-state) in node-list
        collect `(defparameter       ,name
                     (make-instance  ',type
                       :extent       ',extent
                       :msgs         ',msgs   ;what function to execute
                       :pos-cond     ',pos-c
                       :neg-cond     ',neg-c
                       :pos-restr-cond     ',pos-r
                       :neg-restr-cond     ',neg-r
                       :active       ',init-state))
        ))
 
(defmacro make-int-PCL-behaviors (node-list)
  (let ((forms (prepare-int-PCL-beh (symbol-value node-list))))
    `(progn ,@forms)))

;***************************************
;*    Make-CONTROL-LAYER-Behaviors
;***************************************

(defun prepare-ext-CL-behaviors (node-list)
  (loop for (name type extent func pos-c neg-c pos-restr neg-restr init-state) in node-list
        collect `(defparameter       ,name
                     (make-instance  ',type
                       :extent       ',extent
                       :msgs         ',func   ;what state to post into turn-history.
                       :extent       ',extent
                       :pos-cond     ',pos-c
                       :neg-cond     ',neg-c
                       :pos-restr-cond     ',pos-restr
                       :neg-restr-cond     ',neg-restr
                       :active       ',init-state))))
 
(defmacro make-ext-CL-behaviors (node-list)
  (let ((forms (prepare-ext-CL-behaviors (symbol-value node-list))))
    `(progn ,@forms)))


;***********************************
;*    UPDATE DIALOGUE BEHAVIORS
;***********************************

; 2/23/96 this update method identical to the one for ext-one-shot-rea-beh.

(defmethod update ((beh ext-PCL-beh))
;  (debug-print "updating> ")(print (msgs beh))
   (if (done beh)     ;Means we are looking for restore conditions.
       (let ((num-restore-conds (total-restore-conds beh))
             (count 0))
	 (if (pos-restr-cond beh)
	     (dolist (cond-x (pos-restr-cond beh))
               (if (BB-msgs-type cond-x)
	           (if (call-BB cond-x)
		       (setf count (1+ count)))
	         (if (call-KB-msgs cond-x)
		     (setf count (1+ count))))
               )
	   )
	 (if (neg-restr-cond beh)
	     (dolist (cond-x (neg-restr-cond beh))
               (if (BB-msgs-type cond-x)
	           (if (not (call-BB cond-x))
		       (setf count (1+ count)))
	         (if (not (call-KB-msgs cond-x))
		     (setf count (1+ count)))
	         ))
           )
    ;     (print (msgs beh))(princ count)(call-BB 'give-turn)
	 (if (= count num-restore-conds)   ;Means we should restore...
	     (activate beh))
	 )
     ;else not done
     (let ((num-fire-conds (total-conds beh))
	   (count 0))
       (if (pos-cond beh)
	   (dolist (cond-x (pos-cond beh))
             (if (BB-msgs-type cond-x)
	         (if (call-BB cond-x)
		     (setf count (1+ count)))
	       (if (call-KB-msgs cond-x)
		   (setf count (1+ count)))
	       ))
         )
       (if (neg-cond beh)
	   (dolist (cond-x (neg-cond beh))
	     (if (BB-msgs-type cond-x)
                 (if (not (call-BB cond-x))
		     (setf count (1+ count)))
	       (if (not (call-KB-msgs cond-x))
		   (setf count (1+ count)))
	       ))
         )
       (if (= count num-fire-conds)               ;All conds are necessary.
	   (post beh))
       )
     )
   )

(defmethod post ((beh ext-PCL-beh))
  (unless (pending beh) ;unless already posted.
    (let ((msgs (msgs beh)))
    ;    (if (listp msgs) ;then it's a content message.
    ;        (funcall (first msgs) (rest msgs))
      (progn  ;else it's an ordinary message to be sent to motor controller
     ;       (debug-print "posting: ") (print (msgs beh))
             (setf (stamp beh) (time-stamp))
             (push beh *pending-behaviors*)
             (print (list (msgs beh) (time-stamp)))
             (setf (done beh) 'T)
             (if *display-on* (redraw-obj beh))
             ))
    ;    )
    ))

(defmethod activate ((beh ext-PCL-beh))
;  (print 'activating------------->)(print (msgs beh))
;  (setf (active beh) T)
  (setf (done beh) nil)
  (if *display-on* (redraw-obj beh)))


;------------- INTERNAL PCL BEHAVIORS -------------

(defmethod update ((beh int-PCL-beh))  ;For things like start speech recognition
;  (debug-print "updating> ")(print (msgs beh))
   (if (done beh)     ;Means we are looking for restore conditions.
       (let ((num-restore-conds (total-restore-conds beh))
             (count 0))
	 (if (pos-restr-cond beh)
	     (dolist (cond-x (pos-restr-cond beh))
               (if (BB-msgs-type cond-x)
	           (if (call-BB cond-x)
		       (setf count (1+ count)))
	         (if (call-KB-msgs cond-x)
		     (setf count (1+ count)))
                 ))
           )
	 (if (neg-restr-cond beh)
	     (dolist (cond-x (neg-restr-cond beh))
               (if (BB-msgs-type cond-x)
	           (if (not (call-BB cond-x))
		       (setf count (1+ count)))
	         (if (not (call-KB-msgs cond-x))
		     (setf count (1+ count)))
                 ))
           )
	 (if (eq num-restore-conds count)   ;Means we should restore...
	     (activate beh))
	 )
     ;else not done
     (let ((num-fire-conds (total-conds beh))
	   (count 0))
       (unless (null (pos-cond beh))
	 (dolist (cond-x (pos-cond beh))
	   (if (call-BB cond-x)
	       (setf count (+ count 1)))
	   (if (call-KB-msgs cond-x)
	       (setf count (1+ count)))))
       (unless (null (neg-cond beh))
	 (dolist (cond-x (neg-cond beh))
           (if (BB-msgs-type cond-x)
	       (if (not (call-BB cond-x))
	           (setf count (+ count 1)))
	     (if (not (call-KB-msgs cond-x))
	         (setf count (1+ count)))
             ))
         )
   ;    (print (msgs beh))(princ num-fire-conds)(princ count)
       (if (>= count num-fire-conds)               ;All conds are necessary.
	   (post beh))) ;The post method for beh sends them to the motor execution module
     ))


(defmethod post ((beh int-PCL-beh))
;  (push (list (msgs beh) (active beh) (time-stamp)) *turn-history*)
  (print (msgs beh))(print (extent beh))(princ (- (time-stamp) (stamp beh)))
  (if (< (- (time-stamp) (stamp beh)) (extent beh))
      (progn
        (eval (msgs beh))
        (print (list (msgs beh) (time-stamp))))
    )
  (setf (done beh) T)
  )

(defmethod activate ((beh int-PCL-beh))
  (setf (done beh) nil)
  (setf (stamp beh) (time-stamp))
  )


;***********************************
;*    UPDATE CONTENT BEHAVIORS
;***********************************

(defmethod update ((beh ext-CL-beh))
;  (debug-print "updating> ")(print (msgs beh))
   (if (done beh)     ;Means we are looking for restore conditions.
       (let ((num-restore-conds (total-restore-conds beh))
             (count 0))
	 (unless (null (pos-restr-cond beh))
	   (dolist (cond-x (pos-restr-cond beh))
             (if (BB-msgs-type cond-x)
	         (if (call-BB cond-x)                 ;call both blackboards here!
		     (setf count (1+ count)))
	       (if (call-KB-msgs cond-x)
		   (setf count (1+ count)))
               ))
           )
	 (unless (null (neg-restr-cond beh))
	   (dolist (cond-x (neg-restr-cond beh))
             (if (BB-msgs-type cond-x)
	         (if (not (call-BB cond-x))
		     (setf count (1+ count)))
	       (if (not (call-KB-msgs cond-x))
		   (setf count (1+ count)))
               ))
           )
	 (if (eq num-restore-conds count)   ;Means we should restore...
	     (activate beh))
	 )
     ;else not done, see if should fire
     (progn           
       (let ((num-fire-conds (total-conds beh))
             (count 0))
	 (if (pos-cond beh)
	     (dolist (cond-x (pos-cond beh))
	       (if (BB-msgs-type cond-x)
                   (if (call-BB cond-x)
		       (setf count (1+ count)))
	         (if (call-KB-msgs cond-x)
	             (setf count (1+ count)))
                 ))
           )
	 (if (neg-cond beh)
	     (dolist (cond-x (neg-cond beh))
	       (if (BB-msgs-type cond-x)
                   (if (not (call-BB cond-x))
		       (setf count (1+ count)))
	         (if (not (call-KB-msgs cond-x))
	             (setf count (1+ count)))
                 ))
           )
         (if (= count num-fire-conds)               ;All conds are necessary.             
	     (post beh)) ;The post method for beh sends them to the motor execution module
         ))
     ))


(defmethod activate ((beh ext-CL-beh))
  (setf (active beh) T)
  (setf (done beh) nil)
  (if *display-on* (redraw-obj beh)))


(defmethod post ((beh ext-CL-beh))
  "Notice that this 'post' puts the actual output action onto the
   pending-behaviors list, but not itself, like all the other 'post's."
;  (debug-print "posting: ") (princ beh)
  (setf (stamp beh) (time-stamp))
  (unless (pending beh)
    (funcall (first (msgs beh))))
;  (princ "In post ext-cl-beh: ")(print (list (msgs beh) (time-stamp)))
  (setf (done beh) T)  ;!!!will continue to look for its conditions during active state....
  (if *display-on* (redraw-obj beh))
  )

(defmethod pending ((beh ext-CL-beh))
  "Return T if the behavior is already pending for execution."
  (if (member beh *pending-behaviors*) 
      T
    nil))


(defmethod call-BB-stamp ((node turn-state-beh))
  "Return the node's timestamp."
  (stamp node))