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

(defvar *pressedkey* "")

(defvar *joyx* 0)

(defvar *joyy* 0)

(defvar *gameclock* 0)

(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")
;connection, object, path, interface

(defun desired-angle-by-position (x y)
    "calculates angle ship should reach to enter orbiting circle around fortress using worldsurf coordinates"
    (let ((distance (sqrt (+ (expt (- x 355) 2) (expt (- y 313) 2))))
          (angle-to-tan (asin (/ 140 (sqrt (+ (expt (- x 355) 2) (expt (- y 313) 2))))))
          (angle-from-x (atan (- 313 y) (- 355 x))))
        (if (< distance 140)
            (mod (- 120 (/ (* 3 distance) 14) (* angle-from-x 57.2957795)) 360) ;looking for a reason not to use LISP? Go infix!
            (mod (* 57.2957795 (- angle-to-tan angle-from-x)) 360))))

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

(defmethod pygame-screen-process ((self pygame-screen)
                                  ;ship coordinates
                                  (ship-x number)
                                  (ship-y number)
                                  (ship-angle number))
;called from python, gets attributes, returns actions
;python actually sends a string of a list of arguments: '("blah")'
;this is where we update the device members
;continue to setf the-device to a new pairlis? ick.
    (setf the-device
        (pairlis
            (define-chunks-fct
                `((isa visual-location screen-x ,ship-x screen-y ,ship-y kind ship value ,ship-angle)))
            (define-chunks-fct
                 `((isa visual-object value ,ship-angle)))))
                 
    (install-device the-device)
    
    (format nil "~a ~a" *joyx* *joyy*))

;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 (soon?)
;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"))))
    
;mouse is irrelevant at this point
(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 fly ()
    
    (defvar visual-location-chunks
        (define-chunks
               (isa visual-location screen-x 0 screen-y 0 kind ship value nil)))

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

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

    (install-device the-device)
    
    (run-until-condition (lambda () nil) :real-time t)
)

(clear-all)

(define-model flight-demo

;a ridiculously high visual movement tolerance because it wraps around the screen. Might have to do something about that
;anticipate eye movement?
(sgp :trace-detail high :visual-movement-tolerance 30.0)

(chunk-type standard-flight-pattern state shipx shipy shipangle targetangle)
(chunk-type (ship (:include visual-object)))

(add-dm
 (first-goal ISA standard-flight-pattern state begin))

(p start
  =goal>
    ISA          standard-flight-pattern
    state        begin
==>
  =goal>
    state        attend-ship
  +visual-location>
    ISA          visual-location
    kind         ship
)

(p attend-to-nothing
  =goal>
    ISA          standard-flight-pattern
    state        attend-ship
  =visual-location>
    ISA          visual-location
    kind         ship
    value        nil
==>
  =goal>
    state        hold
)

(p holding-pattern
  =goal>
    ISA          standard-flight-pattern
    state        hold
==>
  =goal>
    state begin
)

(p attend-ship
  =goal>
    ISA          standard-flight-pattern
    state        attend-ship
  =visual-location>
    ISA          visual-location
    kind         ship
  - value        nil
    screen-x     =shipx
    screen-y     =shipy
  ?visual>
    state        free
==>
  +visual>
    ISA          move-attention
    screen-pos   =visual-location
  =goal>
    state        encode-ship
    shipx        =shipx
    shipy        =shipy
)

(p encode-ship
  =goal>
    ISA          standard-flight-pattern
    state        encode-ship
    shipx        =shipx
    shipy        =shipy
  =visual>
    ISA          visual-object
    value        =angle
==>
  !safe-bind! =target (desired-angle-by-position =shipx =shipy)
  =goal>
    shipangle    =angle
    targetangle  =target
    state        adjust-trajectory
)

(p turn-counter-clockwise-normal
  =goal>
    ISA          standard-flight-pattern
    state        adjust-trajectory
    shipangle    =current
    targetangle  =target
    !eval!       (and (> =target =current) (< (- =target =current) 177))
==> 
  !eval! (setf *joyx* -0.3)
  !eval! (setf *joyy* 0)
  =goal>
    state        begin
)

(p turn-clockwise-normal
  =goal>
    ISA          standard-flight-pattern
    state        adjust-trajectory
    shipangle    =current
    targetangle  =target
    !eval!       (and (< =target =current) (< (- =current =target) 177))
==> 
  !eval! (setf *joyx* 0.3)
  !eval! (setf *joyy* 0)
  =goal>
    state        begin
)

(p turn-counter-clockwise-backwards
  =goal>
    ISA          standard-flight-pattern
    state        adjust-trajectory
    shipangle    =current
    targetangle  =target
    !eval!       (and (< =target =current) (> (- =current =target) 177))
==> 
  !eval! (setf *joyx* -0.3)
  !eval! (setf *joyy* 0)
  =goal>
    state        begin
)

(p turn-clockwise-backwards
  =goal>
    ISA          standard-flight-pattern
    state        adjust-trajectory
    shipangle    =current
    targetangle  =target
    !eval!       (and (> =target =current) (> (- =target =current) 177))
==> 
  !eval! (setf *joyx* 0.3)
  !eval! (setf *joyy* 0)
  =goal>
    state        begin
)

(p thrust
  =goal>
    ISA          standard-flight-pattern
    state        adjust-trajectory
    shipangle    =current
    targetangle  =target
    !eval!       (< (abs (- =target =current)) 6)
==>
  !eval! (setf *joyx* 0)
  !eval! (setf *joyy* -0.2)
  =goal>
    state        begin
)

(goal-focus first-goal)
)