(require :dbus)
(use-package :dbus)
;(gc-off)

(defvar *shiporientation* nil)
(defvar *targetangle* nil)
(defvar *shipx* 0)
(defvar *shipy* 0)
(defvar *minex* 0)
(defvar *miney* 0)
(defvar *pressedkey* "")

(defun reset-vars ()
  (setf *shiporientation* nil)
  (setf *targetangle* nil))

(defmacro defclassic (class supers &rest slots)
  `(defclass
             ,class
             ,supers
             ,(mapcar
               #'(lambda (s); s = slot specification
                   (flet ((build (sn); sn = slot name
                            (list sn ':accessor sn ':initarg
                                  (read-from-string
                                   (concatenate 'string ":" (symbol-name sn))))))
                     (cond ((atom s) (append (build s) '(:initform nil)))
                           ((null (cddr s)) (append (build (first s)) (list ':initform (second s))))
                           ((eql t (second s))
                            (append (build (first s))
                                    (nthcdr 2 s)
                                    (if (not (member :initform (nthcdr 2 s))) '(:initform nil))))
                           (t s))))
               slots)))

(defclassic mydevice () )

(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 process-pygame ((self pygame-screen) arg) ;called from python, gets attributes, returns actions
;  (progn (setf arg (read-from-string arg))
;    (loop for item in args do
;          (case first(item)
;            ("mine" (do (setf *minex* (second(item))) (setf *miney* (third(item))) (setf *targetangle* (fourth(item)))))
;            ("ship" (do (setf *shipx* (second(item))) (setf *shipy* (third(item))) (setf *shiporientation* (fourth(item))))))
;          (let (temp *pressedkey*)
;            (progn
;              (if (/= *pressedkey* "") (setf *pressedkey* ""))
;              temp)))))

(defmethod pygame-screen-process ((self pygame-screen)
                                  (type1 string)
                                  (x1 number)
                                  (y1 number)
                                  (angle number)
                                  (type2 string)
                                  (x2 number)
                                  (y2 number)
                                  (orientation number))
;called from python, gets attributes, returns actions
    (setf *minex* x1)
    (setf *miney* y1)
    (setf *targetangle* angle)
    (setf *shipx* x2)
    (setf *shipy* y2)
    (setf *shiporientation* orientation)
    (let ((temp *pressedkey*))
        (if 
            (string/= *pressedkey* "")
            (setf *pressedkey* ""))
        temp))

(defmethod get-mouse-coordinates ((self mydevice))
  (vector 0 0))

(defclass mine-feature (icon-feature)
  ((direction :accessor direction :initarg :direction))
  (:default-initargs
    :kind 'MINE
    :dmo-id (gentemp "MINE")))

(defclass ship-feature (icon-feature)
  ((direction :accessor direction :initarg :direction))
  (:default-initargs
    :kind 'SHIP
    :dmo-id (gentemp "SHIP")))

(defmethod feat-to-dmo :around ((self mine-feature))
  (let ((the-chunk (call-next-method)))
    the-chunk))

(defmethod feat-to-dmo :around ((self ship-feature))
  (let ((the-chunk (call-next-method)))
    the-chunk))

(defmethod build-features-for ((self mydevice) (vis-mod vision-module))
      (list (make-instance 'ship-feature
                           :x *shipx*
                           :y *shipy*
                           :value *shiporientation*)
            (make-instance 'mine-feature
                           :x *minex*
                           :y *miney*
                           :value *targetangle*)))
  

(defmethod device-handle-keypress ((self mydevice) key)
  (case key
    (#\d (setf *pressedkey* "d"))
    (#\a (setf *pressedkey* "a"))
    (#\Space (setf *pressedkey* "space"))))

(defmethod device-update ((self mydevice) time)
  (progn 
    (dbus-bus-pump *bus*)
    (proc-display)
    (print "refresh screen!")))

(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
;  =goal>
;    ISA          aim-and-fire
;    state        check-ship-angle
;    current      =current
;    target       =target
;    !eval!       (or (and (> =target =current) (< (abs (- =target =current)) 180)) (and (< =target =current) (> (abs (- =target =current)) 180)))
;  ?manual>
;    state        free
;==> 
;  +manual>
;    ISA          press-key
;    key          a
;  =goal>
;    state        find-ship
;)

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

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

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

(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!       (equal =target =current)
  ?manual>
    state        free
==> 
  +manual>
    ISA          press-key
    key          space
  =goal>
    state        begin
)
    

(goal-focus first-goal)
)

(install-device (make-instance 'mydevice))