;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;         ACT-R 5.0 Model of a spatial orientation task
;;;                         Version WEB
;;;               Monday, February, 3, 2002, 7:00 PM
;;;
;;;(c) 2002, Glenn Gunzelmann
;;;
;;;     Requirements:
;;;
;;; 1. Macintosh Common Lisp 4.3 (or higher)
;;; 2. ACT-R 5.0 with RPM v2.1b4 or higher
;;;    -Available at http://act.psy.cmu.edu/ACT-R_5.0/
;;;     or at http://chil.rice.edu/byrne/RPM/download.html
;;;    -There were several bugs in previous versions which may
;;;     cause the model to run improperly or not at all
;;; 4. Will only run on a Macintosh with these components installed
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;                    Running the Model:
;;;
;;; 1. Open MCL 4.3 (or higher)
;;; 2. Load ACT-R 5.0 (with RPM v2.1b4 or higher
;;;    -http://chil.rice.edu/byrne/RPM/download.html
;;; 3. Load this file
;;; 4. Call (run-block n)
;;;    -Where n is the number of participants
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Global variables used in the simulation
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *targets* nil)

(defparameter *directions* nil)

(defparameter *experiment-window* nil)

(defparameter *start-trial-time* 0)

(defparameter *model-data* nil)

(defparameter *trialnum* 0)

(defparameter *tgt* 0)

(defparameter *pln* 0)

(defparameter *participant* 0)

(defparameter *angles* '(0 45 90 135 180 225 270 315))

(defparameter *x1* 0)

(defparameter *y1* 0)

(defparameter *x2* 0)

(defparameter *y2* 0)

(defparameter *correct-answers* '(s sw w nw n ne e se
                                  sw w nw n ne e se s
                                  w nw n ne e se s sw
                                  nw n ne e se s sw w
                                  n ne e se s sw w nw
                                  ne e se s sw w nw n
                                  e se s sw w nw n ne
                                  se s sw w nw n ne e))

(defparameter *trial-set* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Participant data
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *data-camera* '(2.21 2.34 2.52 2.69 2.70 2.58 2.38 2.32))
(defparameter *data-target* '(1.68 2.26 2.77 3.13 1.77 3.17 2.65 2.32))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Statistical functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun mean-dev (data model)
  (let ((measure 0.000))
    (if (equal (length data) (length model))
        (dotimes (i (length data))
          (setf measure (+ (* (- (nth i data) (nth i model))
                              (- (nth i data) (nth i model)))
                           measure))))
        (setf measure (sqrt (/ measure (length data))))
      (format t "Mean-deviation (RMSD): ~d~%" measure)))

(defun corr (data model)
  (let ((sum-products 0)
        (mean-d 0)
        (mean-m 0)
        (val1 0)
        (val2 0)
        (val3 0))
    (dotimes (i (length data))
      (setf val1 (+ (* (nth i data)
                       (nth i model))
                    val1))
      (setf val2 (+ (nth i data) val2))
      (setf val3 (+ (nth i model) val3)))
    (setf sum-products (- val1 (/ (* val2 val3) (length data))))
    (setf mean-d (/ val2 (length data)))
    (setf mean-m (/ val3 (length model)))
    (setf val2 0)
    (setf val3 0)
    (dotimes (i (length data))
      (setf val2 (+ (* (- (nth i data) mean-d)
                       (- (nth i data) mean-d))
                    val2))
      (setf val3 (+ (* (- (nth i model) mean-m)
                       (- (nth i model) mean-m))
                    val3)))
    (setf val1 (sqrt (* val2 val3)))
    (format t "Correlation:  ~d~%~%" (/ sum-products val1))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;   Code for the experiment delivery, etc.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass glenns-window (color-dialog)
  ())

(defmethod device-handle-keypress ((win glenns-window) key)
  (let (*key-pressed-was* *response-time*)
    (setf *key-pressed-was* 
          (cond ((equal key #\2) 'S)
                ((equal key #\1) 'SW)
                ((equal key #\4) 'W)
                ((equal key #\7) 'NW)
                ((equal key #\8) 'N)
                ((equal key #\9) 'NE)
                ((equal key #\6) 'E)
                ((equal key #\3) 'SE)
                (t 'ERROR)))
    (setf *response-time* (- (pm-get-time) *start-trial-time*))
    (setf (aref *model-data* *participant* *tgt* *pln* 0) *trialnum*)
    (setf (aref *model-data* *participant* *tgt* *pln* 1) (* *tgt* 45))
    (setf (aref *model-data* *participant* *tgt* *pln* 2) (* *pln* 45))
    (setf (aref *model-data* *participant* *tgt* *pln* 3) *key-pressed-was*)
    (setf (aref *model-data* *participant* *tgt* *pln* 4) *response-time*)
    ))

(defun make-window ()
  (setf *experiment-window* 
        (make-instance
          'glenns-window
          :window-type
          :movable-dialog
          :view-position
          ':centered
          :window-title
          "Display"
          :view-size
          #@(980 700)
          :close-box-p
          nil
          :view-font
          '("Chicago" 12 :srcor :plain (:color-index 0))
          :view-subviews
          (append 
           (setf *targets* 
                 (list 
                  (make-dialog-item 'static-text-dialog-item
                    #@(227 507) #@(30 36) "O" 'nil
                    :view-nick-name 't000
                    :part-color-list '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(107 459) #@(30 36) "O" 'nil
                    :view-nick-name 't045
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(56 337) #@(30 36) "O" 'nil
                    :view-nick-name 't090
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(105 217) #@(30 36) "O" 'nil
                    :view-nick-name 't135
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(228 166) #@(30 36) "O" 'nil
                    :view-nick-name 't180
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(347 217) #@(30 36) "O" 'nil
                    :view-nick-name 't225
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(397 337) #@(30 36) "O" 'nil
                    :view-nick-name 't270
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                  (make-dialog-item 'static-text-dialog-item
                    #@(346 458) #@(30 36) "O" 'nil
                    :view-nick-name 't315
                    :part-color-list
                    '(:text 0)
                    :view-font '("Arial" 36 :srcor :bold (:color-index 0)))))
           (setf *directions*
                 (list (make-dialog-item 'static-text-dialog-item
                         #@(719 407) #@(30 36) "S" 'nil
                         :view-nick-name 'S
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(552 406) #@(60 36) "SW" 'nil
                         :view-nick-name 'SW
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(551 244) #@(40 36) "W" 'nil
                         :view-nick-name 'W
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(552 82) #@(66 36) "NW" 'nil
                         :view-nick-name 'NW
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(719 82) #@(30 36) "N" 'nil
                         :view-nick-name 'N
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(855 83) #@(56 36) "NE" 'nil
                         :view-nick-name 'NE
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(882 242) #@(30 36) "E" 'nil
                         :view-nick-name 'E
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(856 405) #@(56 36) "SE" 'nil
                         :view-nick-name 'SE
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 36 :srcor :bold (:color-index 0))))))
          )))

;;Adds some of the non-essential elements to display
(defmethod view-draw-contents :after ((w glenns-window))
  (move-to *experiment-window* 500 0)
  (line-to *experiment-window* 500 700)
  (move-to *experiment-window* 242 640)
  (line-to *experiment-window* 242 560)
  (frame-oval *experiment-window* 720 255 740 275)
  (frame-rect *experiment-window* 200 650 285 680)
  (frame-rect *experiment-window* 135 50 355 110)
  (frame-rect *experiment-window* 540 600 730 690)
  (move-to *experiment-window* *x1* *y1*)
  (line-to *experiment-window* *x2* *y2*)
  )

;;Adds the rest of the non-essential elements to display
(defun add-eye-candy ()
  (add-subviews *experiment-window* 
                       (make-dialog-item 'static-text-dialog-item
                         #@(210 650) #@(65 30) "Plane" 'nil
                         :view-nick-name 'plane
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 24 :srcor :plain (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(145 50) #@(200 60) "View from camera
mounted on plane" 'nil
                         :view-nick-name 'cam-label
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 24 :srcor :plain (:color-index 0)))
                       (make-dialog-item 'static-text-dialog-item
                         #@(550 600) #@(180 90) "In which
direction is the
RED object?" 'nil
                         :view-nick-name 'map-label
                         :part-color-list
                         '(:text 0)
                         :view-font '("Arial" 24 :srcor :plain (:color-index 0)))
    ))

;;makes a list of the possible trials
(defun make-trials ()
  (dotimes (plane 8)
    (dotimes (target 8)
      (setf *trial-set* (cons (list (* plane 45) (* target 45)) *trial-set*))
      ))
)

(make-trials)

;;Removes targets and cardinal directions from screen to reset trial
(defun remove-items ()
  (dotimes (i 8)
    (remove-subviews *experiment-window* (nth i *targets*))
    (remove-subviews *experiment-window* (nth i *directions*))
    ))

;;Places targets and cardinal directions on screen.
(defun place-items ()
  (dotimes (i 8)
    (add-subviews *experiment-window* (nth i *targets*))
    (add-subviews *experiment-window* (nth i *directions*))
    ))

;;Makes all targets and directions black (resets trial)
(defun make-all-black ()
  (dotimes (i 8)
    (set-part-color (nth i *targets*) :text 0)
    (set-part-color (nth i *directions*) :text 0)
    ))

;;Sets coordinates for endpoints of plane's vector
(defun draw-line (pln)
  (erase-rect *experiment-window* 600 125 865 405)
  (cond ((equal pln 0) (setf *x1* 730) (setf *x2* 730) (setf *y1* 400) (setf *y2* 275))
        ((equal pln 1) (setf *x1* 600) (setf *x2* 720) (setf *y1* 400) (setf *y2* 275))
        ((equal pln 2) (setf *x1* 600) (setf *x2* 720) (setf *y1* 265) (setf *y2* 265))
        ((equal pln 3) (setf *x1* 600) (setf *x2* 720) (setf *y1* 125) (setf *y2* 255))
        ((equal pln 4) (setf *x1* 730) (setf *x2* 730) (setf *y1* 125) (setf *y2* 255))
        ((equal pln 5) (setf *x1* 860) (setf *x2* 740) (setf *y1* 125) (setf *y2* 255))
        ((equal pln 6) (setf *x1* 860) (setf *x2* 740) (setf *y1* 265) (setf *y2* 265))
        ((equal pln 7) (setf *x1* 860) (setf *x2* 740) (setf *y1* 400) (setf *y2* 275))
        (t (setf *x1* 0) (setf *x2* 980) (setf *y1* 0) (setf *y2* 700))))

;;Runs model n times on one block of trials
;;Trials are presented in random order
(defun run-block (n)
  (let ((num n))
    (setf *model-data* (make-array (list n 8 8 5)))
    (make-window)
    (add-eye-candy)
    (pm-install-device *experiment-window*)
    (loop
      (let ((trials *trial-set*)
            (trial nil))   
        (cond ((equal n 0) (return t)))
        (setf n (1- n))
        (setf *participant* n)
        (setf *trialnum* 0)
        (loop
          (cond ((equal trials nil) (return t)))
          (setf trial (nth (random (length trials)) trials))
          (setf *trialnum* (1+ *trialnum*))
          (setf *pln* (/ (car trial) 45))
          (setf *tgt* (/ (cadr trial) 45))
          (draw-line *pln*)
          (remove-items)
          (make-all-black)
          (pm-proc-display)
          (place-items)
          (draw-line *pln*)
          (view-draw-contents *experiment-window*)
          (set-part-color (nth *tgt* *targets*) :text 14485510)
          (set-part-color (nth *pln* *directions*) :text 14485510)
          (pm-proc-display)
          (setf *start-trial-time* (pm-get-time))
          (mod-chunk trial t-side nil t-height nil t-cur nil p-cur nil count nil step nil answer nil)
          (pm-run 100)
          (setf trials (remove trial trials))
          )))
    (dostats num)))

;;Calculates statistics for model run
;;and prints out data to screen
(defun dostats (n)
  (let ((temp nil)
        (pln-time 0)
        (tgt-time 0)
        (plns nil)
        (tgts nil)
        (model-answers nil))
    (dotimes (x 8)
      (dotimes (y 8)
        (dotimes (z n)
          (setf pln-time (+ (aref *model-data* z y x 4) pln-time))
          (setf tgt-time (+ (aref *model-data* z x y 4) tgt-time))))
      (setf plns (cons (/ (/ pln-time 8000.0) n) plns))
      (setf tgts (cons (/ (/ tgt-time 8000.0) n) tgts))
      (setf pln-time 0)
      (setf tgt-time 0))
    (setf plns (reverse plns))
    (setf tgts (reverse tgts))
    (dotimes (z n)
      (dotimes (x 8)
        (dotimes (y 8)
          (setf temp (cons (aref *model-data* z x y 3) temp))))
      (setf model-answers (cons temp model-answers))
      (setf temp nil)
      )
    (setf temp t)    
    (format t "~%All answers correct? ~d" 
            (loop
              (cond ((null temp) (return 'no))
                    ((null model-answers) (return 'yes)))
              (setf temp (equal (reverse (car model-answers)) *correct-answers*))
              (setf model-answers (cdr model-answers))))
    (format t "~%~%~c~cRESPONSE TIMES" #\tab #\tab)
    (format t "~%~%Target Angle~%~%~cAngle~cData~cModel~%"  #\tab #\tab #\tab)
    (dotimes (i 8)
      (format t "~c~d~c~d~c~d~%" #\tab
              (nth i *angles*) #\tab
              (nth i *data-target*) #\tab
              (nth i tgts)))
    (format t "~%~%Camera Angle~%~%~cAngle~cData~cModel~%"  #\tab #\tab #\tab)
    (dotimes (i 8)
      (format t "~c~d~c~d~c~d~%" #\tab
              (nth i *angles*) #\tab
              (nth i *data-camera*) #\tab
              (nth i plns)))
    (format t "~%")
    (mean-dev (append *data-target* *data-camera*) (append tgts plns))
    (corr (append *data-target* *data-camera*) (append tgts plns))
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  color-text.lisp code needed for ACT-R/PM to recognize
;;;    the color of text items on the screen
;;;
;;;  Doesn't load automatically with ACT-R/PM, so it is included here.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  -*- mode: LISP; Package: CL-USER; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Mike Byrne
;;; Copyright   : (c)2000-1 Rice U./Mike Byrne, All Rights Reserved
;;; Availability: public domain
;;; Address     : Rice University
;;;             : Psychology Department
;;;             : Houston,TX 77251-1892
;;;             : byrne@acm.org
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : color-text.lisp
;;; Version     : r2
;;; 
;;; Description : Add-on to support colored text in standard MCL dialog
;;;             : items.
;;; 
;;; Bugs        : 
;;; 
;;; Todo        : This should really be rolled into BUILD-STRING-FEATS so
;;;             : it can work everywhere.
;;; 
;;; ----- History -----
;;; 00.03.10 Mike Byrne
;;;             :  Incept date.
;;; 01.07.03 mdb
;;;             : Changed to use Dan's color convention.
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod build-features-for :around ((self static-text-dialog-item)
                                          (vis-mod vision-module))
  (let ((feats (call-next-method))
        (color (mcl-color->symbol (part-color self :text))))
    (mapcar #'(lambda (f)
                (setf (color f) color)
                f)
            feats)))

(defun mcl-color->symbol (mcl-color)
  "Given an MCL color code, return a symbol representing that color.  Unknown colors get mapped to COLOR-RRRRR-GGGGG-BBBBB."
  (if mcl-color
      (case mcl-color
        (#.*green-color* 'green)
        (#.*red-color* 'red)
        (#.*blue-color* 'blue)
        (#.*brown-color* 'brown)
        (#.*purple-color* 'purple)
        (#.*pink-color* 'pink)
        (#.*orange-color* 'orange)
        (#.*dark-gray-color* 'dark-gray)
        (#.*light-blue-color* 'light-blue)
        (#.*white-color* 'white)
        (#.*light-gray-color* 'light-gray)
        (#.*dark-green-color* 'dark-green)
        (#.*tan-color* 'tan)
        (#.*yellow-color* 'yellow)
        (0 'black)
        (otherwise (intern (format nil "COLOR-~5,'0d-~5,'0d-~5,'0d" 
                                   (color-red mcl-color) 
                                   (color-green mcl-color) 
                                   (color-blue mcl-color)))))
      'black))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Model Code
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;<a name="model">
;;;</a>
;;; Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(clear-all)
(pm-reset)

(setf *actr-enabled-p* t)
(setf *latency-fn* 'old-latency)

(sgp :er t :esc t :ga 1.0 :lf .05 :v nil)

(pm-set-params :real-time nil :show-focus nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The following are set to nil above.
;;
;; (pm-set-params :real-time t)
;;   -Causes model to run in real-time
;;
;; (pm-set-params :show-focus t)
;;   -Will show the current location of the eye's fixation
;;
;; (sgp :v t)
;;   -Will print the model trace to the active listener
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Chunk-types and declarative memory
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(chunk-type trial t-side t-height t-cur p-cur count strategy step answer)
(chunk-type angle plane target vertex)
(chunk-type cardinal name loc-x loc-y next-l next-r opposite)
(chunk-type target loc-x loc-y side height aligned)
(chunk-type number value next)
(chunk-type side value opposite)
(chunk-type key number direction)

(add-dm (trial isa trial t-side nil t-height nil t-cur nil p-cur nil count nil strategy count step nil answer nil)
        (ang isa angle plane nil target nil vertex nil)
        (centercam isa visual-location screen-x 242 screen-y 361)
        (centermap isa visual-location screen-x 732 screen-y 267)
        (south     isa cardinal name "s"  loc-x 732 loc-y 431 next-l "sw" next-r "se" opposite "n" )
        (southwest isa cardinal name "sw" loc-x 582 loc-y 430 next-l "w"  next-r "s"  opposite "ne")
        (west      isa cardinal name "w"  loc-x 569 loc-y 268 next-l "nw" next-r "sw" opposite "e" )
        (northwest isa cardinal name "nw" loc-x 583 loc-y 106 next-l "w"  next-r "n"  opposite "se")
        (north     isa cardinal name "n"  loc-x 733 loc-y 106 next-l "nw" next-r "ne" opposite "s" )
        (northeast isa cardinal name "ne" loc-x 881 loc-y 107 next-l "n"  next-r "e"  opposite "sw")
        (east      isa cardinal name "e"  loc-x 895 loc-y 266 next-l "se" next-r "ne" opposite "w" )
        (southeast isa cardinal name "se" loc-x 881 loc-y 429 next-l "s"  next-r "e"  opposite "nw")
        (r1 isa key number 2 direction "s" )
        (r2 isa key number 1 direction "sw")
        (r3 isa key number 4 direction "w" )
        (r4 isa key number 7 direction "nw")
        (r5 isa key number 8 direction "n" )
        (r6 isa key number 9 direction "ne")
        (r7 isa key number 6 direction "e" )
        (r8 isa key number 3 direction "se")
        (T000 isa target loc-x 242 loc-y 531 side left  height 0 aligned "s" )
        (T045 isa target loc-x 122 loc-y 483 side left  height 1 aligned "sw")
        (T090 isa target loc-x  71 loc-y 361 side left  height 2 aligned "w" )
        (T135 isa target loc-x 120 loc-y 241 side left  height 3 aligned "nw")
        (T180 isa target loc-x 243 loc-y 190 side left  height 4 aligned "n" )
        (T225 isa target loc-x 362 loc-y 241 side right height 3 aligned "ne")
        (T270 isa target loc-x 412 loc-y 361 side right height 2 aligned "e" )
        (T315 isa target loc-x 361 loc-y 482 side right height 1 aligned "se")
        (left  isa side value  left opposite right)
        (right isa side value right opposite  left)
        (zero  isa number value 0)
        (one   isa number value 1 next 0)
        (two   isa number value 2 next 1)
        (three isa number value 3 next 2)
        (four  isa number value 4 next 3)
        )

(goal-focus trial)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Productions for finding and encoding the target in the camera view
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  finds the red object on the left side of the screen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p find-target
   =goal>
      isa trial
      t-side nil
      t-height nil
      t-cur nil
      p-cur nil
      count nil
      step nil
      answer nil
      strategy =strategy
   =visual-state>
      isa module-state
      modality free
==>
   +visual-location>
      isa visual-location
    < screen-x 500
      color red  ;Color-65535-09252-12850
   =goal>
      step attend
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Attends the target location on the camera view.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p attend-target
   =goal>
      isa trial
      t-side nil
      t-height nil
      t-cur nil
      p-cur nil
      count nil
      step attend
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
      screen-y =y
      screen-x =x
      color red
==>
   +visual>
      isa visual-object
      screen-pos =visual-location
   +retrieval>
      isa target
      loc-x =x
      loc-y =y
   =goal>
      step encode
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodes the side (left or right) of the target on the target field
;;   and the height (0 to 4) or the target, as well as the cardinal
;;   direction its location maps onto if the two views are aligned
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p encode-target-direction
   =goal>
      isa trial
      t-side nil
      t-height nil
      t-cur nil
      p-cur nil
      count nil
      step encode
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
      screen-x =x
      screen-y =y
      color red
   =visual>
      isa visual-object
      screen-pos =visual-location
   =retrieval>
      isa target
      loc-x =x
      loc-y =y
      side =side
      height =height
      aligned =aligned
==>
   =goal>
      t-side =side
      t-height =height
      t-cur =aligned
      step nil
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Productions for finding and encoding the plane's location
;;     in the map view
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Finds the location of the plane (red item) on the right side
;;     of the screen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p find-plane
   =goal>
      isa trial
      t-side =side
      t-height =height
      t-cur =aligned
      p-cur nil
      count nil
      step nil
      answer nil
      strategy =strategy
   =visual-state>
      ISA         module-state
      modality    free
==>
   +visual-location>
      isa visual-location
    > screen-x 500
      color red
   =goal>
      step attend
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Focuses attention on the plane's location and calls for a retrieval
;;    of the cardinal direction chunk from that location
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p move-attention-to-plane
   =goal>
      isa trial
      t-side =side
      t-height =height
      t-cur =aligned
      p-cur nil
      count nil
      step attend
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      color red
    - attended t
   =visual-state>
      ISA            module-state
      modality    free
==>
   +visual>
      ISA         visual-object
      screen-pos =visual-location
   +retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
   =goal>
      step encode
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodes the plane's location as a Cardinal direction
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p encode-plane-location
   =goal>
      isa trial
      t-side =side
      t-height =height
      t-cur =aligned
      p-cur nil
      count nil
      step encode
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      color red
      attended t
   =visual>
      ISA   visual-object
      value =direction
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =direction
==>
   =goal>
      p-cur =direction
      step solve
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Special productions for "easy" trials
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fires when the plane is at South - Calls for the retrieval of the
;;    Cardinal direction associated with the target position
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p Plane-at-bottom
   =goal>
      isa trial
      t-side =side
      t-height =height
      t-cur =aligned
      p-cur "s"
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      color red
   =visual>
      ISA   visual-object
      value "s"
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name "s"
==>
   +retrieval>
      isa cardinal
      name =aligned
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Moves attention to the retrieved Cardinal location.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p Plane-at-bottom-2
   =goal>
      isa trial
      t-side =side
      t-height =height
      t-cur =aligned
      p-cur "s"
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      color red
   =visual>
      ISA   visual-object
      value "s"
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =aligned
      loc-x =x
      loc-y =y
==>
   +visual-location>
      isa visual-location
      screen-x =x
      screen-y =y
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodes the Cardinal direction as the current location and sets
;;   the count to 0, indicating that the current location is the
;;   correct response
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p Plane-at-bottom-3
   =goal>
      isa trial
      t-side =side
      t-height =height
      t-cur =aligned
      p-cur "s"
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
      screen-x =x
      screen-y =y
   =visual>
      ISA   visual-object
    - screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =aligned
      loc-x =x
      loc-y =y
==>
   +visual>
      isa visual-object
      screen-pos =visual-location
   =goal>
      t-height 0
      p-cur =aligned
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; When the target is opposite the plane, this production
;; fires to retrieve the cardinal direction opposite the
;; plane's position.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p target-at-top
   =goal>
      isa trial
      t-side =side
      t-height 4
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      color red
   =visual>
      ISA      visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =current
      opposite =dir
==>
   +retrieval>
      isa cardinal
      name =dir
      opposite =current
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Moves attention to the cardinal direction opposite the
;;   plane's position.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p target-at-top-2
   =goal>
      isa trial
      t-side =side
      t-height 4
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      color red
   =visual>
      ISA   visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =opposite
      opposite =current
      loc-x =x
      loc-y =y
==>
   +visual-location>
      isa visual-location
      screen-x =x
      screen-y =y
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodes the Cardinal direction as the current location and sets
;;   the count to 0, indicating that the current location is the
;;   correct response
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p target-at-top-3
   =goal>
      isa trial
      t-side =side
      t-height 4
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =s
      screen-y =y
   =visual>
      ISA   visual-object
      value =current
    - screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =opposite
      opposite =current
      loc-x =x
      loc-y =y
==>
   +visual>
      isa visual-object
      screen-pos =visual-location
   =goal>
      t-height 0
      p-cur =opposite
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Determining the search direction in the map view
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; If the plane is not past horizontal, do not switch the search
;;   direction
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p Start-no-switch
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
    > screen-y 200
      attended t
   =visual>
      ISA   visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =current
==>
   =goal>
      count no
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; If the plane is at NW, N, or NE, change the direction of search
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p start-change-direction
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
    < screen-y 200
      attended t
   =visual>
      ISA   visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      name =current
==>
   =goal>
      count yes
   +retrieval>
      isa side
      value =side
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Changes the search direction
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p change-search-direction
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count yes
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
    < screen-y 200
      screen-x =x
      screen-y =y
      attended t
   =retrieval>
      isa side
      value =side
      opposite =new
==>
   =goal>
      count =side
      t-side =new
   +retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Uses the currently attended cardinal location and the
;; direction of counting to determine which point is next
;; toward the left
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p choose-search-direction-left
   =goal>
      isa trial
      t-side left
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count =count
    - count yes
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      attended t
   =visual>
      isa visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
      name =current
      next-l =next
==>
   +retrieval>
      isa cardinal
      name =next
      )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Uses the currently attended cardinal location and the
;; direction of counting to determine which point is next
;; toward the right
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p choose-search-direction-right
   =goal>
      isa trial
      t-side right
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count =count
    - count yes
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      attended t
   =visual>
      isa visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
      name =current
      next-r =next
==>
   +retrieval>
      isa cardinal
      name =next
      )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Once the appropriate Cardinal direction is retrieved, this
;;   production puts that location in the visual-location buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p locate-new-direction
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count =count
    - count yes
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      attended t
   =visual>
      isa visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =newx
      loc-y =newy
      name =next
    - name =current
==>
   +visual-location>
      isa visual-location
      screen-x =newx
      screen-y =newy
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Once the appropriate Cardinal direction is retrieved and the
;;   location identified in the visual-location buffer, this
;;   production moves attention to that location
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p attend-new-direction
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count =count
    - count yes
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
   =visual>
      isa visual-object
      value =current
    - screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
      name =next
    - name =current
==>
   +visual>
      isa visual-object
      screen-pos =visual-location
      )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodes the new Cardinal direction when the search direction was
;;   not switched in order to find it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p encode-new-direction-ok
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count no
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      attended t
   =visual>
      isa visual-object
      value =next
    - value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
      name =next
    - name =current
==>
   =goal>
      p-cur =next
      count nil
   +retrieval>
      isa number
      value =height
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodes the new Cardinal direction when the search direction was
;;   switched in order to find it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p encode-new-direction-switch-back
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count =count
    - count no
    - count yes
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      attended t
   =visual>
      isa visual-object
      value =next
    - value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
      name =next
    - name =current
==>
   =goal>
      p-cur =next
      count nil
      t-side =count
   +retrieval>
      isa number
      value =height
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; After the new Cardinal direction is encoded, the count is
;;   incremented
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p increment-count
   =goal>
      isa trial
      t-side =side
      t-height =height
    - t-height 4
    - t-height 0
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      screen-x =x
      screen-y =y
      attended t
   =visual>
      isa visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa number
      value =height
      next =next
==>
   =goal>
      t-height =next
   +retrieval>
      isa cardinal
      name =current
   )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Response Productions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; When the count decrements to 0, the cardinal direction of the
;; currently encoded direction is stored as the response
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p encode-response-direction
   =goal>
      isa trial
      t-side =side
      t-height 0
      t-cur =aligned
      p-cur =current
      count nil
      step solve
      answer nil
      strategy =strategy
   =visual-location>
      isa visual-location
    > screen-x 500
      attended t
   =visual>
      isa visual-object
      value =current
      screen-pos =visual-location
   =retrieval>
      isa cardinal
      loc-x =x
      loc-y =y
      name =current
==>
   =goal>
      step respond
   +retrieval>
      isa key
      direction =current
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Maps the cardinal direction to the correct response
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p map-response
   =goal>
      isa trial
      step respond
      answer nil
      strategy =strategy
   =retrieval>
      ISA                  key
      number =ans
      direction =direction
==>
   =goal>
      t-side nil
      t-height nil
      t-cur nil
      p-cur nil
      count nil
      step respond
      answer =ans
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Issues the motor command to press the response key
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; *Currently, responses are made by the model using the
;; number row at the top of the keyboard.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(p make-response
   =goal>
      isa trial
      t-side nil
      t-height nil
      t-cur nil
      p-cur nil
      count nil
      step respond
      answer =ans
      strategy =strategy
   =manual-state>
      isa module-state
      modality free
   =visual-state>
      ISA         module-state
      modality    free
==>
   =goal>
      answer nil
      step done
   +manual>
      isa press-key
      key =ans
      !send-command! :vision clear
   )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Production Parameters
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

    (spp encode-target-direction :effort .7)

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