;;;  -*- mode: LISP; Package: CL-USER; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Mike Byrne
;;; Copyright   : (c)1997-2001 CMU/Rice U./Mike Byrne, All Rights Reserved
;;; Availability: public domain
;;; Address     : Rice University
;;;             : Psychology Department
;;;             : Houston,TX 77251-1892
;;;             : byrne@acm.org
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : rpm-toplevel.lisp
;;; Version     : 2.1b6
;;; 
;;; Description : Top-level functions for RPM, nothing fancy.
;;; 
;;; To do       :  
;;;
;;; ----- History -----
;;; 01.07.27 mdb
;;;             : Started 2.1/ACT5 conversion.
;;;             : [x] Parameterize buffer-stuffing
;;; 01.10.05 mdb [b3]
;;;             : Fixed bug in PM-SET-HAND-LOCATION.
;;; 01.11.05 mdb
;;;             : Restored :full-time in PM-RUN.
;;; 2002.04.16 mdb [b6]
;;;             : Made PM-PRINT-ICON more tabular.
;;; 02.05.06 Dan
;;;             : Updated the macros that didn't have a ` to have one, and 
;;;             : removed all the ,'s before *mp* in macros.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro pm-set-cursor-position (x y)
  "Sets the position of the cursor."
  `(pm-set-cursor-position-fct ,(vector x y)))


(defmacro pm-attend-location (x y)
  `(pm-attend-location-fct ,(vector x y)))


(defmacro pm-set-hand-location (hand &rest loc)
  "Sets the location of the given hand to LOC"
  `(pm-set-hand-location-fct ',hand ',loc))


(defmacro pm-set-params (&rest parameters)
  `(set-pm-params-mth *mp* ',parameters))


(defmacro pm-show-params (&rest parameters)
  `(show-pm-params-mth *mp* ',parameters))


(defmacro pm-prepare-motor (&rest lis)
  "Tells the Motor Module to prepare the supplied movement."
  `(pm-prepare-mvmt-mth (motor-m *mp*) ',lis))



(defun pm-reset (&key (initialize-dm t))
  "Resets the Master Process"
  (setf *pop-upon-failure* nil)
  ;(setf *external-sources* nil)
  (reset-mp *mp*)
  (when initialize-dm
    (pm-initialize-dm)))


(defun pm-add-chunks ()
  "Adds the chunks used by the PM layer"
  (add-pm-state-chunks)
)


(defun pm-add-types-and-chunks ()
  "Deprecated function from RPM 1.0"
  (pm-warning "PM-ADD-TYPES-AND-CHUNKS deprecated, use PM-RESET or PM-INITIALIZE-DM.")
  (pm-initialize-dm))


(defun pm-initialize-dm ()
  "Defines chunk types and adds chunks for the PM layer"
  (def-pm-chunk-types)
  (pm-add-chunks))


(defun pm-time ()
  "Return the current time, in seconds, of the Master Process"
  (mp-time *mp*))


(defun pm-proc-screen (&key clear with-cursor)
  "Processes the current display.  For backward compatibility only, use PM-PROC-DISPLAY."
  (when with-cursor
    (setf (with-cursor-p (device-interface *mp*)) t))
  (process-display (device-interface *mp*) (vis-m *mp*) clear))


(defun pm-proc-display (&key clear)
  "Processes the current display."
  (process-display (device-interface *mp*) (vis-m *mp*) clear))


(defun pm-install-window (window)
  "Installs <window> as the action window for the PM layer.  Included purely fo backward compatibility only. Use PM-INSTALL-DEVICE instead."
  (setf (device (device-interface *mp*)) window)
  (update-device (device-interface *mp*) (mp-time *mp*)))


(defun pm-install-device (device)
  "Installs <device> as the active device for the perceptual-motor layer."
  (setf (device (device-interface *mp*)) device))


(defun pm-pixels-to-angle (pixels)
  "Convert <pixels> to degress of visual angle."
  (pixels->angle-mth (device-interface *mp*) pixels))


(defun pm-angle-to-pixels (angle)
  "Convert visual <angle> in degress to pixels."
  (angle->pixels-mth (device-interface *mp*) angle))


(defun pm-set-cursor-position-fct (xyloc)
  (setf (current-cursor (motor-m *mp*)) xyloc)
  (synch-mouse (device-interface *mp*))
  (current-cursor (motor-m *mp*)))


(defun pm-attend-location-fct (loc)
  "Tells the Vision Moddule to start with attention at a certain location."
  (setf (current-marker (vis-m *mp*)) (xy-to-dmo loc t))
  (setf (current-lof (vis-m *mp*)) loc))
       

(defun pm-remove-features (loc &optional scale)
  "Removes features at the specified visual location."
  (delete-features (vis-m *mp*) loc scale))


(defun pm-start-hand-at-mouse ()
  "Starts the right hand on the mouse instead of the default 'home row' location"
  (let ((the-hand (right-hand (motor-m *mp*))))
    (setf (loc the-hand) #(28 2))))


(defun pm-set-char-feature-set (setname)
  "Sets the feature set used to represent characters when optimizing is off. <setname> should be a keyword."
  (set-cfs-mth (vis-m *mp*) setname))


(defun pm-set-hand-location-fct (hand loc)
  "Function to set the location of the given hand to LOC"
  (setf loc (coerce loc 'vector))
  (ecase hand
    (right (setf (loc (right-hand (motor-m *mp*))) loc))
    (left (setf (loc (left-hand (motor-m *mp*))) loc))))
  

(defun pm-step ()
  "Enters the ACT-R/PM stepper"
  (step-rpm-mth *mp*))


(defun pm-run (duration &key (full-time nil))
  "Runs ACT-R/PM for the specifed duration (in seconds).
   If full-time is t then it gurantees that time is advanded by duration seconds"
  (when full-time
    (pm-delayed-event duration #'(lambda () 
                                   (pm-output nil "* Running stopped because time limit reached."))))
  
  (run-master-process *mp* duration))


(defun pm-print-icon ()
  "Print the Vision Manager's icon. For debugging."
  (format t "~%Loc        Att   Kind           Value             Color           ID")
  (format t "~%---------  ---   -------------  ----------------  --------------  -------------")
  (dolist (feat (visicon (vis-m *mp*)))
    (print-icon-feature feat)))


(defun pm-print-sched ()
  "Print the schedule queue. For debugging."
  (print-sched-queue *mp*))


(defun pm-print-input-q (module)
  "Print the input queue of the specified (by keyword) module.  For debugging."
  (print-input-queue (key->mgr *mp* module)))


(defun pm-print-module-state (module-name)
  "Print the state of the specified (by keyword) module."
  (print-mod-state-mth *mp* module-name))


(defun pm-version ()
  "Returns the version string for RPM."
  (version-string *mp*))


(defmacro pm-set-visloc-default (&rest params)
  `(setf (default-spec (vis-m *mp*))
        (apply #'construct-findloc-spec ',params)))



;;; left in for backward compatibilty only
(defun run-mp (duration)
  (run-master-process *mp* duration))