;;; 
;;;           ACT-R/A/C Functions
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;;          Author: Isaac Councill
;;;            Created: 10/14/01 
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;

;;;   i. Declare global variables

;;;  ii. Error-Checker Functions

;;; iii. Graph Functions

;;;  iv. Script Functions

;;;   v. Caffeine Interaction


(defvar run-history nil)

(defvar *hr-graph-list* nil)
(defvar *hr-graph-values* nil)
(defvar *co-graph-list* nil)
(defvar *co-graph-values* nil)
(defvar *pep-graph-values* nil)
(defvar *pep-graph-list* nil)


(defvar *answer* nil)
(setf *answer* "6153") 

(defvar *raw-count* 0)

(defvar *count* nil)
(setf *count* "0")

(defvar *run-time* nil)
(setf *run-time* "0") 

(defvar *run-cycles* nil)
(setf *run-cycles* "1000")

(defvar *raw-run-cycles* 1000)

(defvar *stop-time* 240)

(defvar *x-list* nil)
(setf *x-list* '("0" "24" "48" "72" "96" "120" 
		 "144" "168" "192" "216" "240"))

(defvar *appraisal-marker* "Neutral")

(defvar *worry-marker* nil)

;;;
;;;	i.  Interface Functions
;;;


;; Process single-column answers and return quoted answer -
;; this is to obtain compatibility with interface display

(defun proc-ans (str digit var)
  (let ((newvar (proc-var var)))
    (let ((newstr (copy-seq str)))
      (setf (char newstr digit) newvar)
      (setf *answer* newstr)
      *answer*)))

(defun proc-var (var)
  (let ((new nil))
    (cond
     ((equal var 'ZERO) (setf new '#\0))
     ((equal var 'ONE) (setf new '#\1))
     ((equal var 'TWO) (setf new '#\2))
     ((equal var 'THREE) (setf new '#\3))
     ((equal var 'FOUR) (setf new '#\4))
     ((equal var 'FIVE) (setf new '#\5))
     ((equal var 'SIX) (setf new '#\6))
     ((equal var 'SEVEN) (setf new '#\7))
     ((equal var 'EIGHT) (setf new '#\8))
     ((equal var 'NINE) (setf new '#\9))
     (t (format t 
		"Argument to proc-var must be word one through nine~%")))
    new))


;; General parameter trackers

(defun att-counter ()
  (setf *raw-count* (+ *raw-count* 1))
  (setf *count* (write-to-string *raw-count*)))

(defun timer ()
  (setf *run-time* (format nil "~,2F" *time*)))

;; Set the stop-time from user input

(defun set-stop-time ()
  (setf *stop-time* (with-input-from-string
		     (s (gv stop-time :txt :string))
		     (read s))))


;; Updating the Garnet interface

(defun update-interface (num)
  (proc-ans *answer* 0 num)
  (update-ans)
  (att-counter)
  (update-count)
  (timer)
  (update-time)
  (opal:update behavior))

(defun update-ans ()
  (opal:remove-components behav-agg answer)
  (s-value answer :string *answer*)
  (opal:add-components behav-agg answer))

(defun update-count ()
  (opal:remove-components behav-agg noatts)
  (s-value noatts :string *count*)
  (opal:add-components behav-agg noatts))

(defun update-time ()
  (opal:remove-components behav-agg time-info)
  (s-value time-info :string *run-time*)
  (opal:add-components behav-agg time-info))

(defun update-no-wrong ()
  (opal:remove-components behav-agg noerrs)
  (s-value noerrs :string (princ-to-string *no-wrong*))
  (opal:add-components behav-agg noerrs))


;;;  Error-Checker Functions


(defvar units-parse nil)
(defvar tens-parse nil)
(defvar hunds-parse nil)
(defvar thous-parse nil)
(defvar *right-answer* nil)
(defvar *no-wrong* 0)

(defun get-right-answer ()
  (setf *right-answer* (- (with-input-from-string (s *answer*)
				       (read s))
			  7)))

(defun check-answer ()
  (if (equal *right-answer*
	     (with-input-from-string (s *answer*)
				     (read s)))
      (check-right)
      (progn
	(format t "~%OOPS!"
		(setf *no-wrong* (1+ *no-wrong*))
		(update-no-wrong)
		(check-wrong)
		(setf *answer* (princ-to-string *right-answer*))
		(actr-time 4)
		(parse-answer)
		(goal-focus reset-goal)))))

(defun parse-answer ()
  (setf units-parse (r-proc-ans 
		     (princ-to-string (char *answer* 3))))
  (setf tens-parse (r-proc-ans 
		    (princ-to-string (char *answer* 2))))
  (setf hunds-parse (r-proc-ans 
		     (princ-to-string (char *answer* 1))))
  (setf thous-parse (r-proc-ans 
		     (princ-to-string (char *answer* 0)))))

(defun r-proc-ans (sym)
  (cond
   ((equal sym "0") 'zero)
   ((equal sym "1") 'one)
   ((equal sym "2") 'two)
   ((equal sym "3") 'three)
   ((equal sym "4") 'four)
   ((equal sym "5") 'five)
   ((equal sym "6") 'six)
   ((equal sym "7") 'seven)
   ((equal sym "8") 'eight)
   ((equal sym "9") 'nine)
   (t (format t "Number outside range or not in quote"))))

(parse-answer)

;;; Interface Answer-Check

(defun check-wrong ()
  (s-value ex-line1 :visible t)
  (s-value ex-line2 :visible t)
  (opal:update behavior)
  (sleep 0.1)
  (s-value ex-line1 :visible nil)
  (s-value ex-line2 :visible nil)
  (opal:update behavior))

(defun check-right ()
  (s-value chk-line1 :visible t)
  (s-value chk-line2 :visible t)
  (opal:update behavior)
  (sleep 0.1)
  (s-value chk-line1 :visible nil)
  (s-value chk-line2 :visible nil)
  (opal:update behavior))

;;; Worry Indicator

(defun worry-light ()
  (s-value wor-indic :filling-style opal:red-fill)
  (opal:update behavior)
  (sleep 0.3)
  (s-value wor-indic :filling-style opal:motif-blue-fill)
  (opal:update behavior))

;;; Hook Functions

(defun setup-hook-functions ()
  "Config hook functions"
  (setf *cycle-hook-fn* 'cycle-hook-fn))

(defun cycle-hook-fn (&optional instantiation)
  "Call this function after each cycle with the instantiation fired."
  (declare (ignore instantiation))
  (timer)
  (update-time)
  (opal:update behavior))

(setf *init-hook-fn* 'setup-hook-functions)


;;;
;;;  iii. Script Extension
;;;

(defvar script-history 0)

(defun script-go ()
  (do ((i 1 (+ i 1)))
      ((> i 4) 'Script_Done)
      (progn
	(run)
	(incf script-history)
	(enter-script-data script-history)
	(setf *appraisal-marker* (gv post-app-text :string))
	(s-value pre-app-text :string *appraisal-marker*)
	(model-reset)))
  (setf script-history 0)
  (format t "~%~%DONE SCRIPTING~%"))

(defun enter-script-data (hist)
  (cond
   ((equal hist 1)
    (if (equal (gv pre-app-text :string)
	       "Threat")
	(s-value pre1-text :string "T")
      (if (equal (gv pre-app-text :string)
		 "Neutral")
	  (s-value pre1-text :string "N")
	(if  (equal (gv pre-app-text :string)
		    "Challenge")
	    (s-value pre1-text :string "C"))))
      
    (if (equal (gv post-app-text :string)
	       "Threat")
	(s-value post1-text :string "T")
      (if (equal (gv post-app-text :string)
		 "Neutral")
	  (s-value post1-text :string "N")
	(if  (equal (gv post-app-text :string)
		    "Challenge")
	    (s-value post1-text :string "C"))))
    
    (s-value att1-text :string
	     (gv noatts :string))
    
    (s-value err1-text :string
	     (gv noerrs :string)))
   
   ((equal hist 2)
    (if (equal (gv pre-app-text :string)
	       "Threat")
	(s-value pre2-text :string "T")
      (if (equal (gv pre-app-text :string)
		 "Neutral")
	  (s-value pre2-text :string "N")
	(if  (equal (gv pre-app-text :string)
		    "Challenge")
	    (s-value pre2-text :string "C"))))
    
    (if (equal (gv post-app-text :string)
	       "Threat")
	(s-value post2-text :string "T")
      (if (equal (gv post-app-text :string)
		 "Neutral")
	  (s-value post2-text :string "N")
	(if  (equal (gv post-app-text :string)
		    "Challenge")
	    (s-value post2-text :string "C"))))
    
    (s-value att2-text :string
	     (gv noatts :string))
    
    (s-value err2-text :string
	     (gv noerrs :string)))
   
   ((equal hist 3)
    (if (equal (gv pre-app-text :string)
		 "Threat")
	(s-value pre3-text :string "T")
      (if (equal (gv pre-app-text :string)
		 "Neutral")
	  (s-value pre3-text :string "N")
	(if  (equal (gv pre-app-text :string)
		    "Challenge")
	    (s-value pre3-text :string "C"))))
    
    (if (equal (gv post-app-text :string)
	       "Threat")
	(s-value post3-text :string "T")
      (if (equal (gv post-app-text :string)
		 "Neutral")
	  (s-value post3-text :string "N")
	(if  (equal (gv post-app-text :string)
		    "Challenge")
	    (s-value post3-text :string "C"))))
    
    (s-value att3-text :string
	     (gv noatts :string))
    
    (s-value err3-text :string
	     (gv noerrs :string)))
   
   ((equal hist 4)
    (if (equal (gv pre-app-text :string)
	       "Threat")
	(s-value pre4-text :string "T")
      (if (equal (gv pre-app-text :string)
		 "Neutral")
	  (s-value pre4-text :string "N")
	(if  (equal (gv pre-app-text :string)
		    "Challenge")
	    (s-value pre4-text :string "C"))))
    
    (if (equal (gv post-app-text :string)
	       "Threat")
	(s-value post4-text :string "T")
      (if (equal (gv post-app-text :string)
		 "Neutral")
	  (s-value post4-text :string "N")
	(if  (equal (gv post-app-text :string)
		    "Challenge")
	    (s-value post4-text :string "C"))))
    
    (s-value att4-text :string
	     (gv noatts :string))
    
    (s-value err4-text :string
	     (gv noerrs :string)))))

(defun model-reset ()
  (reload)
  (setf *answer* '"6153")
  (setf *raw-count* 0)
  (setf *count* '"0")
  (setf *run-time* '"0")
  (set-stop-time)
  (hide-highlight)
  (update-ans)
  (update-count)
  (update-time)
  (s-value post-app-text :string "")
  (update-all)
  (opal:update script-win))

(defun update-all ()
  (opal:update behavior)
  (opal:update appraisal)
  (opal:update script-win)
  (opal:update control))

(defun script-reset ()
  (s-value pre1-text :string "")
  (s-value post1-text :string "")
  (s-value att1-text :string "")
  (s-value err1-text :string "")
  
  (s-value pre2-text :string "")
  (s-value post2-text :string "")
  (s-value att2-text :string "")
  (s-value err2-text :string "")

  (s-value pre3-text :string "")
  (s-value post3-text :string "")
  (s-value att3-text :string "")
  (s-value err3-text :string "")
  
  (s-value pre4-text :string "")
  (s-value post4-text :string "")
  (s-value att4-text :string "")
  (s-value err4-text :string "")

  (opal:update script-win))