(defvar *trials*)
(defvar *results*)
(defvar *start-time*)
(defvar *block*)
(defvar *show-window*)

(defconstant *flanker-data* '(500 800))

(defstruct trial block target flanker congruency answer visible)
(defstruct response block congruency correct time)

(defun present-trial (trial)
  (let ((window (open-exp-window "Flanker Experiment" :visible (trial-visible trial))))
    
    (add-text-to-exp-window :text (trial-target trial) :x 125 :y 150 :width 25)
    (add-text-to-exp-window :text (trial-flanker trial) :x 100 :y 150 :width 25)
    (add-text-to-exp-window :text (trial-flanker trial) :x 150 :y 150 :width 25)

    (install-device window)
    (proc-display :clear t)
    
    (setf *start-time* (get-time))
    window))


(defmethod rpm-window-key-event-handler ((win rpm-window) key)
  (let ((trial (pop *trials*)))
    (push (make-response :block (trial-block trial)
                         :congruency (trial-congruency trial)
                         :correct (string-equal (trial-answer trial) (string key))
                         :time (/ (- (get-time) *start-time*) 1000.0))
          *results*)
    (when *trials*
      (present-trial (first *trials*)))))


(defun collect-responses (trial-count)
  (setf *results* nil)
  (let ((window (present-trial (first *trials*))))
    (if *actr-enabled-p*
        (run (* 10 trial-count))
      
      (while (< (length *results*) trial-count)
        (allow-event-manager window)))))


(defun do-trial (target flanker congruency answer &optional (visible (not *actr-enabled-p*)))
  (setf *show-window* visible)
  (setf *block* 1)
  (setf *trials* (list (construct-trial (list target flanker congruency answer))))
  (collect-responses 1))
  ;(analyse-results))


(defun create-set ()
  (permute-list (mapcar #'construct-trial
                  '(("a" "a" "congruent" "z") ("e" "e" "congruent" "z")
                    ("b" "b" "congruent" "m") ("f" "f" "congruent" "m")
                    ("a" "b" "incongruent" "z") ("e" "f" "incongruent" "z")
                    ("b" "a" "incongruent" "m") ("f" "e" "incongruent" "m")
                    ("a" "a" "congruent" "z") ("e" "e" "congruent" "z")
                    ("b" "b" "congruent" "m") ("f" "f" "congruent" "m")
                    ("a" "b" "incongruent" "z") ("e" "f" "incongruent" "z")
                    ("b" "a" "incongruent" "m") ("f" "e" "incongruent" "m")))))

(defun construct-trial (settings)
  (make-trial :block *block*
              :target (first settings)
              :flanker (second settings)
              :congruency (third settings)
              :answer (fourth settings)
              :visible *show-window*))






;;;(defun do-set (&optional (visible (not *actr-enabled-p*)))
;;;  (setf *show-window* visible)
;;;  (setf *block* 1)
;;;  (setf *trials* (create-set))
;;;  (collect-responses 24)
;;;  (analyse-results))
;;;
;;;(defun do-block (&optional (visible (not *actr-enabled-p*)))
;;;  (setf *show-window* visible)
;;;  (setf *block* 1)
;;;  (setf *trials* nil)
;;;  (dotimes (i 8)
;;;    (setf *trials* (append *trials* (create-set))))
;;;  (collect-responses 192))
;;;  ;(analyse-results))
;;;
;;;(defun do-experiment (&optional (visible (not *actr-enabled-p*)) (display t))
;;;  (reset)
;;;  (setf *show-window* visible)
;;;  (setf *trials* nil)
;;;  (dotimes (j 3)
;;;    (setf *block* (+ j 1))
;;;    (dotimes (i 8)
;;;      (setf *trials* (append *trials* (create-set)))))
;;;  (collect-responses 576)
;;;  (analyse-results display))
;;;
;;;(defun collect-data (n)
;;;  (let ((rts (mapcar #' (lambda (x) (/ x (length results)))
;;;               (apply #'mapcar #'+ (mapcar #'first results))))
;;;        (counts (mapcar #' (lambda (x) (truncate x (length results)))
;;;                  (apply #'mapcar #'+ (mapcar (#'second results)))))
;;;        (correlation rts *flanker-data*)
;;;        (mean-deviation rts *flanker-data*))))





(clear-all)

(define-model flanker

;(sgp :seed (123456 0))
   (sgp :v nil :esc t :rt -2 :lf 0.3 :ans 0.5 :bll 0.5 :act nil :ncnar nil :needs-mouse nil :show-focus t :save-buffer-trace t)
 
  
(chunk-type read-letters state)
(chunk-type array letter parity)
(chunk-type letter-fact letter parity) 
(chunk-type response-type parity response) 

(add-dm
 (start isa chunk) (attend isa chunk)
 (respond isa chunk) (done isa chunk) (retrieve-letter isa chunk)
 (vowel isa chunk) (consonant isa chunk) (retrieve-response isa chunk)
 (a isa chunk) (b isa chunk) (e isa chunk) (f isa chunk) (parity isa chunk) (magnitude isa chunk)
 (goal isa read-letters state start) (m isa chunk) (z isa chunk)
 (a1 isa letter-fact letter "a" parity vowel)
 (a2 isa letter-fact letter "e" parity vowel)
 (a3 isa letter-fact letter "b" parity consonant)
 (a4 isa letter-fact letter "f" parity consonant)
 (left isa response-type parity vowel response z)
 (right isa response-type parity consonant response m))




(P find-unattended-letter
   =goal>
      ISA         read-letters
      state       start
 ==>
   +visual-location>
      ISA         visual-location
      :attended    nil
   =goal>
      state       find-location
)

(P attend-letter
   =goal>
      ISA         read-letters
      state       find-location
   =visual-location>
      ISA         visual-location
   ?visual>
      state        free
   
==>
   +visual>
      ISA         move-attention
      screen-pos  =visual-location
   =goal>
      state       attend
)

(P encode-letter
   =goal>
      ISA         read-letters
      state       attend
   =visual>
      ISA         text
      value       =type
   ?retrieval>
      state       free
==>
   =goal>
      state       retrieve-letter
   +imaginal>
      ISA         array
      letter      =type
   +retrieval>
      ISA         letter-fact
      letter      =type
   !output!       =type
)




(P retrieve-parity
   =goal>
      ISA         read-letters
      state       retrieve-letter
   =retrieval>
      ISA         letter-fact
      letter      =type
      parity      =parresponse
   =imaginal>
      ISA         array
==> 
   =goal>
      state       respond
   =imaginal>
      letter      =parresponse
   +retrieval>
      ISA         response-type
      parity      =parresponse
)   
   
   
   
(P response   
   =goal>
      ISA         read-letters
      state       respond
   =retrieval>
      ISA         response-type
      response    =ans
   ?manual>
      state       free
==>   
   =goal>
      state       start
   +manual>
      ISA         press-key
      key         =ans
      !output!    =ans
)
   
 (goal-focus goal)

(setf *actr-enabled-p* t)
)