;;;;;TO DO CPJ:
;; [ ]  check function update-workspace-window-new-block (especially the return statement!!!)
;; [X] change definition of: (defmethod add-and-delete-chunk-objects ((chunk T) windowtype)    (2008-03-03)
;;      -> should be able to deal with situations where one object needs to be updated. this can be:
;;       - a gray area for the subwindow (all blocks of the subwindow should be replaced)
;;       - a block or dot that has to be placed at the new coordinate of a previous available dot/block (workspace window)
;; [X] extend functions to workspace & resource window 
;; [X] especially check for workspace window: here the chunks only need to be updated if a dot is changed to a block!!!!
;; [X] resource-window: make sure only does this when act-r enabled   (2008-02-29) -> place check for ACT-R-6.0 at position where chunks are pushed on the list
;; [X] change coordinates of blocks: have to be relative to the window (use convert-position relevant to) (2008-02-29)   -> see example in resource-pane
;; [X] use add-screen-object (and delete-screen-object) instead of proc-display (2008-03-03 done for resource window)
;; [X] pass right color (ACT-R interpretable) (2008-02-29: function get-ACT-R-color-name (color-symbol) ) -> see example in resource-pane
;; [X] add visicon objects for big rectangles      -> done for resource window
;; [X] look at function update-screen (called when you click on a block of resource window to place it)
;; [ ] use (declare (ignore )) to ignore some of the warnings
;; [X] rename windows to be in accordance with papers
;; [ ] make sure every function and variable has comments
;; [X] round values of coordinates of subwindows and subwindow objects

;; [ ] in run-function also include keyword lockout, so model can be used to test more lockouts than the ones used in the experiment

;;DONE:



;;;;;;;;;;;;;;;
;; important comments:
;; (2008-03-03) CPJ: I changed the names of the subwindows in the code, to be consistent with how they are named in publications.
;;                   The three subwindows are now called: resource window (previously also resource window), target window (prev. source window) and workspace window (prev. target window)



#+:multiworld
(require "MultiWorld")
#+:multiworld
(define-logging-folder "~/Desktop/")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Globals
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *lockouts*
  '((A . 0.0) (B . 0.2)
    (C . 0.4) (D . 0.8)
    (E . 1.6) (F . 3.2)
    (M . Nil)))

(defparameter *condition* nil)
(defparameter *recent-lockouts* nil)

(defparameter *trials* 48)

(defparameter *mw-task-object* nil)
(defparameter *bw* nil)                     ;instance of type BW-task

(defparameter *block-colors*
  (list :orange :red :green :blue :purple :light-blue :yellow :black))

(defparameter *block-color-values*
  (list (cons :red    (color:make-rgb 1.0 0.0 0.0 1.0))
        (cons :orange (color:make-rgb 1.0 0.5 0.0 1.0))
        (cons :yellow (color:make-rgb 1.0 1.0 0.0 1.0))
        (cons :green  (color:make-rgb 0.0 1.0 0.0 1.0))
        (cons :blue   (color:make-rgb 0.0 0.0 1.0 1.0))
        (cons :purple (color:make-rgb 1.0 0.0 1.0 1.0))
        (cons :light-blue (color:make-rgb 0.5 0.5 1.0 1.0))
        (cons :pink   (color:make-rgb 1.0 0.5 0.5 1.0))
        (cons :black  (color:make-rgb 0.0 0.0 0.0 1.0))
        (cons :erase  (color:make-rgb 1.0 1.0 1.0 1.0))
        ))


(defparameter *block-size* 60) ;; 55
(defparameter *block-gap* 30)  ;; 5




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ACT-R Code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass icon-feature ()
  ((screen-x :accessor screen-x :initarg :x :initform nil)
   (screen-y :accessor screen-y :initarg :y :initform nil)
   ;; need initiform for distance?
   (distance :accessor distance :initarg :distance :initform 24) 
   (attended-p :accessor attended-p :initarg :attended-p :initform 'NEW)
   (kind :accessor kind :initarg :kind :initform 'visual-object)
   (val :accessor val :initarg :value :initform nil)
   (color :accessor color :initarg :color :initform 'black)
   (dmo-id :accessor dmo-id :initarg :dmo-id :initform nil)     	
   (screen-obj :accessor screen-obj :initarg :screen-obj :initform nil) 
   (height :accessor height :initarg :height :initform nil)
   (width :accessor width :initarg :width :initform nil)
   (size :accessor size :initarg :size :initform nil)
   (tstamp :accessor tstamp :initarg :tstamp :initform nil) 
   (obj-freq :accessor obj-freq :initarg :obj-freq :initform 0.01)
   (salience :accessor salience :initarg :salience :initform 0)
   (userprop1 :accessor userprop1 :initarg :userprop1 :initform nil)
   (userprop2 :accessor userprop2 :initarg :userprop2 :initform nil)
   (userprop3 :accessor userprop3 :initarg :userprop3 :initform nil)
   (userprop4 :accessor userprop4 :initarg :userprop4 :initform nil)
   ))

;"class that will be used to form chunks of the start/stop button"
(defclass button-object (icon-feature)
  (
   (userprop2 :initform nil :initarg :userprop2 :accessor userprop2)       ;sub-window name
   )
  (:default-initargs 
   :kind 'button
   )
)

;"class that will be used to form chunks of the covered subwindows"
(defclass subwindow-object (icon-feature)
  (
   (userprop2 :initform nil :initarg :userprop2 :accessor userprop2)       ;sub-window name
   )
  (:default-initargs 
   :kind 'subwindow
   )
)

;"class that will be used to created block-object, dot-object and ersaser-object chunks"
(defclass block-object (icon-feature)
  ((userprop1 :initform nil :initarg :userprop1 :accessor userprop1)      ;type of block ('eraser-object, 'block-object, 'dot-object)
   (userprop2 :initform nil :initarg :userprop2 :accessor userprop2)      ;sub-window name
   (userprop3 :initform nil :initarg :userprop3 :accessor userprop3)      ;row of subwindow
   (userprop4 :initform nil :initarg :userprop4 :accessor userprop4)      ;column in subwindow
   )
  (:default-initargs
   :kind 'block                   ;CPJ: changed
   :color 'gray 
   :dmo-id (gentemp "BLOCK-")))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


#|
;all chunks will be made of type BW-chunk, and added to a list, to make them easily accessible for deletion
(defclass BW-chunk ()
  ((parent-chunk :initform nil :initarg :parent-chunk :accessor parent-chunk)        ;parent-chunk is a name of the subwindow where the chunk is in
   (chunked-object :initform nil :initarg :chunked-object :accessor chunked-object)        ;the actual instance of the chunk itself
   (x-position :initform 0 :initarg :x-position :accessor x-position)                ;x & y coordinates
   (y-position :initform 0 :initarg :y-position :accessor y-position))
)
|#



(defclass BW-task ()
  ((target-pattern :initform (make-array '(4 4) :initial-element nil)
                   :initarg :target-pattern :accessor target-pattern)
   (workspace-pattern :initform (make-array '(4 4) :initial-element nil)
                   :initarg :workspace-pattern :accessor workspace-pattern)

   (target-lockout :initform 0.0 :initarg :target-lockout :accessor target-lockout)
   (workspace-lockout :initform 0.0 :initarg :workspace-lockout :accessor workspace-lockout)
   (resource-lockout :initform 0.0 :initarg :resource-lockout :accessor resource-lockout)

   (target-visible :initform nil :initarg :target-visible :accessor target-visible)
   (workspace-visible :initform nil :initarg :workspace-visible :accessor workspace-visible)
   (resource-visible :initform nil :initarg :resource-visible :accessor resource-visible)

   (target-process :initform nil :initarg :target-process :accessor target-process)
   (workspace-process :initform nil :initarg :workspace-process :accessor workspace-process)
   (resource-process :initform nil :initarg :resource-process :accessor resource-process)

   (selected-color :initform nil :initarg :selected-color :accessor selected-color)
   (current-trial :initform nil :initarg :current-trial :accessor current-trial)

   (trial-history :initform nil :initarg :trial-history :accessor trial-history)
   (exp-window :initform nil :initarg :exp-window :accessor exp-window)
   (display-feedback :initform t :initarg :display-feedback :accessor display-feedback)
   ;(list-of-visible-chunks :initform nil :initarg :list-of-visible-chunks :accessor list-of-visible-chunks)                ;CPJ: a list of all the chunks that are visible to the user & the ACT-R model
   ))

(defclass trial-info ()
  ((trial-number :initform 0 :initarg :trial-number :accessor trial-number)
   (start-time :initform nil :initarg :start-time :accessor start-time)
   (end-time :initform nil :initarg :end-time :accessor end-time)
   (errors :initform 0 :initarg :errors :accessor errors)

   (visit-logged :initform nil :initarg :visit-logged :accessor visit-logged)
   (visit-number :initform 1 :initarg :visit-number :accessor visit-number)
   (visit-ended :initform nil :initarg :visit-ended :accessor visit-ended)
   (visit-start :initform nil :initarg :visit-start :accessor visit-start)
   (visit-duration :initform 0 :initarg :visit-duration :accessor visit-duration)
   (visit-correct-placed :initform 0 :initarg :visit-correct-placed :accessor visit-correct-placed)
   (visit-error-placed :initform 0 :initarg :visit-error-placed :accessor visit-error-placed)
   
   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interface definition
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(capi:define-interface config-interface ()
  ()
  (:panes
   (config-option capi:option-pane
           :title "Select a Condition:"
           :title-position :top
           :items *lockouts*
           :visible-min-width '(character 20)
           :print-function #'(lambda (item) (format nil "~a" (car item)))
           :accessor config-option-pane)
   (feedback capi:check-button
             :text "Display feedback"
             :selected t
             :accessor config-feedback)
   (done capi:push-button
         :text "Done"
         :callback 'bw-config-done))
  (:layouts
   (main capi:column-layout '(options done) :adjust :center)
   (options capi:column-layout '(config-option feedback) :adjust :left))
  (:default-initargs
   :title "BlocksWorld Config"
   :x 100 :y 40))


;; Create a specialized output pane so ACT-R can parse it
(defclass bw-output-pane (capi:output-pane)
  ((window-type :initform nil :initarg :window-type :accessor window-type)))


;; Write a parser for the bw-output-pane
(defmethod parse-item ((item bw-output-pane))
  (let ((chunks nil))

    (multiple-value-bind (children parent-chunks) (call-next-method)

      (case (window-type item)
        (:target-window
         ;; Return a list of chunks corresponding to visicon features
       ;(setf chunks (list (make-instance 'block-object)))                          ;CPJ take a look at this section: it should return the right type of chunks
         ;(setf chunks *items-in-target-window*)                  ;CPJ: return the values of the target window
         )
        (:workspace-window                            ;CPJ: in this code, the workspace-window is the "workspace window"
         )
        (:resource-window
         ;(setf chunks *items-in-resource-window*)
       )
        (:button-window
         ))
      (values nil (append chunks parent-chunks))
      
      )
    )
  )


#-:multiworld
(defclass mw-interface (capi:interface) ())

(capi:define-interface BW-interface  (mw-interface)
  () 
  (:panes
   (target bw-output-pane
           :window-type :target-window
           :visible-min-width (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :visible-min-height (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :visible-max-width (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :visible-max-height (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :x 50 :y 50
           :display-callback 'draw-target-pane
           :accessor target-pane)
   (workspace bw-output-pane
           :window-type :workspace-window
           :visible-min-width (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :visible-min-height (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :visible-max-width (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :visible-max-height (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)
           :input-model '(((:button-1 :press) workspace-click))
           :x 850 :y 50
           :display-callback 'draw-workspace-pane
           :accessor workspace-pane)
   (resource bw-output-pane
             :window-type :resource-window
             :visible-min-width (+ (* (+ *block-size* *block-gap*) 5) *block-gap*)
             :visible-max-width (+ (* (+ *block-size* *block-gap*) 5) *block-gap*)
             :visible-min-height (+ (* (+ *block-size* *block-gap*) 2) *block-gap*)
             :visible-max-height (+ (* (+ *block-size* *block-gap*) 2) *block-gap*)
             :input-model '(((:button-1 :press) resource-click))
             :x 100 :y 600
             :display-callback 'draw-resource-pane
             :accessor resource-pane)
   (button bw-output-pane
           :window-type :button-window
           :visible-min-width 125 ;(+ (* (+ *block-size* *block-gap*) 2) *block-gap*)
           :visible-min-height 125 ;(+ (* (+ *block-size* *block-gap*) 2) *block-gap*)
           :x 800 :y 600
           :input-model '(((:button-1 :press) control-button-click))
           :display-callback 'draw-button-pane
           :accessor button-pane)
   (control-button capi:push-button
                 :text "Start Trial"
                 :visible-min-width '(character 10)
                 :visible-min-height '(character 5)
                 :accessor control-button
                 :callback 'control-button-click
                 :x 800 :y 600)
   )
  (:layouts
   (main capi:pinboard-layout '(target workspace resource button)
         :background (color:make-rgb 0.8 0.8 0.8))
   )
  (:default-initargs
   :x 0 :y 0
   :destroy-callback #'(lambda (interface)
#+:multiworld
                         (task-finished *mw-task-object*)
                         )
   :width (capi:screen-width (capi:convert-to-screen))
   :height (capi:screen-height (capi:convert-to-screen))
   :title "BlocksWorld Experiment"
   ;:window-styles '(:always-on-top :borderless :internal-borderless)
   ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interface redraw callbacks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun draw-button-pane (self x y width height)

  (gp:draw-rectangle self x y width height
                     :foreground :white :filled t)
  (gp:draw-rectangle self x y (1- width) (1- height)
                     :foreground :black :filled nil :thickness 2)
  (if (not (current-trial *bw*))
      (gp:draw-string self "START" 12 75 :font
                      (gp:find-best-font self (gp:make-font-description :size 30))
                      :foreground (color:make-rgb 0.0 0.5 0.0 1.0)
                      )
    (gp:draw-string self "STOP" 23 75 :font
                      (gp:find-best-font self (gp:make-font-description :size 30))
                      :foreground (color:make-rgb 0.7 0.0 0.0 1.0)
                      ))

  #+ACT-R-6.0
  (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) x y)   ;get the positions of the area, relative to the window
    (add-and-delete-chunk-objects (make-instance 'button-object
                                          :value (if (not (current-trial *bw*)) 'start 'stop)
                                          :x (round (+ absolute-x (/ width 2)))
                                          :y (round (+ absolute-y (/ height 2)))
                                          :width width
                                          :height height
                                          :color 'gray
                                          :userprop2 'button
                                          )
                                   'button)
    )
)

;; Draws the blocks in the bottom window of the task
(defun draw-resource-pane (self x y width height)
  (let ((chunklist nil))
    #-ACT-R-6.0
    (declare (ignore chunklist))
  (if (resource-visible *bw*)
      (progn (gp:draw-rectangle self x y width height
                                :foreground :white :filled t)
        (dotimes (i 5)
          (dotimes (j 4)
            (let* ((index (+ i (* j 5)))
                   (color-name (nth index (append *block-colors* (list :erase nil))))
                   (color (cdr (assoc color-name *block-color-values*))))
              (case color-name
                (:erase  ;; The Erase block is a special case
                 (let ((block-x (+ x *block-gap* (* i (+ *block-size* *block-gap*))))
                       (block-y (+ y *block-gap* (* j (+ *block-size* *block-gap*)))))
                       (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) block-x block-y)    ;get the positions of the block, relative to the window
                         #-ACT-R-6.0
                         (declare (ignore absolute-x)(ignore absolute-y))
                         
                         (gp:draw-rectangle
                          self
                          block-x
                          block-y
                          *block-size* *block-size*
                          :foreground :black :dashed t :thickness 1)
                         ;;;;;;;;;
                         #+ACT-R-6.0
                         (push  (make-instance 'block-object
                                               :x  (round (+ absolute-x (/ *block-size* 2)))               ;set x-coordinate at the x-center of the block
                                               :y  (round (+ absolute-y (/ *block-size* 2)))               ;set y-coordinate at the y-center of the block
                                               :width *block-size*
                                               :height *block-size*
                                               :color (get-ACT-R-color-name :white) 
                                               :userprop1 'eraser-object :userprop2 'resource :userprop3 j :userprop4 i)      ; CPJ develop a chunk for the block
                                      chunkList)
                         ;(format t "~%block: resource white row: ~A col: ~A   " j i)  
                 (gp:draw-string
                  self "ERASE"
                  (+ x 5 *block-gap* (* i (+ *block-size* *block-gap*)))
                  (+ y 35 *block-gap* (* j (+ *block-size* *block-gap*)))
                  *block-gap* *block-gap*
                  :font (gp:find-best-font self (gp:make-font-description :size 14))))))
                ((nil)
                 ;; Empty square
                 )
                (otherwise
                 (let ((block-x (+ x *block-gap* (* i (+ *block-size* *block-gap*))))
                       (block-y (+ y *block-gap* (* j (+ *block-size* *block-gap*)))))
                   (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) block-x block-y)   ;get the positions of the block, relative to the window    
                     #-ACT-R-6.0
                     (declare (ignore absolute-x)(ignore absolute-y))
                     
                     (gp:draw-rectangle
                      self
                      block-x
                      block-y
                      *block-size* *block-size*
                      :foreground color :filled t)
                     #+ACT-R-6.0 
                     (push  (make-instance 'block-object
                                           :x (round (+ absolute-x (/ *block-size* 2)))               ;set x-coordinate at the x-center of the block
                                           :y (round (+ absolute-y (/ *block-size* 2)))               ;set y-coordinate at the y-center of the block
                                           :width *block-size*
                                           :height *block-size*
                                           :color  (get-ACT-R-color-name color-name)
                                           :userprop1 'block-object :userprop2 'resource :userprop3 j :userprop4 i)      ; CPJ develop a chunk for the block
                            chunkList)
                    ; (format t "~%block: resource ~A row: ~A col: ~A   "(get-ACT-R-color-name color-name) j i)  
                 )))
              ))))
        #+ACT-R-6.0
        (add-and-delete-chunk-objects chunklist 'resource))    ;end of if-part of if/else-loop
    ;else: draw a gray square and add this to the visicon
    (progn
      (gp:draw-rectangle self x y width height :foreground (color:make-rgb 0.5 0.5 0.5) :filled t)
      #+ACT-R-6.0
      (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) x y)   ;get the positions of the area, relative to the window
      (add-and-delete-chunk-objects (make-instance 'subwindow-object 
                     :x (round (+ absolute-x (/ width 2)))
                     :y (round (+ absolute-y (/ height 2)))
                     :width width
                     :height height
                     :color 'gray
                     :userprop2 'resource
                     ) 'resource))
      )

    

  ))
)

;; Draws the pattern of blocks in the target window
(defun draw-target-pane (self x y width height)
  (let ((chunkList nil))               ;CPJ: make a list of the chunks to return
    #-ACT-R-6.0
    (declare (ignore chunklist))
    (if (target-visible *bw*)
        (let ((background :white)      
              )

          (gp:draw-rectangle self x y width height
                           :foreground background :filled t)
        (dotimes (i 4)
          (dotimes (j 4)
            (let ((color (cdr (assoc (aref (target-pattern *bw*) i j) *block-color-values*))))
              (cond
               (color
                (let ((block-x (+ x *block-gap* (* i (+ *block-size* *block-gap*))))
                      (block-y (+ y *block-gap* (* j (+ *block-size* *block-gap*)))))
                  (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) block-x block-y) ;get the position of the block, relative to the window
                    
                    #-ACT-R-6.0
                    (declare (ignore absolute-x)(ignore absolute-y))

                    (gp:draw-rectangle
                     self block-x block-y *block-size* *block-size* :foreground color :filled t)
                    #+ACT-R-6.0
                    (push (make-instance 'block-object
                                                     :x (round (+ absolute-x (/ *block-size* 2)))               ;set x-coordinate at the x-center of the block
                                                     :y (round (+ absolute-y (/ *block-size* 2)))               ;set y-coordinate at the y-center of the block
                                                     :width *block-size*
                                                     :height *block-size*
                                                     :color (get-ACT-R-color-name (car (assoc (aref (target-pattern *bw*) i j) *block-color-values*))) 
                                                     :userprop1 'block-object :userprop2 'target :userprop3 j :userprop4 i)      ; CPJ develop a chunk for the block
                          chunkList)
                
                )))
               (t
                (gp:draw-rectangle
                 self
                 (+ x *block-gap* (* i (+ *block-size* *block-gap*)))
                 (+ y *block-gap* (* j (+ *block-size* *block-gap*)))
                 *block-size* *block-size*
                 :foreground :white :filled t)
                
                (let ((circle-x (+ x (/ *block-size* 2) *block-gap* (* i (+ *block-size* *block-gap*))))
                      (circle-y (+ y (/ *block-size* 2) *block-gap* (* j (+ *block-size* *block-gap*)))))
                  (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) circle-x circle-y) ;get the position of the circle relative to window
                    
                    #-ACT-R-6.0
                    (declare (ignore absolute-x)(ignore absolute-y))

                    (gp:draw-circle
                     self circle-x circle-y 5 :foreground :gray :filled t)
                    #+ACT-R-6.0
                    (push (make-instance 'block-object 
                                                     :x (round (+ absolute-x 2.5))              ;set x-coordinate at the x-center (middle) of the circle
                                                     :y (round (+ absolute-y 2.5))              ;set y-coordinate at the y-center (middle) of the circle
                                                     :width 5
                                                     :height 5
                                                     :color 'gray :userprop1 'dot-object :userprop2 'target :userprop3 j :userprop4 i)      ; CPJ develop a chunk for the block
                          chunkList)
                )))


              )
            )))
        ;;now add chunks to visicon and delete old visually overlapping chunks
        #+ACT-R-6.0
        (add-and-delete-chunk-objects chunklist 'target)
        )
      ;else: draw a gray rectangle
      (progn
        (gp:draw-rectangle self x y width height
                           :foreground (color:make-rgb 0.5 0.5 0.5) :filled t)
        #+ACT-R-6.0
        (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) x y)   ;get the positions of the area, relative to the window
          (add-and-delete-chunk-objects (make-instance 'subwindow-object 
                                              :x (round (+ absolute-x (/ width 2)))
                                              :y (round (+ absolute-y (/ height 2)))
                                              :width width
                                              :height height
                                              :color 'gray
                                              :userprop2 'target
                                              )
                                        'target)
          )
        )
      )

    )
  )

;; Draws the pattern of blocks in the workspace window
(defun draw-workspace-pane (self x y width height)
  (if (workspace-visible *bw*)
      (let ((background :white)
            (chunklist nil))
        #-ACT-R-6.0
        (declare (ignore chunklist))

        (gp:draw-rectangle self x y width height
                           :foreground background :filled t)
        (dotimes (i 4)
          (dotimes (j 4)
            (let ((color (cdr (assoc (aref (workspace-pattern *bw*) i j) *block-color-values*))))
              (cond
               (color
                (let ((block-x (+ x *block-gap* (* i (+ *block-size* *block-gap*))))
                  (block-y (+ y *block-gap* (* j (+ *block-size* *block-gap*)))))
                  (multiple-value-bind (absolute-x absolute-y)(capi:convert-relative-position self (capi:top-level-interface self) block-x block-y) ;get the positions of the blocks, relative to window
                    #-ACT-R-6.0
                    (declare (ignore absolute-x)(ignore absolute-y))

                    (gp:draw-rectangle
                     self
                     block-x
                     block-y
                     *block-size* *block-size*
                     :foreground color :filled t)
                    #+ACT-R-6.0
                    (push (make-instance 'block-object
                                         :x (round (+ absolute-x (/ *block-size* 2)))    ;set x-coordinate at the x-center of the block
                                         :y (round (+ absolute-y (/ *block-size* 2)))    ;set y-coordinate at the y-center of the block
                                         :width *block-size*
                                         :height *block-size*
                                         :color (get-ACT-R-color-name (car (assoc (aref (workspace-pattern *bw*) i j) *block-color-values*)))
                                         :userprop1 'block-object :userprop2 'workspace :userprop3 j :userprop4 i)     ; CPJ develop a chunk for the block
                                         
                          chunklist)
                    )
                  )
                )
               (t
                (gp:draw-rectangle
                 self
                 (+ x *block-gap* (* i (+ *block-size* *block-gap*)))
                 (+ y *block-gap* (* j (+ *block-size* *block-gap*)))
                 *block-size* *block-size*
                 :foreground :white :filled t)
                (let ((circle-x (+ x (/ *block-size* 2) *block-gap* (* i (+ *block-size* *block-gap*))))
                      (circle-y (+ y (/ *block-size* 2) *block-gap* (* j (+ *block-size* *block-gap*)))))
                  (multiple-value-bind (absolute-x absolute-y)(capi:convert-relative-position self (capi:top-level-interface self) circle-x circle-y) ;get the positions of the circles, relative to window
                    #-ACT-R-6.0
                    (declare (ignore absolute-x)(ignore absolute-y))
                    (gp:draw-circle
                     self
                     circle-x
                     circle-y
                     5
                     :foreground :gray :filled t)
                    #+ACT-R-6.0
                    (push (make-instance 'block-object
                                         :x (round (+ absolute-x 2.5))       ;set x-coordinate at the center of the circle
                                         :y (round (+ absolute-y 2.5))       ;set y-coordinate at the center of the circle
                                         :width 5
                                         :height 5
                                         :color 'gray :userprop1 'dot-object :userprop2 'workspace :userprop3 j :userprop4 i)      ; CPJ develop a chunk for the block
                          chunklist)
                    )))
               )
              )
            )
          )
        ;now add chunks to visicon, and delete old chunks that overlap with the new ones
        #+ACT-R-6.0
        (add-and-delete-chunk-objects chunklist 'workspace)
        
        )
    ;else: draw a gray rectangle
    (progn
    (gp:draw-rectangle self x y width height
                       :foreground (color:make-rgb 0.5 0.5 0.5) :filled t)
    #+ACT-R-6.0
    (multiple-value-bind (absolute-x absolute-y) (capi:convert-relative-position self (capi:top-level-interface self) x y)   ;get the positions of the area, relative to the window
      (add-and-delete-chunk-objects (make-instance 'subwindow-object 
                                                   :x (round (+ absolute-x (/ width 2)))
                                                   :y (round (+ absolute-y (/ height 2)))
                                                   :width width
                                                   :height height
                                                   :color 'gray
                                                   :userprop2 'workspace
                                                   )
                                    'workspace)
      )
    )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interface click callbacks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun bw-config-done (data interface)
  (let ((item (capi:choice-selected-item (config-option-pane interface))))
    (setf (display-feedback *bw*) (capi:button-selected (config-feedback interface)))
    (setf *condition* (car item))
    (capi:execute-with-interface
     interface
     'capi:destroy interface)
    (if (equal *condition* 'M)
        (setf (target-lockout *bw*) (nth (random 6) '(0.0 0.2 0.4 0.8 1.6 3.2)))
      (setf (target-lockout *bw*) (cdr item)))
    (setf *recent-lockouts* (list (target-lockout *bw*)))
#+:multiworld
    (configuration-done *mw-task-object* :condition (format nil "~a" (car item)))
    ))

(defun control-button-click (self x y)
  (let ((time (get-internal-real-time))
        (old-lockout nil))

    (cond
     
     ;; START TRIAL
     ((not (current-trial *bw*))
#+:multiworld
      (turn-on-eyetracker-logging)
      (setf (current-trial *bw*) (make-instance 'trial-info))

      (setf (start-time (current-trial *bw*)) time)
      (if (trial-history *bw*)
          (setf (trial-number (current-trial *bw*))
                (1+ (trial-number (first (trial-history *bw*))))))
      (setf (target-pattern *bw*) (generate-pattern))
      (setf (workspace-pattern *bw*) (make-array '(4 4) :initial-element nil))
      (log-info
       (list
        *condition*
        (target-lockout *bw*)
        (trial-number (current-trial *bw*))
        "MW-EVENT"
        "TASK-STATE"
        (target-visible *bw*)
        (workspace-visible *bw*)
        (resource-visible *bw*)
        (target-pattern *bw*)
        (workspace-pattern *bw*)))
      )

     ;; STOP TRIAL
     ((and (current-trial *bw*) (trial-done)
           (< (trial-number (current-trial *bw*)) *trials*))

      (setf old-lockout (target-lockout *bw*))

      (setf *recent-lockouts* (subseq (cons (target-lockout *bw*) *recent-lockouts*)
                                      0 (min 5 (1+ (length *recent-lockouts*)))))
      (cond
       ((equal *condition* 'M)
        (setf (target-lockout *bw*) (choose-without-replacement
                                     (set-difference
                                      '(0.0 0.2 0.4 0.8 1.6 3.2)
                                      *recent-lockouts*
                                      :test 'equal)))))

      (log-info
       (list
        *condition*
        old-lockout
        (trial-number (current-trial *bw*))
        "TRIAL-SUMMARY"
        "BLOCK"
        (visit-number (current-trial *bw*))
        (- time (start-time (current-trial *bw*)))
        (errors (current-trial *bw*))))

      (cond
       ((and (not (visit-logged (current-trial *bw*)))
             (> (visit-duration (current-trial *bw*)) 0))
        (log-info
         (list
          *condition*
          old-lockout
          (trial-number (current-trial *bw*))
          "VISIT-SUMMARY"
          "BLOCK"
          (visit-number (current-trial *bw*))
          (visit-duration (current-trial *bw*))
          (visit-correct-placed (current-trial *bw*))
          (visit-error-placed (current-trial *bw*))))
      
        (setf (visit-logged (current-trial *bw*)) nil)
        (setf (visit-ended (current-trial *bw*)) nil)
        (incf (visit-number (current-trial *bw*)))
        (setf (visit-duration (current-trial *bw*)) 0)
        (setf (visit-correct-placed (current-trial *bw*)) 0)
        (setf (visit-error-placed (current-trial *bw*)) 0)))
#+:multiworld      
      (turn-off-eyetracker-logging)
      (setf (end-time (current-trial *bw*)) time)

      ;; Log Task State
      (log-info
       (list
        *condition*
        (target-lockout *bw*)
        (trial-number (current-trial *bw*))
        "MW-EVENT"
        "TASK-STATE"
        (target-visible *bw*)
        (workspace-visible *bw*)
        (resource-visible *bw*)
        (target-pattern *bw*)
        (workspace-pattern *bw*)))

      (push (current-trial *bw*) (trial-history *bw*))
      (setf (current-trial *bw*) nil)
      (if (display-feedback *bw*)
          (capi:display-message "Good job! You got trial ~a correct.

This trial took you ~a seconds to complete." (trial-number (first (trial-history *bw*)))
                                (round (float (/ (- (end-time (first (trial-history *bw*)))
                                                    (start-time (first (trial-history *bw*)))) 1000))))))

     ;; TRIAL INCORRECT
     ((and (current-trial *bw*) (not (trial-done)))
      (let ((temp-trial (current-trial *bw*)))
        (if (display-feedback *bw*)
            (progn (setf (current-trial *bw*) nil)
              (capi:display-message "There is an error in the current trial.
Make sure the two patterns match exactly before pressing the Stop button.")
              (setf (current-trial *bw*) temp-trial))
        )))

     ;; STOP EXPERIMENT
     ((and (current-trial *bw*) (trial-done)
           (= (trial-number (current-trial *bw*)) *trials*))

      (cond
       ((and (not (visit-logged (current-trial *bw*)))
             (> (visit-duration (current-trial *bw*)) 0))

        (setf old-lockout (target-lockout *bw*))
        (log-info
         (list
          *condition*
          old-lockout
          (trial-number (current-trial *bw*))
          "VISIT-SUMMARY"
          "BLOCK"
          (visit-number (current-trial *bw*))
          (visit-duration (current-trial *bw*))
          (visit-correct-placed (current-trial *bw*))
          (visit-error-placed (current-trial *bw*))))
      
        (setf (visit-logged (current-trial *bw*)) nil)
        (setf (visit-ended (current-trial *bw*)) nil)
        (incf (visit-number (current-trial *bw*)))
        (setf (visit-duration (current-trial *bw*)) 0)
        (setf (visit-correct-placed (current-trial *bw*)) 0)
        (setf (visit-error-placed (current-trial *bw*)) 0)))

      (setf (end-time (current-trial *bw*)) time)
      (setf (current-trial *bw*) nil)
      (if (display-feedback *bw*)
          (capi:display-message "Congratulations! You have now completed the experiment.
Please find the experimenter for further instructions."))
      (capi:execute-with-interface
       (exp-window *bw*) 'capi:destroy (exp-window *bw*))
#+:multiworld      (task-finished *mw-task-object*)))
    (gp:invalidate-rectangle self)
    )
;#+:multiworld  (update-screen)
  )

;; Code to place a block
(defun workspace-click (self x y)
  (let ((time (get-internal-real-time)))
    (if (and (current-trial *bw*) (selected-color *bw*))
        (multiple-value-bind (i j) (nearest-grid-point x y)
          (cond
           ((and (>= i 0) (>= j 0) (< i 4) (< j 4))
            (cond  ;; Update the grid
             ((eq (selected-color *bw*) :erase)
              (setf (aref (workspace-pattern *bw*) i j) nil)
              (update-workspace-window-new-block :erase j i))
             (t
              (setf (aref (workspace-pattern *bw*) i j) (selected-color *bw*))
              (update-workspace-window-new-block (selected-color *bw*) j i)
              ))
            
            (cond  ;; Check for block placement errors
             ((equal (aref (workspace-pattern *bw*) i j) (aref (target-pattern *bw*) i j))
              (incf (visit-correct-placed (current-trial *bw*)))
              (log-info
               ;; Log PLACE-SUMMARY (correct)
               (list
                *condition*
                (target-lockout *bw*)
                (trial-number (current-trial *bw*))
                "PLACE-SUMMARY"
                "BLOCK"
                (visit-number (current-trial *bw*))
                (selected-color *bw*)
                i j
                0) :specify-time time))
             (t
              (incf (visit-error-placed (current-trial *bw*)))
              (log-info
               ;; Log PLACE-SUMMARY (error)
               (list
                *condition*
                (target-lockout *bw*)
                (trial-number (current-trial *bw*))
                "PLACE-SUMMARY"
                "BLOCK"
                (visit-number (current-trial *bw*))
                (selected-color *bw*)
                i j
                1) :specify-time time)
              (incf (errors (current-trial *bw*)))
              ))
            
            (capi:apply-in-pane-process
             self 'gp:invalidate-rectangle self)
            (setf (selected-color *bw*) nil)
            (arrow-cursor)
            (capi:apply-in-pane-process
             (resource-pane (exp-window *bw*)) 'gp:invalidate-rectangle
             (resource-pane (exp-window *bw*)))
            ;(update-screen)

            (log-info
             (list
              *condition*
              (target-lockout *bw*)
              (trial-number (current-trial *bw*))
              "MW-EVENT"
              "TASK-STATE"
              (target-visible *bw*)
              (workspace-visible *bw*)
              (resource-visible *bw*)
              (target-pattern *bw*)
              (workspace-pattern *bw*)))))))))

;; Code to pick up a block
(defun resource-click (self x y)
  (if (resource-visible *bw*)
  (let ((time (get-internal-real-time)))
    (if (current-trial *bw*)
        (multiple-value-bind (i j) (nearest-grid-point x y)
          (if (and (< j 2) (< i 5) (>= j 0) (>= i 0)
                   (not (and (= j 1) (= i 4))))
          (let ((index (+ (min 4 i) (* (min j 1) 5)))
                (color nil))
            ;(capi:display-message "~a ~a" i j)
            (if (<= index (1+ (length *block-colors*)))
                (setf color (nth index (append *block-colors* (list :erase)))))
            (setf (selected-color *bw*) color)

            (log-info ;; Log SELECT-RESOURCE
             (list
              *condition*
              (target-lockout *bw*)
              (trial-number (current-trial *bw*))
              "SELECT-RESOURCE"
              "BLOCK"
              (visit-number (current-trial *bw*))
              color))

            (block-cursor (cdr (assoc color *block-color-values*)))
            (gp:invalidate-rectangle self)
            ;(update-screen)

            ))))))
  (log-info
   (list
    *condition*
    (target-lockout *bw*)
    (trial-number (current-trial *bw*))
    "MW-EVENT"
    "TASK-STATE"
    (target-visible *bw*)
    (workspace-visible *bw*)
    (resource-visible *bw*)
    (target-pattern *bw*)
    (workspace-pattern *bw*))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interface mouseover callbacks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Called by MultiWorld when the mouse enters the target window
(defun target-handler (event)
  (if (current-trial *bw*)
  (case event
    
    ;; ENTER TARGET PANE
    (:enter
     (let ((log-time (get-internal-real-time)))

       (log-info ;; Log ENTER-TARGET
        (list
         *condition*
         (target-lockout *bw*)
         (trial-number (current-trial *bw*))
         "ENTER-TARGET"
         "BLOCK"
         (visit-number (current-trial *bw*))
         )
        :specify-time log-time))
     
     

     (setf (selected-color *bw*) nil)
     (objc:invoke "NSCursor" "hide")
     (block-cursor (color:make-rgb 0.0 1.0 0.0 1.0))
     (objc:invoke "NSCursor" "unhide")
     (arrow-cursor)
     (setf (selected-color *bw*) nil)
     (capi:apply-in-pane-process
      (resource-pane (exp-window *bw*))
      'gp:invalidate-rectangle (resource-pane (exp-window *bw*)))
     (setf (target-process *bw*)
           ;; Schedule an event to uncover the pane
           (mp:process-run-function
            "Target process" nil
            #'(lambda ()
                (sleep (target-lockout *bw*))
                (setf (target-visible *bw*) t)

                (log-info
                 (list
                  *condition*
                  (target-lockout *bw*)
                  (trial-number (current-trial *bw*))
                  "MW-EVENT"
                  "TASK-STATE"
                  (target-visible *bw*)
                  (workspace-visible *bw*)
                  (resource-visible *bw*)
                  (target-pattern *bw*)
                  (workspace-pattern *bw*)))

                (setf (visit-start (current-trial *bw*)) (get-internal-real-time))

                (cond
                 ((visit-ended (current-trial *bw*))

                  (log-info
                   (list
                    *condition*
                    (target-lockout *bw*)
                    (trial-number (current-trial *bw*))
                    "VISIT-SUMMARY"
                    "BLOCK"
                    (visit-number (current-trial *bw*))
                    (visit-duration (current-trial *bw*))
                    (visit-correct-placed (current-trial *bw*))
                    (visit-error-placed (current-trial *bw*))))
                  
                  (setf (visit-logged (current-trial *bw*)) nil)
                  (setf (visit-ended (current-trial *bw*)) nil)
                  (incf (visit-number (current-trial *bw*)))
                  (setf (visit-duration (current-trial *bw*)) 0)
                  (setf (visit-correct-placed (current-trial *bw*)) 0)
                  (setf (visit-error-placed (current-trial *bw*)) 0)
                  ))

                (capi:apply-in-pane-process
                 (target-pane (exp-window *bw*))
                 'gp:invalidate-rectangle (target-pane (exp-window *bw*)))

                (let ((log-time
                       (log-info
                        ;; Log OPEN-TARGET
                        (list
                         *condition*
                         (target-lockout *bw*)
                         (trial-number (current-trial *bw*))
                         "OPEN-TARGET"
                         "BLOCK"
                         (visit-number (current-trial *bw*))
                         ))))
                  ))))
            
     (log-info
      (list
       *condition*
       (target-lockout *bw*)
       (trial-number (current-trial *bw*))
       "MW-EVENT"
       "TASK-STATE"
       (target-visible *bw*)
       (workspace-visible *bw*)
       (resource-visible *bw*)
       (target-pattern *bw*)
       (workspace-pattern *bw*)))
     )
            
    ;; LEAVE TARGET PANE
    (:leave
     ;; Abort the uncover-event if it's scheduled
     (if (target-process *bw*)
         (progn (mp:process-kill (target-process *bw*))
           (setf (target-process *bw*) nil)))
     ;; Cover the pane up again
     (setf (target-visible *bw*) nil)
     
     (if (visit-start (current-trial *bw*))
         (incf (visit-duration (current-trial *bw*))
               (- (get-internal-real-time) (visit-start (current-trial *bw*)))))

     (let ((log-time
            (log-info ;; Log CLOSE-TARGET
             (list
              *condition*
              (target-lockout *bw*)
              (trial-number (current-trial *bw*))
              "CLOSE-TARGET"
              "BLOCK"
              (visit-number (current-trial *bw*))
              ))))
       )

     (log-info
      (list
       *condition*
       (target-lockout *bw*)
       (trial-number (current-trial *bw*))
       "MW-EVENT"
       "TASK-STATE"
       (target-visible *bw*)
       (workspace-visible *bw*)
       (resource-visible *bw*)
       (target-pattern *bw*)
       (workspace-pattern *bw*)))
     (capi:apply-in-pane-process
      (target-pane (exp-window *bw*))
      'gp:invalidate-rectangle (target-pane (exp-window *bw*)))))))


;; Called by MultiWorld when the mouse enters the workspace window
(defun workspace-handler (event)
  (if (current-trial *bw*)
  (case event

    ;; ENTER WORKSPACE PANE
    (:enter
     (setf (workspace-process *bw*)
           (mp:process-run-function
            "Workspace process" nil
            #'(lambda ()
                (sleep (workspace-lockout *bw*))
                (setf (workspace-visible *bw*) t)
                (setf (visit-ended (current-trial *bw*)) t)

                (log-info ;; Log OPEN-WORKSPACE
                 (list
                  *condition*
                  (target-lockout *bw*)
                  (trial-number (current-trial *bw*))
                  "OPEN-WORKSPACE"
                  "BLOCK"
                  (visit-number (current-trial *bw*))
                  ))

                (log-info
                 (list
                  *condition*
                  (target-lockout *bw*)
                  (trial-number (current-trial *bw*))
                  "MW-EVENT"
                  "TASK-STATE"
                  (target-visible *bw*)
                  (workspace-visible *bw*)
                  (resource-visible *bw*)
                  (target-pattern *bw*)
                  (workspace-pattern *bw*)))
                (capi:apply-in-pane-process
                 (workspace-pane (exp-window *bw*))
                 'gp:invalidate-rectangle (workspace-pane (exp-window *bw*)))
                ))))

    ;; LEAVE WORKSPACE PANE
    (:leave
     
     (log-info ;; Log CLOSE-WORKSPACE
      (list
       *condition*
       (target-lockout *bw*)
       (trial-number (current-trial *bw*))
       "CLOSE-WORKSPACE"
       "BLOCK"
       (visit-number (current-trial *bw*))
       ))

     (if (workspace-process *bw*)
         (progn (mp:process-kill (workspace-process *bw*))
           (setf (workspace-process *bw*) nil)))
     (setf (workspace-visible *bw*) nil)
     (log-info
      (list
       *condition*
       (target-lockout *bw*)
       (trial-number (current-trial *bw*))
       "MW-EVENT"
       "TASK-STATE"
       (target-visible *bw*)
       (workspace-visible *bw*)
       (resource-visible *bw*)
       (target-pattern *bw*)
       (workspace-pattern *bw*)))
     (capi:apply-in-pane-process
      (workspace-pane (exp-window *bw*))
      'gp:invalidate-rectangle (workspace-pane (exp-window *bw*)))))))

(defun resource-handler (event)
  (if (current-trial *bw*)
  (case event
    (:enter
     (setf (resource-process *bw*)
           (mp:process-run-function
            "Resource process" nil
            #'(lambda ()
                (sleep (resource-lockout *bw*))
                (setf (resource-visible *bw*) t)
                (setf (visit-ended (current-trial *bw*)) t)

                (log-info ;; Log OPEN-RESOURCE
                 (list
                  *condition*
                  (target-lockout *bw*)
                  (trial-number (current-trial *bw*))
                  "OPEN-RESOURCE"
                  "BLOCK"
                  (visit-number (current-trial *bw*))
                  ))

                (log-info
                 (list
                  *condition*
                  (target-lockout *bw*)
                  (trial-number (current-trial *bw*))
                  "MW-EVENT"
                  "TASK-STATE"
                  (target-visible *bw*)
                  (workspace-visible *bw*)
                  (resource-visible *bw*)
                  (target-pattern *bw*)
                  (workspace-pattern *bw*)))
                (capi:apply-in-pane-process
                 (resource-pane (exp-window *bw*))
                 'gp:invalidate-rectangle (resource-pane (exp-window *bw*)))
                ))))
    (:leave

     (log-info ;; Log CLOSE-RESOURCE
      (list
       *condition*
       (target-lockout *bw*)
       (trial-number (current-trial *bw*))
       "CLOSE-RESOURCE"
       "BLOCK"
       (visit-number (current-trial *bw*))
       ))
     
     (if (resource-process *bw*)
         (progn (mp:process-kill (resource-process *bw*))
           (setf (resource-process *bw*) nil)
           (log-info
            (list
             *condition*
             (target-lockout *bw*)
             (trial-number (current-trial *bw*))
             "MW-EVENT"
             "TASK-STATE"
             (target-visible *bw*)
             (workspace-visible *bw*)
             (resource-visible *bw*)
             (target-pattern *bw*)
             (workspace-pattern *bw*)))))
     (setf (resource-visible *bw*) nil)
     (capi:apply-in-pane-process
      (resource-pane (exp-window *bw*))
      'gp:invalidate-rectangle (resource-pane (exp-window *bw*))))
    )))

(defun block-cursor (color)
  (let ((cursor (objc:invoke "NSCursor" "alloc"))
        (image (objc:invoke "NSImage" "alloc")))

    (objc:invoke image "initWithSize:" #(32 32))
    (objc:invoke image "lockFocus")
    (objc:invoke (objc:invoke "NSColor" "colorWithCalibratedRed:green:blue:alpha:"
                              (color:color-red color)
                              (color:color-green color)
                              (color:color-blue color)
                              (color:color-alpha color)) "set")
    (objc:invoke (objc:invoke "NSBezierPath" "bezierPathWithRect:" #(0 0 32 32)) "fill")
    (objc:invoke (objc:invoke "NSColor" "colorWithCalibratedRed:green:blue:alpha:" 0.0 0.0 0.0 1.0) "set")
    (objc:invoke (objc:invoke "NSBezierPath" "bezierPathWithRect:" #(0 0 32 32)) "stroke")
    (objc:invoke image "unlockFocus")

    (objc:invoke cursor "initWithImage:hotSpot:" image #(16 16))
    (objc:invoke cursor "set")
    )
  )

(defun arrow-cursor ()
  (objc:invoke (objc:invoke "NSCursor" "arrowCursor") "set")
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Generates a random array of blocks. Allows each color to be used
;;  a maximum of twice in the array.
(defun generate-pattern ()
  (let ((array (make-array '(4 4) :initial-element nil))
        (color-list (append *block-colors* *block-colors*))
        (chosen-indices nil))
    (dotimes (i 8)
      (let ((x (random 4)) (y (random 4)))
        (loop
         (capi:process-pending-messages nil)
         (when (not (find (cons x y) chosen-indices :test 'equal)) (return))
         (setf x (random 4))
         (setf y (random 4)))
        (push (cons x y) chosen-indices)
        (multiple-value-bind (color remaining)
            (choose-without-replacement color-list)
          (setf color-list remaining)
          (setf (aref array x y) color))))
    array))

;; Takes (x y) coordinates and translates into (i j) indices
(defun nearest-grid-point (x y)
  (values
   (round (/ (- x (/ *block-size* 2) *block-gap*) (+ *block-size* *block-gap*)))
   (round (/ (- y (/ *block-size* 2) *block-gap*) (+ *block-size* *block-gap*)))))

;; Returns T iff the target pattern matches the workspace pattern
(defun trial-done ()
  (let ((done t))
    (dotimes (i 4)
      (dotimes (j 4)
        (if (not (equal (aref (target-pattern *bw*) i j)
                        (aref (workspace-pattern *bw*) i j)))
            (setf done nil))))
    done))

;; Takes a list and returns two values: a random item,
;;  and the list with the chosen item removed.
(defun choose-without-replacement (items)
  (if items
      (let* ((i (random (length items)))
             (item (nth i items))
             (remainder nil))
        (setf remainder (append (subseq items 0 i)
                                (subseq items (1+ i))))
        (values item remainder))
    (values nil nil)))

(defun draw-BW-state (self state-list)
  (let ((target-visible (read-from-string (nth 8 state-list)))
        (workspace-visible (read-from-string (nth 9 state-list)))
        (resource-visible (read-from-string (nth 10 state-list)))
        (target-pattern (read-from-string (nth 11 state-list)))
        (workspace-pattern (read-from-string (nth 12 state-list))))

    (setf target-visible t)
    (setf resource-visible t)

    (gp:clear-graphics-port self)

    (let ((x 800) (y 600) (width (+ (* (+ *block-size* *block-gap*) 2) *block-gap*))
          (height (+ (* (+ *block-size* *block-gap*) 2) *block-gap*)))
      (gp:draw-rectangle self x y 125 125
                         :foreground :white :filled t)
      (gp:draw-rectangle self x y 125 125
                         :foreground :black :filled nil :thickness 2)
      (gp:draw-string self "START/STOP" (+ x 15) (+ y 65) :font
                      (gp:find-best-font self (gp:make-font-description :size 15))
                      :foreground (color:make-rgb 0.7 0.0 0.0 1.0)
                      )
      )
    
    ;; Draw target window
    (let ((x 50) (y 50) (width (+ (* (+ *block-size* *block-gap*) 4) *block-gap*))
          (height (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)))
      (if target-visible
          (let ((background :white))
            (gp:draw-rectangle self x y width height
                               :foreground background :filled t)
            (dotimes (i 4)
              (dotimes (j 4)
                (let ((color (cdr (assoc (aref target-pattern i j) *block-color-values*))))
                  (if (not color) (setf color background))
                  (gp:draw-rectangle
                   self
                   (+ x *block-gap* (* i (+ *block-size* *block-gap*)))
                   (+ y *block-gap* (* j (+ *block-size* *block-gap*)))
                   *block-size* *block-size*
                   :foreground color :filled t)))))
        (gp:draw-rectangle self x y width height
                           :foreground (color:make-rgb 0.5 0.5 0.5) :filled t)))

    ;; Draw workspace window
    (let ((x 850) (y 50) (width (+ (* (+ *block-size* *block-gap*) 4) *block-gap*))
          (height (+ (* (+ *block-size* *block-gap*) 4) *block-gap*)))
      (if workspace-visible
          (let ((background :white))
            (gp:draw-rectangle self x y width height
                               :foreground background :filled t)
            (dotimes (i 4)
              (dotimes (j 4)
                (let ((color (cdr (assoc (aref workspace-pattern i j) *block-color-values*))))
                  (if (not color) (setf color background))
                  (gp:draw-rectangle
                   self
                   (+ x *block-gap* (* i (+ *block-size* *block-gap*)))
                   (+ y *block-gap* (* j (+ *block-size* *block-gap*)))
                   *block-size* *block-size*
                   :foreground color :filled t)))))
        (gp:draw-rectangle self x y width height
                           :foreground (color:make-rgb 0.5 0.5 0.5) :filled t)))

    ;; Draw resource window
    (let ((x 100) (y 600) (width (+ (* (+ *block-size* *block-gap*) 5) *block-gap*))
          (height (+ (* (+ *block-size* *block-gap*) 2) *block-gap*)))
      (if resource-visible
          (progn (gp:draw-rectangle self x y width height
                                    :foreground :white :filled t)
            (dotimes (i 5)
              (dotimes (j 4)
                (let* ((index (+ i (* j 5)))
                       (color-name (nth index (append *block-colors* (list :erase nil))))
                       (color (cdr (assoc color-name *block-color-values*))))
                  (case color-name
                    (:erase  ;; The Erase block is a special case
                     (gp:draw-rectangle
                      self
                      (+ x *block-gap* (* i (+ *block-size* *block-gap*)))
                      (+ y *block-gap* (* j (+ *block-size* *block-gap*)))
                      *block-size* *block-size*
                      :foreground :black :dashed t :thickness 1)
                     (gp:draw-string
                      self "ERASE"
                      (+ x 5 *block-gap* (* i (+ *block-size* *block-gap*)))
                      (+ y 35 *block-gap* (* j (+ *block-size* *block-gap*)))
                      *block-gap* *block-gap*
                      :font (gp:find-best-font self (gp:make-font-description :size 14))))
                    ((nil)
                     ;; Empty square
                     )
                    (t
                     (gp:draw-rectangle
                      self
                      (+ x *block-gap* (* i (+ *block-size* *block-gap*)))
                      (+ y *block-gap* (* j (+ *block-size* *block-gap*)))
                      *block-size* *block-size*
                      :foreground color :filled t)))
                  ))))
        (gp:draw-rectangle self x y width height
                           :foreground (color:make-rgb 0.5 0.5 0.5) :filled t)
        ))

    
    ))

#+:multiworld
(progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MultiWorld registration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setf *mw-task-object*
      (register-task "BlocksWorld Task"
                     :run-function 'start-bw-task
                     ;:break-function 'stop-bw-task
                     :configure-function 'display-config-win
                     :replay-function 'draw-BW-state
                     ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Experiment control
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Called by MultiWorld
(defun display-config-win ()
  (setf *bw* (make-instance 'BW-task))
  (capi:display (make-instance 'config-interface)))
) ;end multiworld

(defmethod screen-position (item)
  "Returns (values x y)"
  (capi:convert-relative-position item (capi:convert-to-screen) 0 0))

;; Called by MultiWorld
(defun start-bw-task ()
  (setf (exp-window *bw*) (make-instance 'BW-interface))
  
  (log-info
   (list
    "CONDITION"
    "LOCKOUT"
    "TRIAL"
    "PLACE-SUMMARY-HEADER"
    "BLOCK"
    "VISIT-NUM"
    "COLOR"
    "X" "Y"
    "ERROR"))

  (log-info
   (list
    "CONDITION"
    "LOCKOUT"
    "TRIAL"
    "VISIT-SUMMARY-HEADER"
    "BLOCK"
    "VISIT-NUM"
    "VISIT-DURATION"
    "CORRECT-PLACED"
    "ERROR-PLACED"))

  (capi:display (exp-window *bw*))

  (multiple-value-bind (x y) (screen-position (target-pane (exp-window *bw*)))
    (monitor-region
     x y
     (+ x (* (+ *block-size* *block-gap*) 4) *block-gap*)
     (+ y (* (+ *block-size* *block-gap*) 4) *block-gap*)
     'target-handler :callback-type :keyword))
  (multiple-value-bind (x y) (screen-position (workspace-pane (exp-window *bw*)))
    (monitor-region
     x y
     (+ x (* (+ *block-size* *block-gap*) 4) *block-gap*)
     (+ y (* (+ *block-size* *block-gap*) 4) *block-gap*)
     'workspace-handler :callback-type :keyword))
  (multiple-value-bind (x y) (screen-position (resource-pane (exp-window *bw*)))
    (monitor-region
     x y
     (+ x (* (+ *block-size* *block-gap*) 5) *block-gap*)
     (+ y (* (+ *block-size* *block-gap*) 2) *block-gap*)
     'resource-handler :callback-type :keyword))


;#+:multiworld  (update-screen)
  )
#-:multiworld
(progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#-:ACT-R-6.0
(load (concatenate 'string (directory-namestring (current-pathname)) "device.lisp"))

(defclass monitor ()
  ((hot-regions :initform nil :initarg :hot-regions :accessor hot-regions)
   (monitor-process :initform nil :accessor monitor-process)
   (status :initform :running :initarg :running :accessor status)))

(defvar *mw* (make-instance 'monitor))

(defclass hot-region ()
  ((x1 :initform nil :initarg :x1 :accessor x1)
   (x2 :initform nil :initarg :x2 :accessor x2)
   (y1 :initform nil :initarg :y1 :accessor y1)
   (y2 :initform nil :initarg :y2 :accessor y2)
   (entered :initform nil :initarg :entered :accessor entered)
   (callback :initform nil :initarg :callback :accessor callback)
   (callback-type :initform :keyword :initarg :callback-type :accessor callback-type)))

(defun monitor-region (x1 y1 x2 y2 callback &key (callback-type :string))
  (push (make-instance 'hot-region
                       :x1 x1
                       :y1 y1
                       :x2 x2
                       :y2 y2
                       :callback callback
                       :callback-type callback-type
                       :entered nil)
        (hot-regions *mw*)))

(defun monitor-regions ()
  (setf (monitor-process *mw*)
        (mp:process-run-function
         "Monitor regions"
         nil
         'monitor-regions-internal)))

(defun kill-monitor ()
  (if (and (monitor-process *mw*)
           (mp:process-p (monitor-process *mw*)))
      (progn (mp:process-kill (monitor-process *mw*))
        (setf (hot-regions *mw*) nil))))

(defun monitor-regions-internal ()
  (let ((pos nil)
        (mouse-x nil)
        (mouse-y nil)
        (change-state nil)
        (button-down nil)
        (button-state nil))
    (loop
     (when (not (eq (status *mw*) :running)) (return))
     (capi:process-pending-messages nil)
     (sleep 0.02)
     (setf button-state (get-button-state))
     (if (equal button-down button-state)
         (setf change-state nil)
       (setf change-state t))
     (setf button-down button-state)

     (setf pos (mouse-position))
     (setf mouse-x (first pos))
     (setf mouse-y (second pos))
     
     (dolist (region (hot-regions *mw*))
       (cond
        ((and
          (not (entered region))
          (> mouse-x (x1 region))
          (< mouse-x (x2 region))
          (> mouse-y (y1 region))
          (< mouse-y (y2 region))
          (callback region))
         (mp:process-run-function
          "Enter callback" nil
          'apply (callback region) (list (if (equal (callback-type region) :keyword)
                                             :enter
                                           "ENTER")))
         (setf (entered region) t))
        ((and
          (entered region)
          (or (> mouse-x (x2 region))
              (< mouse-x (x1 region))
              (> mouse-y (y2 region))
              (< mouse-y (y1 region)))
          (callback region))
         (mp:process-run-function
          "Leave callback" nil
          'apply (callback region) (list (if (equal (callback-type region) :keyword)
                                             :leave
                                           "LEAVE")))
         (setf (entered region) nil))
        ((and
          (entered region)
          change-state
          (= button-state 1)
          (callback region))
         (mp:process-run-function
          "Click callback" nil
          'apply (callback region) (list (if (equal (callback-type region) :keyword)
                                             :click
                                           "CLICK")))
         ))))
    ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let (debug-log)
(defun get-debug-log() debug-log)

(defun log-info (data-list &key specify-time)
  #-ACT-R-6.0
   (declare (ignore  specify-time))
   (push (append (list 'debug (get-internal-real-time)) data-list) debug-log ))
)

) ;;end no multiworld


#|
(defparameter *lockouts*
  '((A . 0.0) (B . 0.2)
    (C . 0.4) (D . 0.8)
    (E . 1.6) (F . 3.2)
    (M . Nil)))
|#






(defun run-bw (&key (model t) (condition nil))


  (setf *bw* (make-instance 'BW-task))
   (if condition 
       (progn
         (setf *condition* condition)                 ;condition can be either 'A 'B 'C 'D 'E 'F or 'M (mixed!)
         (if (equal *condition* 'M)
             (setf (target-lockout *bw*) (nth (random 6) '(0.0 0.2 0.4 0.8 1.6 3.2)))
           (setf (target-lockout *bw*) (cdr (find *condition* *lockouts* :key #'car))))
         (setf *recent-lockouts* (list (target-lockout *bw*)))
         )
     )

  (start-bw-task)
  (monitor-regions)
  #+ACT-R-6.0
  (when model 
    (install-device (exp-window *bw*))
    (mp:process-run-function "actr" '() #'run-act 50  t *standard-output*)))


#+ACT-R-6.0
(defvar *act-out* nil)
(defun run-act (tm rt output) 
  (setq *standard-output* output)
  (setq *act-out* output)
  (run tm :real-time t) ;;;(run-until-stop :real-time rt)
)

#+ACT-R-6.0 
(progn

#|
(defun schedule-actr-break (tm msg)
  (schedule-break-relative tm :priority :min
   :details msg))

(let ((stop-actr nil))
  (defun stop-actr ()
    (setf stop-actr t))
  (defun clear-stop-actr ()
    (setf stop-actr nil))
  (defun stop-actr-p ()
    stop-actr))

(defun run-until-stop ( &key (real-time nil))
  (verify-current-mp  
   "run called with no current meta-process."
     (let ((tot-time 0) (tot-events 0) breakfl (tm (get-internal-real-time)))
       (clear-stop-actr)
       (while (null (stop-actr-p))
         (multiple-value-bind (time events break)
             (run-sched-queue (current-mp)
                              #'(lambda (mp next-time count) (declare (ignore mp next-time count))
                                  (stop-actr-p))
                              :real-time real-time) 
           (if (setq breakfl break) 
               (stop-actr)
             (progn (incf tot-time time) (incf tot-events events)))))
       (format *act-output* "~%Total real time ~S seconds" (/ (- (get-internal-real-time) tm) 1000.0))
       (values tot-time tot-events breakfl))))
|#

(defun get-device ()
  (device (current-device-interface)))

(defmacro defp (&rest body)
  `(p-fct ',body))


(defun get-vision ()
  (get-module :vision))

(defun get-chunk-types ()
  (let ((res nil))
    (dolist (c (all-dm-chunks (get-module declarative)))
      (push (act-r-chunk-type-name (act-r-chunk-chunk-type (get-chunk c))) res))
    (remove-duplicates res)))

(defun get-production-names ()
 (mapcar (lambda(x) (production-name x)) (procedural-productions (get-module procedural))))

(defun get-production-by-name (name)
  (get-production  name))

(defun show-buffers (&optional (bufs (buffers)))
  (if (atom bufs)
    (buffer-chunk-fct (list bufs))
    (dolist (buf bufs)
      (buffer-chunk-fct (list buf)))))

(defun show-events ()
  (meta-p-events (get-mp (current-meta-process))))


#|
(defmethod my-add-screen-objects ((obj-list LIST))
  (dolist (item obj-list)
    (add-screen-object item (get-module :vision))))

(defmethod my-add-screen-objects ((obj T))
  (add-screen-object obj (get-module :vision)))


|#

(defmethod add-and-delete-chunk-objects ((chunklist LIST) windowtype) ;(format *act-out* "~%add and delete ~S ~S" windowtype chunklist)
    ;; if the visicon already contains any element that's located in the same subwindow-type, then delete that object from the visicon
    (dolist (obj (visicon-chunks (get-module :vision)))
      (if (equal (chunk-slot-value-fct obj 'subwindowtype) windowtype)
          (progn
          (delete-screen-object (chunk-special-visual-object obj) (get-module :vision))
          (return))  ;return to save time???
                  
        )
      )
    
    ;now add the new chunks to the visicon
    (dolist (obj chunklist)
      (add-screen-object obj (get-module :vision))
      )
)


(defmethod add-and-delete-chunk-objects ((chunk T) windowtype)  ;(format *act-out* "~%add and delete ~S ~S" windowtype chunk)

    ;; if the visicon already contains any element that's located in the same subwindow-type, then delete that object from the visicon
    (dolist (obj (visicon-chunks (get-module :vision)))
      
      ;;;;;;;;;; first check if the visicon object is an object that has the subwindowtype property. E.g., if it is a subwindow or an object of a subwindow!!

      (if (equal (chunk-slot-value-fct obj 'subwindowtype) windowtype)
          (delete-screen-object (chunk-special-visual-object obj) (get-module :vision))
        )
      )
    
    ;now add the new chunks to the visicon
    (add-screen-object chunk (get-module :vision))
)



(defmethod update-workspace-window-new-block (newcolor row column)
"if a new block is placed in the workspace window, or a block is erased, this function updates the visicon"
  (let ((objectcolor nil)
        (dot_or_block nil)
        (x nil)
        (y nil)
        (width nil)
        (height nil)
        (i nil)
        (j nil)
        )

    ;;decide if a block is erased, or if a block is placed, and set variables accordingly
    (if (equal newcolor :erase)
        (setf objectcolor 'white
              dot_or_block 'dot-object
              width 5
              height 5
              )
      (setf objectcolor (get-ACT-R-color-name newcolor)
            dot_or_block 'block-object
            width *block-size*
            height *block-size*
            ))

    ;; delete old chunks that where at the same position; however, first save their x & y coordinates
    (dolist (obj (visicon-chunks (get-module :vision)))
      (if (and (equal (chunk-slot-value-fct obj 'subwindowtype) 'workspace) (equal (chunk-slot-value-fct obj 'row) row) (equal (chunk-slot-value-fct obj 'column) column))
          (progn 
            (setf x (chunk-slot-value-fct obj 'screen-x)
                  y (chunk-slot-value-fct obj 'screen-y)
                  i (chunk-slot-value-fct obj 'row)
                  j (chunk-slot-value-fct obj 'column)
                  )
            (delete-screen-object (chunk-special-visual-object obj) (get-module :vision))
             (return)     ;get out of the dolist-loop
            )
        ))
    
    ;; add the new chunk, which is either a dot or a block
    (add-screen-object (make-instance  'block-object
                                       :x x              ;set x-coordinate at the x-center (middle) of the circle
                                       :y y              ;set y-coordinate at the y-center (middle) of the circle
                                       :width width
                                       :height height
                                       :color objectcolor :userprop1 dot_or_block :userprop2 'workspace :userprop3 j :userprop4 i) (get-module :vision))
    

)

)


;;;; Mike's fixes to ACT-R bugs

(defmethod view-position ((view capi:interface))
  (if (capi:top-level-interface-p view)
      (multiple-value-bind (x y w h) (capi:top-level-interface-geometry view)
        (declare (ignore w h)) (vector x y))
  (capi:with-geometry view (vector capi:%x% capi:%y%))))

(defmethod build-vis-locs-for ((self capi:simple-pane) (vis-mod vision-module))
  (declare (ignore vis-mod))
  (let ((f (car (define-chunks-fct `((isa visual-location
                                         screen-x ,(px (view-loc self))
                                          screen-y ,(py (view-loc self))
                                          kind visual-object
                                          value unknown))))))
    (setf (chunk-visual-object f) self)
    f))

(defmethod build-vis-locs-for ((self block-object) (vis-mod vision-module))
  (declare (ignore vis-mod))
  (let ((f (car (define-chunks-fct `((isa block-location
                                         screen-x ,(screen-x self)               
                                          screen-y ,(screen-y self)
                                          width ,(width self)
                                          height ,(height self)
                                          kind ,(userprop1 self)
                                          color ,(color self)
                                          subwindowtype ,(userprop2 self)
                                          row ,(userprop3 self)
                                          column ,(userprop4 self)
                                          ))))))
    (setf (chunk-visual-object f) self)
    f))


(defmethod build-vis-locs-for ((self icon-feature) (vis-mod vision-module))
  (declare (ignore vis-mod))
  (let ((f (car (define-chunks-fct `((isa subwindow-location
                                         screen-x ,(screen-x self) 
                                          screen-y ,(screen-y self)
                                          width ,(width self)
                                          height ,(height self)
                                          kind subwindow
                                          color ,(color self)
                                          ))))))
    (setf (chunk-visual-object f) self)
    f))

(defmethod build-vis-locs-for ((self button-object) (vis-mod vision-module))
  (declare (ignore vis-mod))
  (let ((f (car (define-chunks-fct `((isa button-location
                                         screen-x ,(screen-x self) 
                                          screen-y ,(screen-y self)
                                          value ,(val self)                   ;;;;;;check if this is correct!
                                          width ,(width self)
                                          height ,(height self)                                          
                                          kind button-object
                                          color ,(color self)
                                          subwindowtype ,(userprop2 self)
                                          ))))))
    (setf (chunk-visual-object f) self)
    f))

(defmethod build-vis-locs-for ((self subwindow-object) (vis-mod vision-module))
  (declare (ignore vis-mod))
  (let ((f (car (define-chunks-fct `((isa subwindow-location
                                          screen-x ,(screen-x self) 
                                          screen-y ,(screen-y self)
                                          ;value ,(val self)                   ;;;;;;check if this is correct!
                                          width ,(width self)
                                          height ,(height self)
                                          kind subwindow
                                          color ,(color self)
                                          subwindowtype ,(userprop2 self)
                                          ))))))
    (setf (chunk-visual-object f) self)
    f))




(defmethod vis-loc-to-obj ((win BW-interface) loc)
  (declare (ignore win))
  (car (define-chunks-fct `((isa ,(chunk-slot-value-fct loc 'kind) 
                                 value ,(chunk-slot-value-fct loc 'value)
                                 color ,(chunk-slot-value-fct loc 'color)
                                 height ,(chunk-slot-value-fct loc 'height)
                                 width ,(chunk-slot-value-fct loc 'width)
                                 subwindowtype ,(chunk-slot-value-fct loc 'subwindowtype)
                                 row ,(chunk-slot-value-fct loc 'row)
                                 column ,(chunk-slot-value-fct loc 'column)
                                 )))))



(defmethod vis-loc-to-obj ((win block-object) loc)
  (declare (ignore win))
  (car (define-chunks-fct `((isa ,(chunk-slot-value-fct loc 'kind) 
                                 value ,(chunk-slot-value-fct loc 'value)
                                 color ,(chunk-slot-value-fct loc 'color)
                                 height ,(chunk-slot-value-fct loc 'height)
                                 width ,(chunk-slot-value-fct loc 'width)
                                 subwindowtype ,(chunk-slot-value-fct loc 'subwindowtype)
                                 row ,(chunk-slot-value-fct loc 'row)
                                 column ,(chunk-slot-value-fct loc 'column)
                                 )))))

(defmethod vis-loc-to-obj ((win button-object) loc)
  (declare (ignore win))
  (car (define-chunks-fct `((isa ,(chunk-slot-value-fct loc 'kind) 
                                 value ,(chunk-slot-value-fct loc 'value)
                                 color ,(chunk-slot-value-fct loc 'color)
                                 height ,(chunk-slot-value-fct loc 'height)
                                 width ,(chunk-slot-value-fct loc 'width)
                                 subwindowtype ,(chunk-slot-value-fct loc 'subwindowtype)
                                 )))))



(defmethod get-ACT-R-color-name (color-symbol)
  "based on a name of a color in the BW environment (e.g. :blue :white), returns a value that ACT-R can interpret (e.g. blue white)"
  (case color-symbol 
    (:red 'red)
    (:orange 'orange)
    (:yellow 'yellow)
    (:green 'green) 
    (:blue 'blue)
    (:purple 'purple)
    (:light-blue 'light-blue)
    (:pink 'pink)  
    (:black 'black)
    (:white 'white)
    ;(:erase 'erase)
    (otherwise (format t "There is an error in the color processing") 'error-color)
        ))



;;;; functions to get placeHolders


(defun updatePlaceHolder (row column placedOrEncoded oldPlaceCounter)
  "if a block is either encoded or placed at position (row,column), update the relevant index of the oldPlaceCounter, and return the newPlaceCounter"
  (let ((x nil))
    (case placedOrEncoded
      ('placed (setf x 'placed))
      ('encoded (setf x 'encoded))
      (otherwise (format t "ERROR IN FUNCTION updatePlaceCounter")))

    (if x  ;if x is not equal to nil
        (setf (svref oldPlaceCounter (+ (* 4 row) column)) x))
    oldPlaceCounter))


(defun getRowPlaceHolder (index)
  (let ((x (floor (/ index 4))))
    x)

)
  

(defun getColumnPlaceHolder (index)
  (let ((x index))
    (if (> index 3)
        (setf x (mod index 4)))
    x))



(clear-all)






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; start of the ACT-R Model
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-model Blocks_World_Task_ACT_R_6


(home-hands (get-module :motor))

(set-cursor-position 500 500)   ;start within the screen

(hand-to-mouse (get-module :motor))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sgp 	
        ;output related
        :v t                  ;produce output/trace
        :trace-detail medium    ;detail of output trace
        :show-focus t         ;show where model looks t/nil

        ;subsymbolic processing (for chunks) related
	:esc t    	      ;enable subsymbolic processing
	:ol nil               ;optimized learning
        :er t                 ;enable randomness
        :bll 0.5              ;base level learning
        :ans 0.25             ;activation noise (default nil, noise added if positive number)
        :lf 1                 ;latency-factor (default: 1)
        :rt 0                 ;retrieval threshold (tau) (default 0)

        ;production-rule related
        :ul t                 ;utility learning
        :egs 2                ;expected noise parameter (0 default = no noise). Sets the s of noise equation

        ;other parameters
        :ncnar nil              ;normalize chunk-names after each run


	:visual-finst-span 100 
	:visual-num-finsts 100 

        :declarative-num-finsts 10     ;number of items in declarative memory of which a finst is set. Defaults to 4.
        :declarative-finst-span 10     ;time a declarative memory item is considered as "recently retrieved"; defaults to 3 (seconds)



)


;;visual objects related chunks
(chunk-type (subwindow-object (:include visual-object)))
(chunk-type (button-object (:include visual-object)) subwindowtype)
(chunk-type (button (:include visual-object)))
(chunk-type (subwindow (:include visual-object)))                         ;the gray areas that cover the subwindows are of chunk-type subwindow
(chunk-type (block-object (:include visual-object)) subwindowtype row column)
(chunk-type (dot-object (:include visual-object)) subwindowtype row column)
(chunk-type (eraser-object (:include visual-object)) subwindowtype row column)
(chunk-type (block-location (:include visual-location)) subwindowtype row column)
(chunk-type (subwindow-location (:include visual-location)) subwindowtype)                  ;changed
(chunk-type (button-location (:include visual-location)) subwindowtype)
(chunk-type (subwindowtype (:include visual-object)))


;;goal related chunks
(chunk-type solveBWT blocksplaced state)        ;the goal-chunk


;;imaginal related chunks
(chunk-type encodingcounter encoded placeHolder)    ;placeHolder tries to find the place of a chunk  

(define-chunks 
 ;;window types
 (target isa chunk)
 (workspace isa chunk)
 (resource isa chunk)
 (button isa chunk)
 
 ;;colors that ACT-R doesn't yet know
 ;(red isa chunk)
 (orange isa chunk)
 ;(yellow isa chunk)
 ;(green isa chunk)
 ;(blue isa chunk)
 (purple isa chunk)
 (light-blue isa chunk)
 (pink isa chunk)
 (gray isa chunk)
 ;(black isa chunk)

 ;;objects
 (eraser isa chunk)
 (eraser-object isa chunk)
 (dot-object isa chunk)
 (block-object isa chunk)
 (button-object isa chunk)
 (subwindow isa chunk)


 ;states used by goal

)




;; put goal in declarative memory
(add-dm
 (goal0 isa solveBWT blocksplaced 0 state start)
)




;;;
;;; start productions here
;;;




(p solveBWT-start1
"start by looking at the start button"
   =goal>
      isa solveBWT
      state start
   ?visual-location>
      state free
==>
   +visual-location>                ;automatically move to start-button
      isa button-location
      ;> screen-x 800
      ;> screen-y 600
)

(p solveBWT-start2-move-mouse-and-eyes-to-start-button
"if you have a button with value start as vis-loc, move mouse and eyes to it"
   =goal>
      isa solveBWT
      state start
   =visual-location>
      isa button-location
      value start
   ?visual>
      state free
   ?manual>
      state free
==>
   +manual>
      isa move-cursor
      loc =visual-location
   +visual>
      isa move-attention
      screen-pos =visual-location
   =goal>
      state press-start
)


(p solveBWT-press-start
"if you attend the start button and the hands are free, press it to start. 
Also create an imaginal buffer chunk called encodingcounter, to store how many items you encode"
   =goal>
      isa solveBWT
      state press-start
   ?manual>
      state free
   ?visual>
      state free
   =visual>                  
      isa button-object
      value start
   ?imaginal>
      state free
==>
    !safe-bind! =placeHolderVector (make-array 16 :initial-element nil)
   -visual>
   +manual>
      isa click-mouse      ;click start
   =goal>
      state start-study
   +visual-location>       ;move eyes to target window
      isa subwindow-location
      subwindowtype target
   +imaginal>                     ;create an imaginal buffer to count the number of encoded items during each visit to the target window
      isa encodingcounter
      encoded 0
      placeHolder =placeHolderVector
)

(p solveBWT-start-study
"start the study by moving the mouse to the target window and try to retrieve the last item you attended"
   =goal>
      isa solveBWT
      state start-study
   =visual-location>
      isa subwindow-location
      subwindowtype target
   ?visual>
      state free
   ?manual>
      state free
==>
   =goal>
      state study1st
   +manual>                                ;;first move cursor and NOT attention, so that model doesn;t encode all the blocks in memory right away
      isa move-cursor
      loc =visual-location
   +retrieval>
      isa block-object
      subwindowtype target
)
   



(p solveBWT-study1st-based-on-retrieval-error
"if you start your study, but could not retrieve an item from memory, just start with the top-left most item"
   =goal>
      isa solveBWT
      state study1st
      < blocksplaced 8
   ?visual-location>
      state free
   ?manual>
      state free
   ?retrieval>
      state error
==>
   =goal>
      state study
   +visual-location>
      isa block-location
      kind block-object
      subwindowtype target
      screen-y lowest         ;go for the highest block
      screen-x lowest         ;then for the block most to the left (ACT-R works through these constraints in order)
)



;; to deal with delay in updating visicon
(p solveBWT-study1st-based-on-retrieval-error-FAIL
"if you fail to find a blockobject, this can be due to delay in updating the visicon, so just keep on trying to find it"
   =goal>
      isa solveBWT
      state study
      < blocksplaced 8
   ?visual-location>
      state error
   ?retrieval>
      state error
==>
   =goal>
      state study1st
   +visual-location>
      isa block-location
      kind block-object
      subwindowtype target
      screen-y lowest
      screen-x lowest
)


(p solveBWT-study1st-based-on-retrieval-success
"if you start your study and retrieved an item from memory try to find this item again"
   =goal>
      isa solveBWT
      state study1st
      < blocksplaced 8
   ?visual-location>
      state free
   ?manual>
      state free
   =retrieval>
      isa block-object
      subwindowtype target
      screen-pos =position_previous_target
      row =row-position
      column =column-position
==>
   =goal>
      state find-retrieved-item-in-target-window
   =retrieval>                 ;keep item in buffer
   +visual-location>
      isa block-location
      kind block-object               ;first find the block itself, to make sure that there are items visible
      row =row-position
      column =column-position
      subwindowtype target
)


;; to overcome a delay in updating the visicon
(p solveBWT-find-retrieved-item-in-target-window-fail
"if an item in the visicon is not found, keep on looking for it"
   =goal>
      isa solveBWT
      state find-retrieved-item-in-target-window
      < blocksplaced 8
   ?visual-location>
      state error
   =retrieval>
      isa block-object
      subwindowtype target
      screen-pos =position_previous_target
      row =row-position
      column =column-position

==>
   =goal>
      state study1st
   +visual-location>
      isa block-location
      kind block-object               ;first find the block itself, to make sure that there are items visible
      row =row-position
      column =column-position
      subwindowtype target
   =retrieval>
)


(p solveBWT-find-retrieved-item-in-target-window-success
"if you found the item you retrieved from memory also on the screen, then try to find an item that's in the same row"
   =goal>
      isa solveBWT
      state find-retrieved-item-in-target-window
   =visual-location>
      isa block-location
      kind block-object
      row =row-position
      column =column-position
      subwindowtype target
   =retrieval>
      isa block-object
      subwindowtype target
      screen-pos =position_previous_target
      row =row-position
      column =column-position
==>
   =goal>
      state study
   =retrieval>
   +visual-location>
      isa block-location
      kind block-object          
      subwindowtype target
      row =row-position             ;find item in same row
      > column =column-position     ;but that's more to the right
      screen-x lowest               ;find the one that's closests to the current object
)      


(p solveBWT-study3-failure-to-find-same-row
"if you tried to find an item in the same row as a retrieved item but failed, try to find one in a next row, that's closest to the top-left-corner"
   =goal>
      isa solveBWT
      state study
   ?visual-location>
      state error
   =retrieval>
      isa block-object
      subwindowtype target
      screen-pos =position_previous_target
      row =row-position
      column =column-position
==>
   =goal>
      state study
   =retrieval>
   +visual-location>
      isa block-location
      > row =row-position     ;try to find a block in next rows
      kind block-object
      subwindowtype target
      screen-y lowest
      screen-x lowest
)











;;;;routine for watching and encoding an item

(p solveBWT-study4-watch-item
   "if you have a vis-loc of an item you want to study, move visual-attention to it"
   =goal>
      isa solveBWT
      state study
   =visual-location>
      isa block-location
      kind block-object
      subwindowtype target
   ?visual>
      state free
==>
   =goal>
      state encode-item
   +visual>
      isa move-attention
      screen-pos =visual-location
   !eval! (print-visicon)
)

#|
(p solveBWT-encode-item
   "if you're studying an item, update the encodingcounter"
   =goal>
      isa solveBWT
      state encode-item
      < blocksplaced 8
   =visual>
      isa block-object
   ?imaginal>
      state free
   =imaginal>
      isa encodingcounter
      encoded =old_encoded
==>
   !safe-bind! =new_encoded (+ =old_encoded 1)              ;reference manual page 135: update the encoded counter with 1
   =visual>                                                 ;keep the visual item in memory, so you can use this info for next item to encode
   =imaginal>
      encoded =new_encoded
   =goal>
      state study
   !eval! (print-visicon)
   !eval! (buffer-chunk visual)
)
|#

(p solveBWT-encode-item-other-implementation
   "if you're studying an item, update the encodingcounter"
   =goal>
      isa solveBWT
      state encode-item
      < blocksplaced 8
   =visual>
      isa block-object
      row =row-position
      column =column-position
   ?imaginal>
      state free
   =imaginal>
      isa encodingcounter
      encoded =old_encoded
      placeHolder =old_placeHolder
==>
   !safe-bind! =new_encoded (+ =old_encoded 1)              ;reference manual page 135: update the encoded counter with 1
   !safe-bind! =new_placeHolder (updatePlaceHolder =row-position =column-position 'encoded =old_placeHolder)
   +visual-location>                                                 ;add visual-location
      isa block-location
      subwindowtype target
      row =row-position
      column =column-position      
   =imaginal>
      encoded =new_encoded
      placeHolder =new_placeHolder
   =goal>
      state watch-2nd-time
)

(p solveBWT-study4-watch-item-2nd-time
   "if you have a vis-loc of an item you want to study, move visual-attention to it"
   =goal>
      isa solveBWT
      state watch-2nd-time
   =visual-location>
      isa block-location
      kind block-object
      subwindowtype target
   ?visual>
      state free
==>
   =goal>
      state redecide-continue-study-or-start-placing
   +visual>
      isa move-attention
      screen-pos =visual-location
)



(p solveBWT-redecide-continue-study-or-start-placing
   =goal>
      isa solveBWT
      state redecide-continue-study-or-start-placing
      < blocksplaced 8
   =visual>
      isa block-object
==>
   =visual>                                                 ;keep the visual item in memory, so you can use this info for next item to encode
   =goal>
      state study
)





;;; the following are production rules for finding the next-items to encode, given that a previous number of encoded are encoded in the imaginal buffer's encodingcounter
;;; afer a firing of each of these rules, they are followed by the rules "watch-item" and "encode-item"
;;; each time that "encode-item" has fired, the model has to choose either to start with placing items, or to encode another item

(p solveBWT-study5-find-2nd-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 7
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 1
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest
      subwindowtype target
)

(p solveBWT-study5-find-3rd-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 6
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 2
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest
      subwindowtype target
)


(p solveBWT-study5-find-4th-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 5
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 3
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest
      subwindowtype target
)

(p solveBWT-study5-find-5th-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 4
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 4
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest
      subwindowtype target
)


(p solveBWT-study5-find-6th-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 3
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 5
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest
      subwindowtype target
)



(p solveBWT-study5-find-7th-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 2
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 6
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest
      subwindowtype target
)


(p solveBWT-study5-find-8th-item
   =goal>
      isa solveBWT
      state study
      < blocksplaced 1
   ?visual-location>
      state free
   =imaginal>
      isa encodingcounter
      encoded 7
   =visual>
      isa block-object
      row =old_row
      column =old_column
==>
   =goal>
      state study
   =imaginal>
   =visual>
   +visual-location>
      isa block-location
      kind block-object
      row =old_row
      > column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      :attended nil
      screen-x lowest          ;select the one that's nearest to the current item, but within the same row
      subwindowtype target
)




(p solveBWT-study5-find-nth-item-in-next-row
   "if you wanted to find an item in the same row as an item you're attending, move to the next row"
   =goal>
      isa solveBWT
      state study
   =visual>
      isa block-object
      row =old_row
      column =old_column
   ?visual-location>        ;failed to find the right column
      state error
==>
   =goal>
      state study
   =imaginal>
   ;=visual>
   +visual-location>
      isa block-location
      kind block-object
      > row =old_row                          ;try to find an item in the next row
      :attended nil
      screen-y lowest
      screen-x lowest
      ;> column =old_column                    ;try to find an item in same row, but different column (e.g., work from left to right)
      subwindowtype target
)










;;;; end of production rules for encoding items in memory


;;this rule is in competition with the encoding rules
(p solveBWT-study6-start-placing-items
"if you're done encoding items, start to place them. First move vis-loc to resource window"
   =goal>
      isa solveBWT
      state study
      < blocksplaced 8
   =imaginal>                  ;only start placing if you have 1 or more items encoded
      isa encodingcounter
      > encoded 0
   ?visual-location>
      state free
   =visual>                   ;you were attending a block-object
      isa block-object
      row =old_row
      column =old_column
==>
   =imaginal>                    ;keeep encouding encounter in memory
   =goal>
      state find-resource-window
   +visual-location>
      isa subwindow-location
      subwindowtype resource
)


(p solveBWT-find-resource-window
   "if the resource window is found, move mouse and visual attention to it, and start to retrieve an encoded block-item from memory"
   =goal>
      isa solveBWT
      state find-resource-window
      < blocksplaced 8
   =imaginal>                  ;only start placing if you have 1 or more items encoded
      isa encodingcounter
      > encoded 0
   =visual-location>                   ;you are looking at the resource window
      isa subwindow-location
      subwindowtype resource
   ?retrieval>
      state free
   ?manual>
      state free
   ?visual>
      state free
==>
   =goal>
      state go-to-resource-block
     
   =imaginal>                       ;keep imaginal buffer filled
   =visual-location>
   +manual>
      isa move-cursor
      loc =visual-location
   +visual>
      isa move-attention
      screen-pos =visual-location          ;changed
   +retrieval>
      isa block-object
      subwindowtype target
      :recently-retrieved nil
)





(p solveBWT-go-to-resource-block
"if you've retrieved an item from memory that you now want to place, move vis-loc to a block of that color"
   =goal>
      isa solveBWT
      state go-to-resource-block
      < blocksplaced 8
   =imaginal>                  ;only start placing if you have 1 or more items encoded
      isa encodingcounter
      > encoded 0
   =retrieval>
      isa block-object
      subwindowtype target
      color =col
   ?manual>
      state free
==>
   =retrieval>                            
   =imaginal>
   =goal>
      state move-vis-loc-to-resource
   +visual-location>
      isa block-location
      color =col
      kind block-object
      subwindowtype resource
)



;; to deal with potential delay in updating visicon
(p solveBWT-move-vis-loc-to-resource-fail
   "if failed to find a block in the resource window, retry it, as this might be due to delay in updating the visicon"
   =goal>
      isa solveBWT
      state move-vis-loc-to-resource
      < blocksplaced 8
   ?visual-location> 
      state error
 ==>
   =goal> 
      state go-to-resource-block
)

(p solveBWT-go-to-resource-block2-retrieval-fail
"if failed to retrieve an item from memory that you want to place, start studying again, by moving vis-loc to target window"
   =goal>
      isa solveBWT
      state go-to-resource-block
      < blocksplaced 8
   =imaginal>                  ;only start placing if you have 1 or more items encoded
      isa encodingcounter
      > encoded 0
      placeHolder =old_placeHolder
   ?retrieval>               ;failed to retrieve a block from memory
      state error
   =visual-location>                   ;you are looking at the resource window
      isa subwindow-location
      subwindowtype resource
==>
   !safe-bind! =new_placeHolder (make-array 16 :initial-element nil)
   =goal>
      state start-study              ;start again with studying the resource window
   =imaginal>                        ;realise that you don't remember all the items again, so reset encoder
      encoded 0
      placeHolder =new_placeHolder
   +visual-location>                 ;move to target window
      isa subwindow-location
      subwindowtype target
)






(p solveBWT-move-vis-loc-to-resource
"once you've moved your vis-loc to a resource, move mouse and attention to it"
   =goal>
      isa solveBWT
      state move-vis-loc-to-resource
   =visual-location>
      isa block-location
      kind block-object
      subwindowtype resource
   ?manual>
      state free
   ?visual>
      state free
==>
   =goal>
      state move-attention-and-mouse-to-resource
   +visual>
      isa move-attention
      screen-pos =visual-location
   +manual>
      isa move-cursor
      loc =visual-location
)

(p solveBWT-move-attention-and-mouse-to-resource
"click on a resource, and move vis-loc to workspace window"
   =goal>
      isa solveBWT
      state move-attention-and-mouse-to-resource
   ?manual>
      state free
   =visual>
      isa block-object
   ?visual-location>
      state free
==>
   =goal>
      state move-attention-to-workspace
   +manual>
      isa click-mouse
   +visual-location>
      isa subwindow-location         ;go to workspace window
      subwindowtype workspace
)

(p solveBWT-move-attention-to-workspace
   "once your vis-loc is on the workspace, move the block with the mouse there"
   =goal>
      isa solveBWT
      state move-attention-to-workspace
   ?manual>
      state free
   =visual-location>
      isa subwindow-location
      subwindowtype workspace
==>
   =goal>
      state move-block-to-workspace-main
   +manual>
      isa move-cursor
      loc =visual-location
   ;+visual>
   ;   isa move-attention
   ;   screen-pos =visual-location                 ;;changed: does this work????
)


(p solveBWT-move-block-to-workspace-main
   "if the cursor has moved a resource block to the workspace window, now find the exact row and column where it's placed"
   =goal>
      isa solveBWT
      state move-block-to-workspace-main
   =retrieval>
      isa block-object
      row =row-location
      column =column-location
   ?manual>
      state free
   ?visual-location>
      state free
==>
   =retrieval>
   =goal>
      state move-vis-loc-to-block-position-in-workspace
   +visual-location>
      isa block-location         ;can be either a block-object or dot-object
      row =row-location
      column =column-location
      subwindowtype workspace
)



;; to overcome delay in updating the visicon
(p solveBWT-move-vis-loc-to-block-position-in-workspace-fail
   "if failed to find a block location in the workspace, retry it, as this might be because the visicon hasn't updated"
   =goal>
      isa solveBWT
      state move-vis-loc-to-block-position-in-workspace
      < blocksplaced 8
   ?visual-location> 
      state error
 ==>
   =goal>
      state move-block-to-workspace-main
)




(p solveBWT-move-vis-loc-to-block-position-in-workspace
   "if the location of a block in the workspace window has been found, now move the block and visual attention to that location"
   =goal>
      isa solveBWT
      state move-vis-loc-to-block-position-in-workspace
   =visual-location>
      isa block-location          ;can be either a dot-object or block-object
      row =row-location
      column =column-location
      subwindowtype workspace
   =retrieval>
      isa block-object
      row =row-location
      column =column-location
   ?manual>
      state free
   ?visual>
      state free
==>
   =goal>
      state place-block
   =retrieval>
   +visual>
      isa move-attention
      screen-pos =visual-location
   +manual>
      isa move-cursor
      loc =visual-location
)



(p solveBWT-place-block1-place
   "if at the workspace locatio where you want to place a block is now a dot, place the block and update the blocksplaced counter in the goal buffer with 1; also decrease the encodingcounter of the imaginal buffer"
   =goal>
      isa solveBWT
      state place-block
      blocksplaced =old_blocksplaced
   =visual>
      isa dot-object          ;can be either a dot-location or a blocks-location
      row =row-location
      column =column-location
   ?manual>
      state free
   =retrieval>
      isa block-object
      row =row-location
      column =column-location
   =imaginal>
      isa encodingcounter
      encoded =old_encoded
      placeHolder =old_placeHolder
==>
   !safe-bind! =new_encoded (- =old_encoded 1)              ;reference manual page 135: update the encoded counter with -1
   !safe-bind! =new_blocksplaced (+ =old_blocksplaced 1) 
   !safe-bind! =new_placeHolder (updatePlaceHolder =row-location =column-location 'encoded =old_placeHolder)
   =goal>
      state decide-after-placing
      blocksplaced =new_blocksplaced
   =imaginal>
      encoded =new_encoded
      placeHolder =new_placeHolder
   +manual>
      isa click-mouse
   ;implicitly clear retrieval-buffer
)


(p solveBWT-place-block2-replace
   "if at the workspace locatio where you want to place a block is already a block, place the block and DO NOT update the blocksplaced counter (as you replaced a block); 
   still, decrease the encodingcounter of the imaginal buffer"
   =goal>
      isa solveBWT
      state place-block
      blocksplaced =old_blocksplaced
   =visual>
      isa block-object          ;can be either a dot-location or a blocks-location
      row =row-location
      column =column-location
   ?manual>
      state free
   =retrieval>
      isa block-object
      row =row-location
      column =column-location
   =imaginal>
      isa encodingcounter
      encoded =old_encoded
      placeHolder =old_placeHolder
==>
   !safe-bind! =new_encoded (- =old_encoded 1)              ;reference manual page 135: update the encoded counter with -1
   !safe-bind! =new_placeHolder (updatePlaceHolder =row-location =column-location 'encoded =old_placeHolder)
   =goal>
      state decide-after-placing
      blocksplaced =old_blocksplaced
   =imaginal>
      encoded =new_encoded
      placeHolder =new_placeHolder
   +manual>
      isa click-mouse
   ;implicitly clear retrieval-buffer
)






;;after placing a block, you either:
;; A. still have blocks encoded in memory, and try to remember that -> remember-new-block
;; B. have no blocks encoded in memory, but are not fully done with placing pattern -> restart-study
;; C. have a complete pattern -> move to stop-button 

(p solveBWT-decide-after-placing1-decide-remember-new-block
   "when done placing a block, decide to try to remember another one to place, as your encodingcounter says you've encoded more"
   =goal>
      isa solveBWT
      state decide-after-placing
      < blocksplaced 8               ;if you still have to place blocks
   =imaginal>
      isa encodingcounter
      > encoded 0                    ;and you have encoded an item in memory
   ?retrieval>
      state free
   ?visual-location>
      state free
==>
   =goal>
      state find-resource-window
   =imaginal>
;   +retrieval>                       ;try to remember a new block
;      isa block-object
;      :recently-retrieved nil
;      subwindowtype target
   +visual-location>                 ;move to resource-window
      isa subwindow-location
      subwindowtype resource
)

(p solveBWT-decide-after-placing2-decide-restart-study
   "when done placing a block, and there are no more blocks encoded, decide to restart studying"
   =goal>
      isa solveBWT
      state decide-after-placing
      < blocksplaced 8
   =imaginal>
      isa encodingcounter
      encoded 0                     ;you don't have any more items encoded
   ?visual-location>
      state free
==>
   =goal>
      state start-study
   =imaginal>                        ;keep imaginal buffer
   +visual-location>                 ;move to target window
      isa subwindow-location
      subwindowtype target
)

(p solveBWT-decide-after-placing3-decide-stop-trial
   "when done placing a block, and you've placed 8 blocks (indicated in goal chunk slot blocksplaced), decide to stop the current trial"
   =goal>
      isa solveBWT
      state decide-after-placing
      blocksplaced 8
   ?visual-location>
      state free
==>
   =goal>
      state begin-stop-trial
   +visual-location>                 ;move to start/stop button
      isa button-location
)
















;;;;;;;;;;;;;productions for stopping a trial
(p solveBWT-begin-stop-trial
   "if decided to stop, and your visloc is a stopbutton, move mouse and visual attention to it"
   =goal>
      isa solveBWT
      state begin-stop-trial
   =visual-location>
      isa button-location
   ?visual>
      state free
   ?manual>
      state free
==>
   =goal>
      state move-to-stop-button
    +manual>
       isa move-cursor
       loc =visual-location
    +visual>
       isa move-attention
       screen-pos =visual-location
)


(p solveBWT-move-to-stop-button
   "if mouse and visual attention is on stop button, press it"
   =goal>
      isa solveBWT
      state move-to-stop-button
   =visual>
      isa button-object
      value stop
   ?manual>
      state free
==>
   =goal>
      state done
   +manual>
      isa click-mouse
)


 ;place here a production to start the next study with a +goal
(p solveBWT-done-correct
   =goal>
      isa solveBWT
      state done
   ?manual>
      state free
   =imaginal>       ;implicitly clear the imaginal buffer
      isa encodingcounter  ;;;; place here some evaluation for if the thought of the model was correct
==>
   +goal>
      isa solveBWT
      state start
      blocksplaced 0
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;end of productions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;give goal focus here

(goal-focus goal0)



;;;reward functions:

;; if you've solved the BWT completely, reward with 8 points
(spp solveBWT-done-correct :reward 8)


;; if you think you've solved BWT completely, but have made an error, give only amount of points of correct items


;;if you replace an item, give a negative reward (costly)
(spp place-block2-replace :reward -1)





);end of define-model

);end of ACT-R progn





;;;;;;;;;comments of Chris:



#| a general rule that might be useful:

;;perhaps start this rule with a goal state of "start-moving-mouse-and-eyes"
;;and end with "stop-moving-mouse-and-eyes"

(p move-mouse-and-eyes
   =goal>
      isa solveBWT
      ;here should be extra checks to make sure the rule fires at the right moments (e.g. that the state is not one in which user is studying)
   =visual-location>
      isa visual-location
   ?visual>
      state free
   ?manual>
      state free
==>
   =goal>
   +manual>
      isa move-cursor
      loc =screen-pos
   +visual>
      isa move-attention
      screen-pos =visual-location
)







|#