;;;  -*- mode: LISP; Package: CL-USER; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Mike Byrne
;;; Copyright   : (c)2001 Rice U./Mike Byrne, All Rights Reserved
;;; Availability: public domain
;;; Address     : Rice University
;;;             : Psychology Department
;;;             : Houston,TX 77251-1892
;;;             : byrne@acm.org
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : scanpath.lisp
;;; Version     : r2
;;; 
;;; Description : Will render a trace path [or at least print one for 
;;;             : non-MCL Lisps] for visual attention, point-of-gaze, or 
;;;             : the mouse.  Inspired by code from David Peebles, who 
;;;             : deserves all the credit for the idea.
;;; 
;;; Bugs        : none known yet, but it's early
;;; 
;;; Todo        : [] Provide option to display fix duration rather than sequence
;;;             :    number?
;;; 
;;; ----- History -----
;;; 01.11.11 Mike Byrne
;;;             :  Incept date.
;;; 2002.04.26 mdb [r2]
;;;             : Now restores foreground color for the window, oops.
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;; ---------------------------------------------------------------------- ;;;;
;;;; toplevel stuff

(defun pm-enable-path-tracing (kind)
  "Enable tracing for some type of path."
  (case kind
    (:attn (setf (trace-attn-p (vis-m *mp*)) t))
    (:mouse (setf (trace-mouse-p (vis-m *mp*)) t))
    (:eye (if (not (fboundp 'eye-trace))
            (pm-warning "EMMA must be installed to trace eye movements.")
            (setf (trace-eye-p (vis-m *mp*)) t)))
    (otherwise (pm-warning "Unknown path trace."))
    ))


(defun pm-disable-path-tracing (kind)
  "Disable tracing for some type of path."
  (case kind
    (:attn (setf (trace-attn-p (vis-m *mp*)) nil))
    (:mouse (setf (trace-mouse-p (vis-m *mp*)) nil))
    (:eye (if (not (fboundp 'eye-trace))
            (pm-warning "EMMA must be installed to trace eye movements.")
            (setf (trace-eye-p (vis-m *mp*)) nil)))
    (otherwise (pm-warning "Unknown path trace."))
    ))


;;; PM-PRINT-PATH-TRACE      [Function]
;;; Description : Print out a text version of the trace.  Note that the eye and
;;;             : the attn trace add the current location so you get the last 
;;;             : stop.  The mouse doesn't do this because the mouse can be 
;;;             : moved by the user, rendering this useless.


(defun pm-print-path-trace (kind)
  "Print out a text listing of a path trace."
  (case kind
    (:attn (print-path-trace (cons (cons (pm-time) (current-lof (vis-m *mp*)))
                                   (attn-trace (vis-m *mp*)))))
    (:mouse (print-path-trace (mouse-trace (device-interface *mp*))))
    (:eye (if (not (fboundp 'eye-trace))
            (pm-warning "EMMA must be installed to trace eye movements.")
            (print-path-trace (cons (cons (pm-time) (eye-loc (vis-m *mp*)))
                                    (eye-trace (vis-m *mp*))))))
    (otherwise (pm-warning "Unknown path trace."))
    ))


;;; PM-DRAW-SCANPATH      [Function]
;;; Description : Render the scanpath.  
(defun pm-draw-scanpath (kind)
  "Draw a scanpath on the window."
  (case kind
    ;; visual attention uses the red color set because the focus ring is red.
    ;; I know this clashes with EPAL's mouse path being red.  Oh well.
    (:attn 
     (render-seq (device (device-interface *mp*)) 
                 (reverse (cons (cons (pm-time) (current-lof (vis-m *mp*)))
                                (attn-trace (vis-m *mp*))))
                 '(514 49344 1028 49344 33667 65535)))
    ;; the mouse uses green one because [1] Green isn't used for eyes or 
    ;; attention and [2] the MCL "virtual cursor" is green.
    (:mouse 
     (render-seq (device (device-interface *mp*)) 
                 (reverse (mouse-trace (device-interface *mp*)))
                 '(0 49858 21074 65535 0 49858)))
    ;; uses blue to match the EPAL default
    (:eye 
     (if (not (fboundp 'eye-trace))
       (pm-warning "EMMA must be installed to trace eye movements.")
       (render-seq (device (device-interface *mp*)) 
                   (reverse (cons (cons (pm-time) (eye-loc (vis-m *mp*)))
                                  (eye-trace (vis-m *mp*))))
                   '(15000 65535 0 65535 0 50000))))
    (otherwise (pm-warning "Unknown path trace."))
    ))
  



;;; PRINT-PATH-TRACE      [Method]
;;; Description : Given a path in reverse temporal sequence (this is what 
;;;             : you get when you use PUSH), print it out.  Each entry is
;;;             : of the form (zz.zzz #(x y)) where z is a time and x and y
;;;             : represents a location.

(defmethod print-path-trace ((fix-lst list))
  (format t "~%Time	Location~%----	--------")
  (dolist (fix (reverse fix-lst))
    (format t "~%~6,3F	~A" (first fix) (rest fix))))

(defmethod print-path-trace ((fix-lst null))
  (pm-warning "List of stops is empty, nothing to render."))
  

;;;; ---------------------------------------------------------------------- ;;;;
;;;; Rendering code


(defgeneric render-seq (wind fix-lst base-colors)
  (:documentation "Renders a fixation list to a window, fading colors based on the given spec.  Note that <fix-lst> is assumed to be in order here."))


(defmethod render-seq ((wind window) (fix-lst list) (base-colors list))
  (window-select wind)
  (let ((color-lst (apply #'generate-colors (length fix-lst) base-colors))
        (orig-color (get-fore-color wind)))
    (set-fore-color wind (first color-lst))
    ;; if there's just one entry, only render a number
    (if (null (rest fix-lst))
      (with-focused-view wind
        (render-fix wind (rest (first fix-lst)) "1"))
      ;; iterate through, rendering points and lines
      (dotimes (i (1- (length fix-lst)))
        (with-focused-view wind
          (set-fore-color wind (nth i color-lst))
          (render-fix wind (rest (nth i fix-lst)) (mkstr (1+ i)))
          (render-sac wind (rest (nth i fix-lst)) (rest (nth (1+ i) fix-lst)))))
      )
    (set-fore-color wind orig-color)))

(defmethod render-seq ((wind window) (fix-lst null) (base-colors list))
  (pm-warning "List of stops is empty, nothing to render."))


(defgeneric render-fix (wind loc str)
  (:documentation "Renders a string to the location, then returns the pen."))

(defmethod render-fix ((wind window) (loc vector) (str string))
  (move-to wind (px loc) (py loc))
  (with-pstrs ((ps str))
    (#_drawstring ps))
  (move-to wind (px loc) (py loc)))


(defgeneric render-sac (wind start end)
  (:documentation "Currently just renders a line."))

(defmethod render-sac ((wind window) (start vector) (end vector))
  (move-to wind (px start) (py start))
  (line-to wind (px end) (py end)))



;;;; ---------------------------------------------------------------------- ;;;;
;;;; Utils

(defun generate-colors (steps low-blue high-blue low-green high-green low-red high-red)
  "Produces a blend of <steps> colors."
  (let ((delta-blue (/ (- high-blue low-blue) steps))
        (delta-green (/ (- high-green low-green) steps))
        (delta-red (/ (- high-red low-red) steps))
        (answer '()))
    (dotimes (step steps)
      (push (make-color (round (+ low-red (* step delta-red)))
                        (round (+ low-green (* step delta-green)))
                        (round (+ low-blue (* step delta-blue))))
            answer))
    (nreverse answer)))

#|
blue set is:
(15000 65535 0 65535 0 50000)

red set is:
(514 49344 1028 49344 33667 65535)

green set is:
(0 49858 21074 65535 0 49858)
|#