; Typing (doit) will start conversation
;
; Sample input:
; > assert row middle red green red green
; > assert rightmost red above bottommost blue 
; > propose rightmost red corresponds leftmost red
; > do leftmost red

(clearall)

(sgp :era t :ut nil :ct t :lt nil)

(chunk-type communicate status hear other want prop)
(chunk-type speech speaker type prop)
;(chunk-type obligation status agent action event)
(chunk-type ground type status agent action prop info)
(chunk-type agent want)
(chunk-type event agent action prop)
(chunk-type proposition string agent arg1 arg1-color relation arg2 arg2-color status)
(chunk-type belief type agent arg1 relation arg2)
(chunk-type color)
(chunk-type direction inverse)
(chunk-type number value)
(chunk-type ordinal value)
(chunk-type attribute)
(chunk-type circle agent correspond color above below left-of right-of 
            x y x-global row column)
(chunk-type row agent cir1 cir2 cir3 cir4 cir5 col1 col2 col3 col4 col5 
            y y-global)
(chunk-type x-global)
(chunk-type y-global)
(chunk-type find agent color x-global circle)
(chunk-type find-related color1 color2 x1 x2 y-global relation status)
(chunk-type check-corr prop status)
(chunk-type check-conf prop status)
(chunk-type confirm prop)

(add-dm (other isa agent)
        (me isa agent)
        (both isa agent)
        (red isa color)
        (orange isa color)
        (yellow isa color)
        (green isa color)
        (blue isa color)
        (blank isa color)
        (one isa number value 1)
        (two isa number value 2)
        (three isa number value 3)
        (first isa ordinal value 1)
        (second isa ordinal value 2)
        (third isa ordinal value 3)
        (count isa attribute)
        (corresponds isa attribute)
        (confirmed isa attribute)
        (above isa direction inverse below)
        (below isa direction inverse above)
        (left-of isa direction inverse right-of)
        (right-of isa direction inverse left-of)
        (topmost isa y-global)
        (middle isa y-global)
        (bottommost isa y-global)
        (leftmost isa x-global)
        (rightmost isa x-global)
        (c1 isa circle agent me color orange above c2 
            x 1 y 1 x-global leftmost row row1)
        (p12 isa proposition agent me arg1-color orange arg1 c1 
             relation above arg2-color green arg2 c2)
        (p21 isa proposition agent me arg1-color green arg1 c2
             relation below arg2-color orange arg2 c1)
        (c2 isa circle agent me color green below c1 left-of c3
            x 1 y 2 x-global leftmost row row1)
        (p23 isa proposition agent me arg1-color green arg1 c2
             relation left-of arg2-color red arg2 c3)
        (p32 isa proposition agent me arg1-color red arg1 c3
             relation right-of arg2-color green arg2 c2)
        (c3 isa circle agent me color red right-of c2 left-of c4
            x 2 y 2 x-global leftmost row row1)
        (p34 isa proposition agent me arg1-color red arg1 c3
             relation left-of arg2-color green arg2 c4)
        (p43 isa proposition agent me arg1-color green arg1 c4
             relation right-of arg2-color red arg2 c3)
        (c4 isa circle agent me color green right-of c3 left-of c5
            x 3 y 2 x-global rightmost row row1)
        (p45 isa proposition agent me arg1-color green arg1 c4
             relation left-of arg2-color red arg2 c5)
        (p54 isa proposition agent me arg1-color red arg1 c5
             relation right-of arg2-color green arg2 c4)
        (c5 isa circle agent me color red right-of c4 above c6
            x 4 y 2 x-global rightmost row row1)
        (p56 isa proposition agent me arg1-color red arg1 c5
             relation above arg2-color orange arg2 c6)
        (p65 isa proposition agent me arg1-color orange arg1 c6
             relation below arg2-color red arg2 c5)
        (c6 isa circle agent me color orange below c5
            x 4 y 3 x-global rightmost)
        (row1 isa row agent me cir1 c2 cir2 c3 cir3 c4 cir4 c5 
              col1 green col2 red col3 green col4 red col5 blank
              y 2 y-global middle)
#|
        (belief1 isa belief agent me arg1 blue relation above arg2 green)
        (belief1i isa belief agent me arg1 green relation below arg2 blue)
        (belief2 isa belief agent me arg1 red relation left-of arg2 green)
        (belief2i isa belief agent me arg1 green relation right-of arg2 red)
        (belief3 isa belief agent me arg1 red relation above arg2 yellow)
        (belief3i isa belief agent me arg1 yellow relation below arg2 red)
        (belief4 isa belief agent me arg1 blue relation count arg2 one)
        (belief4 isa belief agent me arg1 green relation count arg2 one)
        (belief4 isa belief agent me arg1 red relation count arg2 one)
        (belief4 isa belief agent me arg1 yellow relation count arg2 one)
|#
)

(defun color-p (x)
  (member x '(red orange yellow green blue)))

(defun global-x-p (x)
  (member x '(leftmost rightmost)))

(defun global-y-p (x)
  (member x '(topmost bottommost)))

(defun direction-p (x)
  (member x '(above below left-of right-of)))

; > assert row middle red green red green
; > request row middle
; > assert rightmost red above bottommost blue 
; > propose rightmost red corresponds leftmost red
; > confirm leftmost red
(defun doit ()
  (let (;(inp nil)
        ;(speech-s nil)
;        (prop-s nil)
;        (row-s nil)
        )
    (load "comm.actr")

(eval `(add-dm (goal isa communicate status "accept contribution"
                           other other)))
      (goal-focus goal)
      (run)))

(p listen
   =goal>
    isa communicate
    status "accept contribution"
    hear nil
==>
   !eval! (format t "~&> ")
   !bind! =inp (read-from-string (format nil "(~a)" (read-line nil)))
   =speech>
    isa speech
    speaker other
    type (!eval! (string (first =inp)))
    prop (!eval! (format nil "~a" (cdr =inp)))
   =goal>
    hear =speech
)

(p understand-speech
   =goal>
    isa communicate
    status "accept contribution"
    hear =speech
    other =other
   =speech>
    isa speech
    prop =prop
==>
   !output! ("(You said something.  I'll try to understand.)")
   =ob1>
    isa ground
    type "obliged"
    agent me
    action "understand"
    prop =speech
;!eval! (goalstack)
   !pop!          ;goal to accept contribution
   !pop!          ;goal to ground statement from self
   !push! =ob1
;!eval! (goalstack)
   =goal>
    hear nil
)

(p understand-assert
   =goal>
    isa ground
    type "obliged"
    agent me
    action "understand"
    prop =speech
    status nil
   =speech>
    isa speech
    type "ASSERT"
    prop =prop
==>
   !output! ("(You are trying to make me believe ~a.  I'll try.)" =prop)
   =act>
    isa ground
    type "try"
    agent other
    action "try belief"
    prop =prop
   =goal>
    status "done"
    prop =prop
   !focus-on! =act
)

(p understand-action-directive
   =goal>
    isa ground
    type "obliged"
    agent me
    action "understand"
    prop =speech
    status nil
   =speech>
    isa speech
    type "CONFIRM"
    prop =prop
==>
   !output! ("(You are trying to make me ~a.  I'll let you know.)" =prop)
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "address"
    prop =prop
   =goal>
    status "done"
   !focus-on! =ob2
)

(p understand-info-request
   =goal>
    isa ground
    type "obliged"
    agent me
    action "understand"
    prop =speech
    status nil
   =speech>
    isa speech
    type "REQUEST"
    prop =prop
==>
   !output! ("(You are asking me for ~a.  I'll let you know.)" =prop)
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "answer"
    prop =prop
   =goal>
    status "done"
   !focus-on! =ob2
)

(p understand-open-request
   =goal>
    isa ground
    type "obliged"
    agent me
    action "understand"
    prop =speech
    status nil
   =speech>
    isa speech
    type "PROPOSE"
    prop =prop
==>
   !output! ("(You are asking me to agree to ~a.  I'll let you know.)" =prop)
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "assess"
    prop =prop
   =goal>
    status "done"
   !focus-on! =ob2
)

(p understand-accept
   =goal>
    isa ground
    type "obliged"
    agent me
    action "understand"
    status nil
   =speech>
    isa speech
    type "ACCEPT"
   =prop>
    isa proposition
    agent both
    status "pending"
   =sccoe>
    isa ground
    agent me
    info =prop
==>
   !output! ("(You are accepting ~a.)" =prop)
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "finish"
    prop =prop
   =goal>
    status "done"
   !focus-on! =ob2
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun nth-string (n s)
  (nth n (read-from-string s)))

(p other-assert-row
   =goal>
    isa ground
    type "try"
    agent other
    action "try belief"
    prop =prop
    status nil
   !eval! (equal (first (read-from-string =prop)) 'row)
==>
   !output! ("(Creating row...)")
   =row>
    isa row
    agent other
    y-global (!eval! (second (read-from-string =prop)))
    col1 (!eval! (third (read-from-string =prop)))
    col2 (!eval! (fourth (read-from-string =prop)))
    col3 (!eval! (fifth (read-from-string =prop)))
    col4 (!eval! (sixth (read-from-string =prop)))
    col5 (!eval! (seventh (read-from-string =prop)))
   =sccoe>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =row
   =goal>
    status "done"
   !focus-on! =sccoe
   !push! =row           ;unpack circles
)

; > request row middle
(p other-request-row
   =goal>
    isa ground
    type "obliged"
    agent me
    action "answer"
    prop =prop
   !eval! (equal (nth-string 0 =prop) 'row)
   =row>
    isa row
    agent me
    y-global (!eval! (nth-string 1 =prop))
==>
   =goal>
    status "done"
   =new>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =row
    status nil
   !focus-on! =new
)

(p other-assert-link
   =goal>
    isa ground
    type "try"
    agent other
    action "try belief"
    prop =prop
    status nil
   !eval! (global-x-p (nth-string 0 =prop))
==>
   =p1>
    isa proposition
    agent other
    string =prop
    relation (!eval! (nth-string 2 =prop))
   =sccoe>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =p1
   =goal>
    status "done"
   !focus-on! =sccoe
   !push! =p1            ;fill args
)

; > request above leftmost red
(p other-request-link
   =goal>
    isa ground
    type "obliged"
    agent me
    action "answer"
    prop =prop
   !eval! (global-x-p (nth-string 1 =prop))
==>
   =c>
    isa circle
    x-global (!eval! (nth-string 1 =prop))
    color (!eval! (nth-string 2 =prop))
   =p>
    isa proposition
    agent me
    relation (!eval! (nth-string 0 =prop))
    arg2 =c
   =new>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =p
    status "related"
   !focus-on! =new
)

(p other-propose-corr
   =goal>
    isa ground
    type "obliged"
    agent me
    action "assess"
    prop =prop
    status nil
==>
  =p1>
   isa proposition
   agent both
   string =prop
   relation corresponds
  =new>
   isa check-corr
   prop =p1
  =sccoe>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =new
  =goal>
   status "done"
  !focus-on! =sccoe
  !push! =new           ;check corr
  !push! =p1            ;fill args
)

(p other-request-conf
   =goal>
    isa ground
    type "obliged"
    agent me
    action "address"
    prop =prop
==>
  =p1>
   isa proposition
   agent both
   string =prop
   relation confirmed
  =new>
   isa check-conf
   prop =p1
  =sccoe>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =new
  =goal>
   status "done"
  !focus-on! =sccoe
  !push! =new          ;check conf
  !push! =p1           ;fill args
)

(p other-accept-conf
   =goal>
    isa ground
    type "obliged"
    agent me
    action "finish"
    prop =prop
   =prop>
    isa proposition
    relation confirmed
    status "pending"
    arg1 =c1
    arg1-color =col1
   =c1>
    isa circle
    x =x
    y =y
==>
   !output! ("Confirming ~a at (~a ~a)" =col1 =x =y)
   =prop>
    status "done"
   !pop!
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p check-corr-left
   =goal>
    isa check-corr
    prop =p
    status nil
   =p>
    isa proposition
    arg1 =c1
    arg2 =c2
   =p1-left>
    isa proposition
    arg1 =c1
    arg1-color =color1
    arg2-color =color2
    relation right-of
   =p2-left>
    isa proposition
    arg1 =c2
    arg1-color =color12
-    arg2-color =color2
    arg2-color =color3
    relation right-of
==>
   =p>
    status (!eval! 
            (format nil "You have ~a left of ~a, but I have ~a left of ~a."  
                    =color2 =color1 =color3 =color12))
   =goal>
    status (!eval! 
            (format nil "You have ~a left of your ~a, but I have ~a left of my ~a."  
                    =color2 =color1 =color3 =color12))
)

(p check-corr-below
   =goal>
    isa check-corr
    prop =p
    status nil
   =p>
    isa proposition
    arg1 =c1
    arg2 =c2
   =p1-below>
    isa proposition
    arg1 =c1
    arg1-color =color1
    arg2-color =color2
    relation above
   =p2-left>
    isa proposition
    arg1 =c2
    arg1-color =color12
-    arg2-color =color2
    arg2-color =color3
    relation above
==>
   =p>
    status (!eval! 
            (format nil "You have ~a below ~a, but I have ~a below ~a."  
                    =color2 =color1 =color3 =color12))
   =goal>
    status (!eval! 
            (format nil "You have ~a below your ~a, but I have ~a below my ~a."  
                    =color2 =color1 =color3 =color12))
)
    
(p check-corr-ok
   =goal>
    isa check-corr
    prop =p
    status nil
   =p>
    isa proposition
    arg1 =c1
    arg1-color =col1
    arg2 =c2
    arg2-color =col2
   =c1>
    isa circle
   =c2>
    isa circle
==>
  =c1>
   correspond =c2
  =c2>
   correspond =c1
  =p>
   status "OK"
  =goal>
   status "OK"
)

(spp check-corr-ok :r 0.5)

(p check-conf-ok
   =goal>
    isa check-conf
    prop =p
    status nil
   =p>
    isa proposition
    arg1 =c1
   =p1>
    isa proposition
    relation corresponds
    status "OK"
    arg1 =c1
    arg1-color =color1
    arg2 =c2
    arg2-color =color2
   =c2>
    isa circle
    x =x
    y =y
==>
   =p>
    status "confirming"
    arg2 =c2
    arg2-color =color2
   =goal>
    status "OK"
)

(p check-conf-bad-corr
   =goal>
    isa check-conf
    prop =p
    status nil
   =p>
    isa proposition
    arg1 =c1
   =p1>
    isa proposition
    relation corresponds
-    status "OK"
    arg1 =c1
    arg1-color =color1
    arg2 =c2
    arg2-color =color2
==>
   =p>
    status "Bad correspondence"
    arg2 =c2
    arg2-color =color2
   =goal>
    status "I don't think the correspondence for that circle is good."
)

(p check-conf-no-corr
   =goal>
    isa check-conf
    prop =p
    status nil
   =p>
    isa proposition
==>
  =p>
   status "No correspondence"
  =goal>
   status "We don't have a correspondence for that circle yet."
)

(spp check-conf-no-corr :r 0.5)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p fill-1-prop
   =goal>
    isa proposition
    agent other
    string =prop
    relation =rel
    arg1 nil
   !eval! (not (nth-string 4 =prop))
==>
   =new1>
    isa find
    agent other
    color (!eval! (nth-string 1 =prop))
    x-global (!eval! (nth-string 0 =prop))
    circle =circle1
   !push! =new1
  =goal>
   arg1 =circle1
   arg1-color (!eval! (nth-string 1 =prop))
)

(p fill-2-prop
   =goal>
    isa proposition
    agent other
    string =prop
    relation =rel
    arg1 nil
   !eval! (nth-string 4 =prop)
==>
   !output! ("(trying to ground ~a and ~a circles)" 
             (nth-string 1 =prop) (nth-string 4 =prop))
   =new1>
    isa find
    agent other
    color (!eval! (nth-string 1 =prop))
    x-global (!eval! (nth-string 0 =prop))
    circle =circle1
   =new2>
    isa find
    agent other
    color (!eval! (nth-string 4 =prop))
    x-global (!eval! (nth-string 3 =prop))
    circle =circle2
   !push! =new2
   !push! =new1
  =goal>
   arg1 =circle1
   arg1-color (!eval! (nth-string 1 =prop))
   arg2 =circle2
   arg2-color (!eval! (nth-string 4 =prop))
)

(p fill-1-both-prop
   =goal>
    isa proposition
    agent both
    string =prop
    relation =rel
    arg1 nil
   !eval! (not (nth-string 4 =prop))
==>
   !output! ("(trying to ground ~a circle)" 
             (nth-string 1 =prop))
   =new1>
    isa find
    agent other
    color (!eval! (nth-string 1 =prop))
    x-global (!eval! (nth-string 0 =prop))
    circle =circle1
   !push! =new1
  =goal>
   arg1 =circle1
   arg1-color (!eval! (nth-string 1 =prop))
)

(p fill-2-both-prop
   =goal>
    isa proposition
    agent both
    string =prop
    relation =rel
    arg1 nil
   !eval! (nth-string 4 =prop)
==>
   !output! ("(trying to ground ~a circles)" 
             (nth-string 1 =prop))
   =new1>
    isa find
    agent other
    color (!eval! (nth-string 1 =prop))
    x-global (!eval! (nth-string 0 =prop))
    circle =circle1
   =new2>
    isa find
    agent me
    color (!eval! (nth-string 4 =prop))
    x-global (!eval! (nth-string 3 =prop))
    circle =circle2
   !push! =new2
   !push! =new1
  =goal>
   arg1 =circle1
   arg1-color (!eval! (nth-string 1 =prop))
   arg2 =circle2
   arg2-color (!eval! (nth-string 4 =prop))
)

(p retrieve-circle
   =goal>
    isa find
    agent =agent
    color =color
    x-global =g
    circle nil
   =circle>
    isa circle
    agent =agent
    color =color
    x-global =g
==>
   =goal>
    circle =circle
   !pop!
)

(p fill-circle
   =goal>
    isa find
    agent =agent
    color =color
    circle nil
   =circle>
    isa circle
    agent =agent
    color =color
    x-global nil
==>
   !output! ("(You've mentioned the ~a circle before)" =color)
   !push! =circle
)

(p new-circle
   =goal>
    isa find
    color =color
    x-global =g
    circle nil
==>
   !output! ("(you haven't mentioned the ~a circle before)" =color)
   =c1>
    isa circle
    agent other
    color =color
    x-global =g
   =goal>
    circle =c1
   !pop!
)

(p link-above
   =goal>
    isa proposition
    string =prop
    arg1 =c1
    arg2 =c2
    relation above
   =c1>
    isa circle
    above nil
   =c2>
    isa circle
    below nil
==>
   =c1>
    above =c2
   =c2>
    below =c1
   !pop!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p backward-accept-assert-row
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =row
    status nil
   =row>
    isa row
    y-global =y
==>
   !output! ("OK. (I believe ~a.)" =prop)
   =goal>
    status "done"
   =new>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =row
    status "related"
   !pop!
   !focus-on! =new
)

(p backward-accept-assert-link
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =p1
    status nil
   =p1>
    isa proposition
-   relation corresponds
==>
   !output! ("OK. (I believe ~a.)" =prop)
   =goal>
    status "done"
   =new>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =p1
    status "related"
   !pop!
   !focus-on! =new
)

(p backward-reject-propose-corr
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =check
    status nil
   =check>
    isa check-corr
    status =status
-    status "OK"
==>
   !output! ("~a" =status)
   =goal>
    status "done"
)

(p backward-accept-propose-corr
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =check
    status nil
   =check>
    isa check-corr
    status "OK"
   =c1>
    isa circle
    correspond nil
==>
   !output! ("OK, still need ~a" =c1)
   =goal>
    status "done"
)

(p backward-accept-propose-corr-conf
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =check
    status nil
   =check>
    isa check-corr
    status "OK"
    prop =p1
   =p1>
    isa proposition
==>
   !output! ("(OK)")
   =goal>
    status "done"
   =new>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =p1
    status nil
   !focus-on! =new
)

(spp backward-accept-propose-corr-conf :r 0.5)

(p backward-accept-request-conf
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =check
    status nil
   =check>
    isa check-conf
    status =status
    status "OK"
    prop =p1
   =p1>
    isa proposition
==>
   =goal>
    status "done"
   !output! ("OK.")
   =new>
    isa confirm
    prop =p1
   !push! =new
)

(p backward-reject-request-conf
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    info =check
    status nil
   =check>
    isa check-conf
    status =status
-    status "OK"
    prop =p1
   =p1>
    isa proposition
==>
   =goal>
    status "done"
   !output! ("~a" =status)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p confirm-action
   =goal>
    isa confirm
    prop =prop
   =prop>
    isa proposition
    status "confirming"
    arg2 =c
   =c>
    isa circle
    x =x
    y =y
==>
   =prop>
    status "confirmed"
   !output! ("(Confirming (~a ~a))" =x =y)
   !pop!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p find-related
   =goal>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =p1
    status "related"
   =p1>
    isa proposition
    arg1 =c1
    arg1-color =col1
    arg2-color =col2
    relation =rel
   =c1>
    isa circle
    x-global =x1
   =c2>
    isa circle
    x-global =x2
==>
   =new>
    isa find-related
    color1 =col1
    x1 =x1
    color2 =col2
    x2 =x2
    relation =rel
    status =p2
   =goal>
    info =p2
    status nil
   !push! =new
)

(p find-1-related
   =goal>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =p1
    status "related"
   =p1>
    isa proposition
    relation =rel
    arg2 =c2
   =c2>
    isa circle
    x-global =x2
    color =col2
==>
   =new>
    isa find-related
    color2 =col2
    x2 =x2
    relation =rel
    status =p2
   =goal>
    info =p2
    status nil
   !push! =new
)

(p find-related-row
   =goal>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =row
    status "related"
   =row>
    isa row
    y-global =y
==>
   =new>
    isa find-related
    y-global =y
    status =r2
   =goal>
    info =r2
    status nil
   !push! =new
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(p forward-assert-row
   =goal>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =row
    status nil
   =row>
    isa row
    y-global =y
    col1 =col1
    col2 =col2
    col3 =col3
    col4 =col4
    col5 =col5
==>
   !output! ("My ~a row is ~a ~a ~a ~a ~a." =y =col1 =col2 =col3 =col4 =col5)
   =goal>
    status "done"
)

(p forward-assert-link
   =goal>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =prop
    status nil
   =prop>
    isa proposition
    arg1 =c1
    arg1-color =col1
    arg2 =c2
    arg2-color =col2
    relation =rel
   =rel>
    isa direction
   =c1>
    isa circle
    x-global =x1
   =c2>
    isa circle
    x-global =x2
==>
   !output! ("My ~a ~a circle is ~a my ~a ~a circle." 
             =x1 =col1 =rel =x2 =col2)
   =goal>
    status "done"
)

(p forward-request-conf
   =goal>
    isa ground
    type "SCCOE"
    agent me
    prop nil
    info =p1
    status nil
   =p1>
    isa proposition
    relation corresponds
    arg1 =c1
    arg1-color =col1
    arg2 =c2
    arg2-color =col2
==>
   !output! ("Let's confirm that ~a circle" =col1)
   =p2>
    isa proposition
    agent both
    arg1 =c2
    arg1-color =col2
    arg2 =c1
    arg2-color =col1
    relation confirmed
    status "pending"
   =goal>
    info =p2
)

(p check-understanding
   =goal>
    isa ground
    type "SCCOE"
    status "done"
==>
   =new>
    isa communicate
    status "accept contribution"
    hear nil
    other other
   !push! =new
)

#|
(p backward-accept-assert
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    status nil
==>
   !output! ("OK. (I believe ~a.)" =prop)
   =goal>
    status "done"
   !pop!
)

(spp backward-accept-assert :r 0.25)
|#

(p backward-reject-assert
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    status nil
   =prop>
    isa proposition
    arg1 =arg1
    relation =rel
    arg2 =arg2
   =prop2>
    isa proposition
    arg1 =arg1
    relation =rel2
-    relation =rel
    arg2 =arg2
==>
   !output! ("~a is ~a ~a?  I thought you said ~a is ~a ~a." =arg1 =rel =arg2
             =arg1 =rel2 =arg2)
   =goal>
    status "not"
   !pop!
)

#|
(p backward-accept-assert-helpful
   =goal>
    isa ground
    type "SCCOE"
    agent other
    prop =prop
    status nil
==>
   !output! ("OK. (I believe ~a.)" =prop)
   !push! =prop      ;find related prop
   =goal>
    status "done"
)

(spp backward-accept-assert-helpful :r 0.5)

(p backward-accept-action-directive
   =goal>
    isa communicate
    status "addressing-action-directive"
    other =other
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "address"
    prop =speech
   =speech>
    isa speech
    type "DO"
    prop =prop
==>
   !output! ("Since I'm a nice guy I'll ~a" =prop)
   =act>
    isa ground
    type "obliged"
    agent me
    action "do"
    prop =prop
   =ob2>
    status "done"
   =goal>
    status "done"
   !pop!
)

(p backward-answer-yes
   =goal>
    isa communicate
    status "answering-info-request"
    other =other
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "answer"
    prop =speech
   =speech>
    isa speech
    type "IS"
    prop =prop
   =prop>
    isa proposition
    arg1 =arg1
    relation =rel
    arg2 =arg2
   =bel>
    isa belief
    agent me
    arg1 =arg1
    relation =rel
    arg2 =arg2
==>
   !output! ("Yes, ~a ~a ~a." =arg1 =rel =arg2)
   =ob2>
    status "done"
   =sccoe1>
    isa ground
    type "SCCOE"
    agent me
    prop =prop
   =goal>
    status "done"
   !pop!
)

(p backward-answer-no-helpful
   =goal>
    isa communicate
    status "answering-info-request"
    other =other
   =ob2>
    isa ground
    type "obliged"
    agent me
    action "answer"
    prop =speech
   =speech>
    isa speech
    type "IS"
    prop =prop
   =prop>
    isa proposition
    arg1 =arg1
    relation =rel
    arg2 =arg2
==>
   !output! ("No, my ~a is not ~a ~a." =arg1 =rel =arg2)
   !push! =prop
   =ob2>
    status "done"
   =sccoe1>
    isa ground
    type "no SCCOE"
    agent me
    prop =prop
   =goal>
    status "done"
)

(spp backward-answer-no-helpful :r 0.5)
|#

(p related-arg1
   =goal>
    isa find-related
    color1 =col1
    x1 =x1
    relation =rel
    status nil
   =c>
    isa circle
    color =col1
    x-global =x1
   =p1>
    isa proposition
    agent me
    arg1 =c
    relation =y
    arg2 =z
==>
   =goal>
    status =p1
   !pop!)

(p related-arg2
   =goal>
    isa find-related
    color2 =col2
    x2 =x2
    relation =rel
    status nil
   =c>
    isa circle
    color =col2
    x-global =x2
   =p1>
    isa proposition
    agent me
    arg1 =x
    relation =y
    arg2 =c
==>
   =goal>
    status =p1
   !pop!)

(spp related-arg2 :r 0.5)

(p related-y
   =goal>
    isa find-related
    y-global =y
    status nil
   =row>
    isa row
    agent me
    y-global =y
==>
   !output! ("(found my related ~a row)" =y)
   =goal>
    status =row
   !pop!)

(p unpack-c1
   =row>
    isa row
    col1 =col1
    cir1 nil
==>
   =c1>
    isa circle
    agent other
    color =col1
    x 1
    row =row
   =row>
    cir1 =c1)

(p unpack-c2
   =row>
    isa row
    cir1 =cir1
    col1 =col1
    cir2 nil
    col2 =col2
   =cir1>
    isa circle
==>
   =c2>
    isa circle
    agent other
    color =col2
    x 2
    right-of =cir1
    row =row
   =p1>
    isa proposition
    agent other
    arg1 =cir1
    arg1-color =col1
    arg2 =c2
    arg2-color =col2
    relation left-of
   =p2>
    isa proposition
    agent other
    arg1 =c2
    arg1-color =col2
    arg2 =cir1
    arg2-color =col1
    relation right-of
   =cir1>
    left-of =c2
   =row>
    cir2 =c2)

(p unpack-c3
   =row>
    isa row
    cir2 =cir2
    col2 =col2
    cir3 nil
    col3 =col3
   =cir2>
    isa circle
==>
   =c3>
    isa circle
    agent other
    color =col3
    x 3
    right-of =cir2
    row =row
   =p1>
    isa proposition
    agent other
    arg1 =cir2
    arg1-color =col2
    arg2 =c3
    arg2-color =col3
    relation left-of
   =p2>
    isa proposition
    agent other
    arg1 =c3
    arg1-color =col3
    arg2 =cir2
    arg2-color =col2
    relation right-of
   =cir2>
    left-of =c3
   =row>
    cir3 =c3)

(p unpack-c4
   =row>
    isa row
    cir3 =cir3
    col3 =col3
    cir4 nil
    col4 =col4
   =cir3>
    isa circle
==>
   =c4>
    isa circle
    agent other
    color =col4
    x 4
    right-of =cir3
    row =row
   =p1>
    isa proposition
    agent other
    arg1 =cir3
    arg1-color =col3
    arg2 =c4
    arg2-color =col4
    relation left-of
   =p2>
    isa proposition
    agent other
    arg1 =c4
    arg1-color =col4
    arg2 =cir3
    arg2-color =col3
    relation right-of
   =cir3>
    left-of =c4
   =row>
    cir4 =c4)
    
(p globalize1
   =circle>
    isa circle
    color =color
    x =x1
    x-global nil
   =circle2>
    isa circle
    agent other
    color =color
-    x =x1
    x =x2
    x-global nil
   !eval! (< =x1 =x2)
==>
   !output! ("(~a circle ~a is left of ~a circle ~a)" 
             =color =circle =color =circle2)
   =circle>
    x-global leftmost
   =circle2>
    x-global rightmost
   !pop!)
    
(p globalize2
   =circle>
    isa circle
    color =color
    x =x1
    x-global nil
   =circle2>
    isa circle
    agent other
    color =color
-    x =x1
    x =x2
    x-global nil
   !eval! (> =x1 =x2)
==>
   =circle>
    x-global rightmost
   =circle2>
    x-global leftmost
   !pop!)


; DAMSL
; Forward
;   Statement (Assert)
;   Request
;     Action
;     Info
;     Open
; Backward
;   Answer
;   Agreement
;     Accept (part)
;     Maybe
;     Reject (part)
;     Hold
;   Understanding
;     Signal Non-Understanding
;     Signal Understanding
;       Acknowledge
;       Repeat/Rephrase
;       Completion
;     Correct Misspeaking

; Clark & Shaefer
; question - answer
; request - comply/refuse
; propose - accept/reject
; offer - accept/reject
; invite - accept/reject
; apologize - accept/reject
; thank - accept/reject
; assess - agree/disagree
; compliment - agree/disagree
; summon - answer
; greet - greet
; farewell - farewell

; Traum
; S1 Accept/Promise A - S1 Acheive A
; S1 Request A - S2 Address Request by accept A or reject A
; S1 YNQ whether P - S2 Answer-if P
; S1 WHQ P(x) - S2 Inform-ref x
; utterance not_understood/incorrect - repair utterance