spatial.lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Frank Tamborello
;;; Copyright   : (c)2009-10 Frank Tamborello & Hongbin Wang
;;;		: The University of Texas Health Science Center at Houston 
;;;		: (UTHSC-H), All Rights Reserved
;;; Availability: public domain
;;; Address     : University of Texas Health Science Center at Houston
;;;             : School of Health Information Sciences
;;;		: 7000 Fannin, Ste. 600
;;;             : Houston, TX 77030
;;;             : franklin.tamborello@uth.tmc.edu
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the Lisp Lesser General Public
;;; License: the GNU Lesser General Public License as published by the
;;; Free Software Foundation (either version 2.1 of the License, 
;;; or, at your option, any later version),
;;; and the Franz, Inc Lisp-specific preamble.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the Lisp Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
;;; and see Franz, Inc.'s preamble to the GNU Lesser General Public License,
;;; http://opensource.franz.com/preamble.html.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : spatial.lisp
;;; Version     : 1.0
;;;
;;; Description : A module for ACT-R 6 that does human spatial cognition, 
;;;		particularly for the egocentric and intrinsic frames of 
;;;		reference (FORs). For now the only buffer is "spatial", but that
;;;		may well change in the near-future.
;;; 
;;; Usage 	: Place in one of ACT-R's autoload directories, like "modules,"
;;;		so that it loads with the rest of ACT-R, before any models.
;;; 
;;; Bugs        : Productions requesting creation of any spatial chunk must also
;;;		use a '=visual' to prevent buffer clearing of the visual buffer
;;;		before the spatial module has a chance to use the visual buffer
;;;		chunk, or else turn strict harvesting off for the visual buffer.
;;; 
;;; todo	: * only one buffer, let's call it "spatial," should accept
;;;		requests for the entire module
;;;		: * complete noise mechanism for space parsing
;;;		: * switch noise function on & off with global :er parameter -> 
;;;		: the request function will check the value of the param-er field 
;;;		: of the spatial-module struct
;;;		: * screen-centered-location: work with X & y coords, then
;;;		: more than just x & y coords, like 
;;;		: nearest, current, and modifiers        
;;; 
;;; ----- History -----
;;; 2009.07.09	fpt [r1]
;;;	: inception
;;; 2009.07.16	fpt [r2] 
;;;	: get spatial module to calculate distance between the 
;;;	: currently-attended visual-object and a visual-location,
;;;	: returning it as an ifor chunk
;;; 2009.09.16	fpt [r2.1]
;;;	: added chunk-types & buffers from the ACT-R 5 space-module.
;;; 2009.09.21	fpt [r3]
;;;	: added a functional viewing-distance parameter
;;; 2009.09.29 	fpt [r4]
;;;	: added a noise function
;;;	: added two parameters to control the noise function
;;; 2010.04.23	fpt [r5[
;;;	: make the EFOR buffers (body-central hand-central eye-central,
;;;	& allo-central) do some stuff
;;;	: Deleted the spatial buffer
;;; 2010.04.26 fpt [r5.1]
;;;	: screen-based-location chunk creation either uses specified locations
;;;	or whatever's in the visual buffer
;;; 2010.04.27 fpt [r6]
;;;	: the egocentric space will be divided into 9 sectors: center, up, 
;;;	up-right, right, down-right, down, down-left, left, and up-left. For now
;;;	"center" and "not-center" are implemented.
;;; 2010.04.28 fpt [r6.1]
;;;	: request-spatial now has helper functions for screen-based-locations
;;; 2010.05.06 fpt [r7]
;;;	: added additional sectors for the module to parse space into
;;; 2010.05.07 fpt [r8]
;;;	: added noisiness for sector computation
;;;	... or rather started to
;;; 2010.05.11 fpt [r9]
;;;	: Changed the sector parsing mechanism to use polar coordinates
;;;	converted from the Lisp device space's Cartesian system rather than
;;;	parsing Lisp's Cartesian coordinates directly.
;;; 2010.05.11 fpt [r10]
;;;	: Changed chunk-types to reflect the spatial ontology I developed with
;;;	Hongbin & Yanlong.
;;; 2010.05.11 fpt [r11]
;;;	: Add ability to set axis of polar coordinates for space parsing to 
;;;	arbitrary orientations
;;;	: And renamed the sbl- functions to parse-space- since we're no longer
;;;	dealing with "screen-based-location" chunks, and that's a more accurate
;;;	name for what those functions do.
;;; 2010.05.11 fpt [r12]
;;;	: Allocentral buffer & place chunks can now be requested. 
;;; 2010.05.11 fpt [r13]
;;;	: added ifor buffer-for now it can create chunks of type 
;;;	int-eye-centered,
;;;	which are just like ego-eye-centered except that the viewpoint is the 
;;;	place chunk in the allocentral buffer at creation time and its 
;;;	orientation is that of the place chunk. Its bearing (to another object)
;;;	is the ego-eye-centered bearing to that object offset by the orientation
;;;	of the place chunk representing the IFOR anchor's viewpoint. See
;;;	request-spatial for the case of a request to the ifor buffer, 
;;;	handle-ifor,
;;;	& remap-symbolic-bearing.
;;; 2010.05.13 fpt [r14]
;;;	: One issue with the way IFOR representations are made in r13 is that 
;;;	the module assumes the IFOR anchor to be in the center of the ACT-R
;;;	device space. Enable space parsing centered from anywhere in the ACT-R 
;;;	device space, such as the visual-location chunk referenced from the
;;;	screen-pos slot of a visual chunk.
;;; 2010.06.13 fpt [r15]
;;;	: Update to reflect the latest ontology & taxonomy: there is now a 
;;;	spatial-object buffer, and the function handle-spatial-object builds
;;;	spatial-object chunks for it from visual-object or
;;;	intrinsic-visual-object chunks
;;; 2010.06.16 fpt [r16]
;;;	: Update to reflect the latest ontology & taxonomy: eye-centered-spatial-
;;;	representation now up to spec
;;; 2010.06.16 fpt [r17]
;;;	: Update to reflect the latest ontology & taxonomy: allocentric
;;; 2010.06.16 fpt [r18]
;;;	: Update to reflect the latest ontology & taxonomy: intrinsic
;;; 2010.06.21 fpt [r19]
;;;	: The intrinsic buffer can now generate intrinsic-SR chunks either 
;;;	automatically if the spatial module receives a request to generate any
;;;	SR or an SO and their is an intrinsicality = t SR chunk in the imaginal
;;;	buffer or upon specific request of an intrinsic-SR chunk and the presence
;;;	of an intrinsicality = t SR chunk in the imaginal buffer or a specified
;;;	heading for the to-be-created intrinsic-SR chunk.
;;; 2010.06.22 fpt [r20]
;;;	: Fixed a bug wherein handle-spatial-object might call the handle
;;;	function of the buffer that just called it, creating other problems. Now
;;;	when buffer handler functions call handle-spatial-object, instead of 
;;;	passing a simple boolean to its int-req parameter they pass their
;;;	buffer's name.
;;; 2010.06.22 fpt [r21]
;;;	: Buffer chunk interdependency problem was more fundamental than I'd
;;;	appreciated previously; alter request mechanism so that no matter what
;;;	buffer is requested, the spatial-object buffer makes its chunk first,
;;;	since it doesn't depend upon any of the other spatial buffers but they
;;;	all depend upon it. Then post-event-hook functions call the rest of the
;;;	buffer chunk handling functions when they see the spatial-object chunk 
;;;	set to its buffer.
;;; 2010.06.23 fpt [r22]
;;;	: The module now clears all its buffers whenever one is cleared.
;;; 2010.06.29 fpt [r23]
;;;	: Eye-centered-spatial-representation chunks are now automatically 
;;;	copied to the imaginal buffer upon creation if their intrinsicality
;;;	slot value is t. They're copied with a time-delta of .01 because if it 
;;;	were 0 then handle-intrinsic would try to make an intrinsic-SR chunk
;;;	out of the eye-centered-SR & its own copy in the imaginal buffer. In any
;;;	case this might not be a bad thing, particularly if, as Newell claimed,
;;;	it takes something on the order of 10 ms for a symbol to be accessed 
;;;	across brain regions (Newell, 1990, p. 140).
;;; 2010.06.29 fpt [r24]
;;;	: Buffer handler functions now accept the chunk-spec that's been handed
;;;	to the spatial module. This fixes the bug that required no harvesting of
;;;	the visual buffer and also allows new functionality: IFOR pop-out.
;;;	Incidentally, because FORMS predicts all-from-
;;;	one functionality, one object-location is represented in multiple FORs,
;;;	so the modeler may not issue requests to multiple buffers in a 
;;;	production. I should probably enforce this later by only making one
;;;	buffer available to requests. For now just request the spatial-object
;;;	buffer only.
;;; 2010.06.30 fpt [r25]
;;;	: Now if an intrinsical eye-centered-SR is made the model will request
;;;	the visual-location of some salient other location and if it finds one, 
;;;	it will buffer-stuff itself with spatial representations of that 
;;;	visual-location. In this way the spatial module will implement an IFOR
;;;	pop-out effect.
;;;	: Changed copy intrinsical eye-centered-spatial-representation chunk
;;;	to imaginal time to 0 to support ifor pop-out.
;;; 2010.07.02 fpt [r26]
;;;	: Not clearing the imaginal buffer when an handle-intrinsic uses its 
;;;	chunk is causing problems, so created a post-event-hook-function to
;;;	do so when the intrinsic buffer is set.
;;;	: Deleted :attended nil parameter from the visual-location request of
;;;	the intrinsical case of the handle-eye-centric function because it was
;;;	causing the model not to find matching-color items in the retrieval exp
;;;	because occasionally they had just been attended.
;;;	: Added requirement to handle-intrinsic that it not make an intrinsic
;;;	chunk if the eye-central buffer chunk's bearing is 'center.
;;;	: Important note about the IFOR pop-out mechanism as implemented in r25:
;;;	There's a bug we need to be aware of in the spatial module with no 
;;;	obvious fix, but shouldn't be an issue for the time being: because the 
;;;	ifor pop-out mechanism requests visual-locations it's a bad idea to 
;;;	request a visual-location in the same production that also requests 
;;;	spatial representations. First there's no guarantee (as far as I know 
;;;	off the top of my head) which order the visual-requests will process in, 
;;;	so they could get mixed up. Secondly, because you're likely to have the 
;;;	next production harvest those requests, bad things could occur. So for 
;;;	now just don't request spatial & visual-location buffers in the same 
;;;	production.
;;; 2010.07.03 fpt [r27]
;;;	: Was having problems with the ifor pop-out mechanism such that it was 
;;;	finding the location of the item it had just made an eye-centered-SR for.
;;;	So now handle-eye-centric requests a visual-location that has different
;;;	screen-x & -y from what it just finished working with.
;;; 2010.07.03 fpt [r28]
;;;	: Disabled automatic clearing of the imaginal buffer again because it
;;;	broke the perceptual model.
;;; 2010.07.06 fpt [r29]
;;;	: Intrinsic chunks are now made with viewpoint as the IFOR anchor's
;;;	spatial-object rather than eye-centered-spatial-representation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defstruct spatial-module 
   model-name param-viewing-distance param-er param-spatial-noise-scale 
   param-spatial-noise-s sm-chunk-spec)

(defun create-spatial-module (model-name)
   "Creates the spatial module."
   (mapcar 'add-post-event-hook 
           '(post-so-make-eye-sr post-so-make-allo-sr post-so-make-int-sr
             clear-one-clear-all stuff-intrinsic-buffer ))
   (make-spatial-module :model-name model-name))

(defun query-spatial (instance buffer-name slot value)
   (declare (ignore instance) (ignore buffer-name) )
   ;; only valid slot is state
   ;; for now the spatial module is always free
   (case slot
     (state
      (case value
        (busy nil)
        (free t)
        (error nil)
        (t (print-warning "Unknown state query ~S to spatial module" value)
            nil)))
     (t (print-warning 
          "Unknown query ~S ~S to the spatial module" slot value))))

(defun reset-spatial (instance)
   (declare (ignore instance))
   :documentation "Resets the spatial module."
   (chunk-type spatial-object intrinsicality shape orientation 
               perceptual-reference)
   (chunk-type abstract-spatial-representation salience heading bearing 
               distance viewpoint identity)
   (chunk-type (egocentric-spatial-representation 
                (:include abstract-spatial-representation)))
   (chunk-type (allocentric-spatial-representation 
                (:include abstract-spatial-representation)))
   (chunk-type (intrinsic-spatial-representation 
                (:include abstract-spatial-representation)))
   (chunk-type (eye-centered-spatial-representation 
                (:include egocentric-spatial-representation)))
   (chunk-type (hand-centered-spatial-representation 
                (:include egocentric-spatial-representation)))
   (chunk-type (body-centered-spatial-representation 
                (:include egocentric-spatial-representation)))
   (chunk-type bearing location)
   (define-chunks-fct
     '((eye-so
        isa spatial-object
        intrinsicality t
        shape nil
        orientation up)
       (eye-spatial-representation
        isa eye-centered-spatial-representation
        heading up
        bearing center
        viewpoint eye-so
        identity eye-so)
       (screen-so
        isa spatial-object
        intrinsicality t
        shape rectangle
        orientation up)
       (screen-sr
        isa eye-centered-spatial-representation
        heading up
        bearing center
        viewpoint eye-so
        identity screen-so)
       (center isa bearing)
       (not-center isa bearing)
       (up isa bearing)
       (up-right isa bearing)
       (right isa bearing)
       (down-right isa bearing)
       (down isa bearing)
       (down-left isa bearing)
       (left isa bearing)
       (up-left isa bearing)
       )))

(defun delete-spatial (instance)
   (declare (ignore instance))
   :documentation "Deletes the spatial module.")

(defun request-spatial (instance buffer chunk-spec)
   :documentation "Handles requests of the spatial module."
   (mapcar 'clear-buffer '(spatial-object eye-central allocentral intrinsic))
   (unless 
     (symbol-in-a-list 
      buffer 
      '(spatial-object eye-central allocentral intrinsic))
     (print-warning "Invalid buffer requested of the spatial module."))
   (setf (spatial-module-sm-chunk-spec instance) nil)
   (setf (spatial-module-sm-chunk-spec instance) chunk-spec)
   ;;   (format t "~A~%" chunk-spec)
   (handle-spatial-object chunk-spec))


(defun handle-spatial-object (chunk-spec)
   "Handles requests for spatial-object chunk-types"
   (let* ((int (when (slot-in-chunk-spec-p chunk-spec 'intrinsicality)
                  (nth 2 (car 
                          (chunk-spec-slot-spec chunk-spec 'intrinsicality)))))
          (shp (when (slot-in-chunk-spec-p chunk-spec 'shape)
                  (nth 2 (car (chunk-spec-slot-spec chunk-spec 'shape))))) 
          (ori (when (slot-in-chunk-spec-p chunk-spec 'orientation)
                  (nth 2 (car 
                          (chunk-spec-slot-spec chunk-spec 'orientation)))))
          (p-ref (when (slot-in-chunk-spec-p chunk-spec
                                              'perceptual-reference)
                    (nth 2 (car 
                            (chunk-spec-slot-spec chunk-spec
                                                  'perceptual-reference)))))
          (chunk (car (define-chunks-fct 
                         `((isa spatial-object 
                                intrinsicality ,int 
                                shape ,shp 
                                orientation ,ori
                                perceptual-reference ,p-ref))))))
     (schedule-set-buffer-chunk 
      'spatial-object
      chunk 0 :module 'spatial)))




(defun handle-intrinsic (chunk-spec)
   "handle requests for intrinsic-spatial-relationship chunk-types, will make
one if there's a valid eye-centered-spatial-representation in the imaginal 
buffer."
   (declare (ignore chunk-spec))
   (let ((so (if (query-buffer 'spatial-object '((buffer . full)))
                (buffer-read 'spatial-object)
                (print-warning "No spatial-object chunk in the spatial-object
buffer, no identity slot value for this intrinsic-spatial-representation
chunk!"))))
     (cond
      ( ;; (or 
       (and
        (query-buffer 'imaginal '((buffer . full)))
        (symbol-in-a-list 'orientation
                          (chunk-type-slot-names-fct 
                           (chunk-chunk-type-fct
                            (buffer-read 'imaginal))))
        (not (null (chunk-slot-value-fct (buffer-read 'imaginal) 'orientation)))
        (not (eql 'center 
                  (chunk-slot-value-fct (buffer-read 'eye-central) 'bearing))))
       (let* ((sal nil)
              (dist (spatial-module-param-viewing-distance (get-module spatial)))
              (vp (buffer-read-report 'imaginal)) 
              (id so)
              (hdg (if
                      (chunk-slot-value-fct id 'intrinsicality)
                      (chunk-slot-value-fct id  'orientation)
                      nil))
              (brg (remap-symbolic-bearing  
                     (chunk-slot-value-fct 
                      (no-output 
                       (car (buffer-chunk-fct '(eye-central)))) 'bearing) 
                     (chunk-slot-value-fct vp 'orientation)))
              (chunk (car (define-chunks-fct 
                             `((isa intrinsic-spatial-representation
                                    salience ,sal heading ,hdg distance ,dist 
                                    bearing ,brg viewpoint ,vp identity ,id))))))
         (schedule-set-buffer-chunk 
          'intrinsic chunk 0 :module 'spatial)
         )) 
      ((chunk-slot-value-fct so 'intrinsicality)
       (schedule-set-buffer-chunk
        'imaginal 
        so
        0 :module 'spatial :requested nil))
      (t nil))))




(defun handle-allocentric (chunk-spec)
   "Handle requests for allocentric-spatial-representation chunk-types. For now,
since we assume the modeled subject is sitting at a computer and the visual 
task environment is the computer screen, this essentially just copies what the
spatial module has already done for the eye-central buffer."
   (declare (ignore chunk-spec))
   (let* ((so (if (query-buffer 'spatial-object '((buffer . full)))
                 (buffer-read 'spatial-object)
                 (print-warning "No spatial-object chunk in the spatial-object
buffer, no identity slot value for this allocentral chunk!")))
          (sal nil)
          (brg (chunk-slot-value-fct 
                 (buffer-read 'eye-central)  'bearing))
          (vp (copy-chunk-fct 'screen-so))

          ;; remap eye-central buffer chunk's bearing in terms of the 
          ;; vp's sr's heading, retrieve the eye-centered-sr with screen-so 
          ;; in id slot & eye-so in vp slot
          (hdg (if
                  (not (null (chunk-slot-value-fct 
                              (buffer-read 'eye-central) 'heading)))
                  (remap-symbolic-bearing 
                   (chunk-slot-value-fct 
                    (no-output (car (buffer-chunk-fct '(eye-central))))  'heading)
                   (chunk-slot-value-fct 
                    (no-output (copy-chunk-fct 'screen-sr))  'heading))
                  nil))
          (dist (spatial-module-param-viewing-distance (get-module spatial)))
          (id so)
          (chunk (car (define-chunks-fct 
                         `((isa allocentric-spatial-representation 
                                salience ,sal viewpoint ,vp heading ,hdg 
                                distance ,dist identity ,id bearing ,brg))))))
     (schedule-set-buffer-chunk 'allocentral chunk 0 :module 'spatial)))


(defun handle-eye-centric (chunk-spec)
   "Handles creation of eye-centered-spatial-representation chunks for the 
eye-central buffer."
   (declare (ignore chunk-spec))
   (let*
     ((so (buffer-read 'spatial-object))
      (int (chunk-slot-value-fct so 'intrinsicality))
      (p-ref (chunk-slot-value-fct so 'perceptual-reference))
      (p-ref-supertypes (chunk-type-supertypes-fct
                            (chunk-chunk-type-fct p-ref)))

      ;; for vl- test the chunk-type of the chunk-spec's p-ref slot
      ;; if it's visual-object, then set vl to be the screen-pos as before
      ;; if it's visual-location, then set it to be that
      (vl (if (symbol-in-a-list 'visual-object p-ref-supertypes)
             (chunk-slot-value-fct p-ref 'screen-pos)
             p-ref))
      (col (chunk-slot-value-fct p-ref 'color))
      (space-center-x (/ *space-width* 2))
      (space-center-y (/ *space-height* 2))
      (center-sector-radius 
       (* .2 (/ (+ *space-width* *space-height*) 2)))
      (loc-x (chunk-slot-value-fct vl 'screen-x))
      (loc-y (chunk-slot-value-fct vl 'screen-y))
      (sector-value 
       ;; unless the location is in the center, return the atom 
       ;; naming the sector bin into which the location was parsed.
       (cond
        ;; item's in the center
        ((<= (xy-distance loc-x loc-y space-center-x space-center-y)
             center-sector-radius); local point (screen-x, -y) is within 
         'center)
        ;; item's outside the center sector
        ((> (xy-distance loc-x loc-y space-center-x space-center-y) 
            center-sector-radius)
         (let* ((sb-bearing (coords-to-angle loc-x loc-y))
                (sector-bin (parse-circle sb-bearing 22.5)))
           (svref 
            (vector 'up 'up-right 'right 'down-right 'down 'down-left 'left 
                    'up-left) sector-bin)))
        (t  (progn (print-warning "Coordinates not defined for space 
parsing.") nil))))
      (sal nil)

      ;; if there's a chunk in the visual buffer that refers to the vl
      ;; chunk taken in the parameter and it has an orientation then use that      
      (hdng (if
               (and
                (symbol-in-a-list
                 'intrinsicality
                 (chunk-type-slot-names-fct 
                  (chunk-chunk-type-fct so)))
                (symbol-in-a-list
                 'orientation
                 (chunk-type-slot-names-fct 
                  (chunk-chunk-type-fct so)))
                (chunk-slot-value-fct so 'intrinsicality))
               (chunk-slot-value-fct so 'orientation)
               nil)) 
      ;; distance parameter
      (dist 
       (spatial-module-param-viewing-distance 
        (get-module spatial)))  
      (vp 'eye-so)
      (id so)
      (chunk (car (define-chunks-fct 
                     `((isa eye-centered-spatial-representation 
                            salience ,sal
                            bearing ,sector-value
                            heading ,hdng
                            distance ,dist
                            viewpoint ,vp
                            identity ,id))))))
     (schedule-set-buffer-chunk 
      'eye-central chunk 0 :module 'spatial)
     (when int
       (schedule-clear-buffer 'visual-location 0 :module 'spatial)
       (schedule-module-request 
        'visual-location
        (define-chunk-spec-fct `(isa visual-location
                                    color ,col
                                    - screen-x ,loc-x 
                                    - screen-y ,loc-y)) 
        0
        :module 'spatial))))





(defun spatial-module-params-fct (instance param)
   (if (consp param)
     (case (car param)
       (:viewing-distance
        (setf (spatial-module-param-viewing-distance instance) (cdr param)))
       (:er
        (setf (spatial-module-param-er instance) (cdr param)))
       (:spatial-noise-scale
        (setf (spatial-module-param-spatial-noise-scale instance) (cdr param)))
       (:spatial-noise-s
        (setf (spatial-module-param-spatial-noise-s instance) (cdr param))))
     (case param
       (:spatial-noise-scale (spatial-module-param-spatial-noise-scale instance))
       (:spatial-noise-s (spatial-module-param-spatial-noise-s instance)))))

(define-module-fct 'spatial 
  '(body-central hand-central eye-central allocentral intrinsic spatial-object)
  (list (define-parameter :viewing-distance :owner nil)
        (define-parameter :er :owner nil)
        (define-parameter :spatial-noise-scale
          :documentation
          "scales the noise computed for spatial bearing representations as a function of their distance from increments of 90¡ bearing"
          :default-value 15
          :valid-test (lambda (x) (and (numberp x) (>= x 0)))
          :warning "not a positive number or 0"
          :owner t)
        (define-parameter :spatial-noise-s
          :documentation
          "the s parameter passed to act-r-noise in generating spatial noise. See act-r-noise."
          :default-value .5
          :valid-test (lambda (x) (and (numberp x) (> x 0)))
          :warning "not a positive number"
          :owner t)
        )
  :version "1.0"
  :documentation "A module for ACT-R 6 that does human spatial cognition, particularly for the egocentric and intrinsic frames of reference (FORs)."
  :creation 'create-spatial-module
  :query #'query-spatial
  :reset #'reset-spatial
  :delete #'delete-spatial
  :request #'request-spatial
  :params #'spatial-module-params-fct)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Event Hook Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun post-so-make-eye-sr (evt)
   "After ACT-R sets the spatial-object buffer chunk, call handle-eye-centric to
make an eye-centered-spatial-representation automatically."
   (if (and
        (eql 'set-buffer-chunk (evt-action evt))
        (eql 'spatial-object (car (evt-params evt))))
     (handle-eye-centric 
      (spatial-module-sm-chunk-spec (get-module spatial)))
     nil))

(defun post-so-make-allo-sr (evt)
   "After ACT-R sets the spatial-object buffer chunk, call handle-allocentric to
make an allocentric-spatial-representation automatically."
   (if (and
        (eql 'set-buffer-chunk (evt-action evt))
        (eql  'eye-central (car (evt-params evt))))
     (handle-allocentric 
      (spatial-module-sm-chunk-spec (get-module spatial)))
     nil))

(defun post-so-make-int-sr (evt)
   "After ACT-R sets the spatial-object buffer chunk, call handle-intrinsic to
make an intrinsic-spatial-representation automatically."
   (if (and
        (eql 'set-buffer-chunk (evt-action evt))
        (eql  'allocentral (car (evt-params evt))))
     (handle-intrinsic 
      (spatial-module-sm-chunk-spec (get-module spatial)))
     nil))

(defun clear-one-clear-all (evt)
   "If one spatial buffer gets cleared, clear them all."
   (if (eql 'clear-buffer (evt-action evt))
     (case (car (evt-params evt))
       (spatial-object 
        (clear-buffer 'eye-central )
        (clear-buffer 'allocentral )
        (clear-buffer 'intrinsic ))
       (eye-central 
        (clear-buffer 'spatial-object )
        (clear-buffer 'allocentral )
        (clear-buffer 'intrinsic ))
       (allocentral
        (clear-buffer 'spatial-object )
        (clear-buffer 'eye-central )
        (clear-buffer 'intrinsic ))
       (intrinsic
        (clear-buffer 'spatial-object )
        (clear-buffer 'eye-central )
        (clear-buffer 'allocentral )
        (clear-buffer 'intrinsic ))
       (t nil))
     nil))


(defun stuff-intrinsic-buffer (evt)
   "If the event is a set-buffer-chunk to the imaginal buffer and it's unrequested
and that chunk has an orientation slot and that orientation slot has a value 
and the visual-location buffer has a chunk, then use that visual-location chunk
to request a spatial-object."
   (when (and
          (eql 'set-buffer-chunk (evt-action evt))
          (eql 'imaginal (car (evt-params evt)))
          (null (car (last (evt-params evt))))
          (symbol-in-a-list 'orientation
                            (chunk-type-slot-names-fct 
                             (chunk-chunk-type-fct
                              (buffer-read 'imaginal))))
          (not (null (chunk-slot-value-fct (buffer-read 'imaginal) 'orientation)))
          (query-buffer 'visual-location '((buffer . full))))
     (let* ((vl (buffer-read 'visual-location))
            (shp (chunk-slot-value-fct vl 'value)))
       (schedule-module-request
        'spatial-object
        (define-chunk-spec-fct 
          `(isa spatial-object
                shape ,shp
                perceptual-reference ,vl)) 0 :module 'spatial))))






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun square (x) (* x x))

(defun xy-distance (p-x p-y q-x q-y)
   "The distance between two points."
   (sqrt (+ (square (- p-x q-x))
            (square (- p-y q-y)))))

(defun coords-to-angle (x y)
   "Converts x & y coordinates into an angle (degrees) in the interval [0¡, 359¡] with 0¡ being aligned with the positive end of the y-axis and degrees incrementing clockwise and the origin at the center of the ACT-R device."
   (let* ((corrected-x (- x (/ *space-width* 2)))
          (corrected-y (+ (* -1 y) (/ *space-height* 2)))
          (theta (cond 
                   ((< corrected-y 0)
                    (* -1 (/ (atan corrected-y corrected-x) pi) 180))
                   (t  (- 360 (* (/ (atan corrected-y corrected-x) pi) 180))))))
     (mod (+ theta 90) 360)))

(defun parse-circle (angle &optional (offset 0))
   "Parses the angle, plus offset, into one of eight sectors of a circle. Returns an integer."
   (prog1 (floor (mod (+ angle offset) 360) 45)))


(defun remap-symbolic-bearing (bearing offset)
   "Takes a bearing symbol (the slot value from an abstract-location child 
chunk-type) and an offset (the value of the orientation slot from an 
abstract-location child chunk-type). Returns that bearing incremented offset places 
counter-clockwise."
   (if
     (or (eq 'center bearing) (eq 'center offset))
     (format t "Remapping not defined for bearings or headings with value of 
center.")
     (let ((map-lst  '((up . 0) (up-right . 1) (right . 2) (down-right . 3) 
                         (down . 4) (down-left . 5) (left . 6) (up-left . 7))))
       (svref 
        (vector 'up 'up-right 'right 'down-right 'down 'down-left 'left 'up-left)
        (mod (- (cdr (assoc bearing map-lst))
                (cdr (assoc offset map-lst))) 8)))))

(defun symbol-in-a-list (sym lst)
   "Takes a symbol and a list, returns t if the symbol is in the list, else nil."
   (cond
    ((null lst) nil)
    ((eq sym (car lst)) t)
    (t (symbol-in-a-list sym (cdr lst)))))