(load "/Applications/actr6-1-3/load-act-r-6.lisp")
(require :dbus)
(use-package :dbus)
;(gc-off)

(defvar *pressedkey* "")

(defclass pygame-screen ()())

(defvar *inst* (make-instance 'pygame-screen))

(defvar *bus* (make-dbus-bus :session))

(dbus-bus-request-name *bus* "net.coderanger.DBusLisp")

(dbus-add-callback *bus* *inst* "/" "net.coderanger.DBusLisp")

(defmethod pygame-screen-introspect ((obj pygame-screen))
  (format *standard-output* "Introspecting~%")
  (dbus::slurp-file "introspection.xml"))

(defmethod pygame-screen-process ((self pygame-screen)
                                  (type1 string)
                                  ;mine
                                  (x1 number)
                                  (y1 number)
                                  (angle number)
                                  (type2 string)
                                  ;ship
                                  (x2 number)
                                  (y2 number)
                                  (orientation number))
;called from python, gets attributes, returns actions
;this is where we update the device members
;setf the-device to a new pairlis? ick.
    (setf the-device
        (pairlis
            (define-chunks-fct
                `((isa visual-location screen-x ,x1 screen-y ,y1 kind mine value ,angle)
                (isa visual-location screen-x ,x2 screen-y ,y2 kind ship value ,orientation)))
            (define-chunks-fct
                 `((isa visual-object value ,angle)
                 (isa visual-object value ,orientation)))))
                 
    (install-device the-device)
    
    (let ((temp *pressedkey*))
        (if 
            (string/= *pressedkey* "")
            (setf *pressedkey* ""))
        temp))
        

;return list of chunks of type visual-location
;this is what constitutes the visicon
(defmethod build-vis-locs-for ((device list) vismod) 
    (mapcar 'car device))
   
;called when model moves attention to a visual feature
;given the device, and a chunk of type visual-location
;returns corresponding chunck of type visual-object        
(defmethod vis-loc-to-obj ((device list) vis-loc) 
    (cdr (assoc vis-loc device)))
    
;use add-screen-object and delete-screen-object to update the visicon
;calls build-vis-locs-for
;create new chunk-type (myblock (:include visual-location))
;call build-vis-locs-for on each vis-loc type, not whole display  

(defmethod device-handle-keypress ((self list) key)
  (case key
    (#\d (setf *pressedkey* "d"))
    (#\a (setf *pressedkey* "a"))
    (#\Space (setf *pressedkey* "space"))))
    
    
(defmethod get-mouse-coordinates ((self list))
    (vector 0 0))

(defmethod device-update ((self list) time)
  (progn 
    (dbus-bus-pump *bus*)
    (proc-display)
    (print "refresh screen!")))
    
(defun do-experiment ()
    
    (defvar visual-location-chunks
        (define-chunks
               (isa visual-location screen-x 0 screen-y 0 kind mine value nil)
               (isa visual-location screen-x 0 screen-y 0 kind ship value nil)))

    (defvar visual-object-chunks
        (define-chunks
               (isa visual-object value 0)
               (isa visual-object value 0)))

    (defvar the-device (pairlis visual-location-chunks visual-object-chunks))

    (install-device the-device)
    
    (run-until-condition (lambda () nil))
)

(clear-all)

(define-model psf-demo

(sgp :trace-detail high)

(chunk-type aim-and-fire state current target)
(chunk-type (ship (:include visual-object)) direction)
(chunk-type (mine (:include visual-object)) direction)

(add-dm
 (first-goal ISA aim-and-fire state begin))

(p start
  =goal>
    ISA          aim-and-fire
    state        begin
==>
  =goal>
    state        attend-mine
  +visual-location>
    ISA          visual-location
    kind         mine
)

(p attend-false-mine
  =goal>
    ISA          aim-and-fire
    state        attend-mine
  =visual-location>
    ISA          visual-location
    kind         mine
    value        nil
==>
  =goal>
    state        hold
)

(p holding-pattern
  =goal>
    ISA          aim-and-fire
    state        hold
==>
  =goal>
    state begin
)

(p attend-mine
  =goal>
    ISA          aim-and-fire
    state        attend-mine
  =visual-location>
    ISA          visual-location
    kind         mine
  - value        nil
  ?visual>
    state        free
==>
  +visual>
    ISA          move-attention
    screen-pos   =visual-location
  =goal>
    state        encode-mine
)

(p encode-mine
  =goal>
    ISA          aim-and-fire
    state        encode-mine
  =visual>
    ISA          visual-object
    value        =angle
==>
  =goal>
    target       =angle
    state        find-ship
)

(p find-ship
  =goal>
    ISA          aim-and-fire
    state        find-ship
==>
  =goal>
    state        attend-ship
  +visual-location>
    ISA          visual-location
    kind         ship
)

(p attend-ship
  =goal>
    ISA          aim-and-fire
    state        attend-ship
  =visual-location>
    ISA          visual-location
    kind         ship
  ?visual>
    state        free
==>
  +visual>
    ISA          move-attention
    screen-pos   =visual-location
  =goal>
    state        encode-ship
)

(p encode-ship
  =goal>
    ISA          aim-and-fire
    state        encode-ship
  =visual>
    ISA          visual-object
    value        =orientation
==>
  =goal>
    current      =orientation
    state        check-ship-angle
)

(p move-counter-clockwise-normal
  =goal>
    ISA          aim-and-fire
    state        check-ship-angle
    current      =current
    target       =target
    !eval!       (and (> =target =current) (< (- =target =current) 180))
  ?manual>
    state        free
==> 
  +manual>
    ISA          press-key
    key          a
  =goal>
    state        find-ship
)

(p move-clockwise-normal
  =goal>
    ISA          aim-and-fire
    state        check-ship-angle
    current      =current
    target       =target
    !eval!       (and (< =target =current) (< (- =current =target) 180))
  ?manual>
    state        free
==> 
  +manual>
    ISA          press-key
    key          d
  =goal>
    state        find-ship
)

(p move-counter-clockwise-backwards
  =goal>
    ISA          aim-and-fire
    state        check-ship-angle
    current      =current
    target       =target
    !eval!       (and (< =target =current) (> (- =current =target) 180))
  ?manual>
    state        free
==> 
  +manual>
    ISA          press-key
    key          a
  =goal>
    state        find-ship
)

(p move-clockwise-backwards
  =goal>
    ISA          aim-and-fire
    state        check-ship-angle
    current      =current
    target       =target
    !eval!       (and (> =target =current) (> (- =target =current) 180))
  ?manual>
    state        free
==> 
  +manual>
    ISA          press-key
    key          d
  =goal>
    state        find-ship
)

(p fire
  =goal>
    ISA          aim-and-fire
    state        check-ship-angle
    current      =current
    target       =target
    !eval!       (< ( abs (- =target =current)) 3)
  ?manual>
    state        free
==> 
  +manual>
    ISA          press-key
    key          space
  =goal>
    state        begin
)   

(goal-focus first-goal)
)