;;;  -*- mode: LISP; Package: CL-USER; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Dan Bothell 
;;; Copyright   : (c)2000 CMU/Dan Bothell, All Rights Reserved
;;; Availability: public domain
;;; Address     : Carnegie Mellon University
;;;             : Psychology Department
;;;             : Pittsburgh,PA 15213-3890
;;;             : db30+@andrew.cmu.edu
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : view-line-acl.lisp
;;; Version     : r0
;;; 
;;; Description : Allows for drawing lines in ACL windows using a dialog-item (transparent pane),
;;;             : and therefore can generate features for the window.  That way R/PM will see
;;;             : the lines without using rpm-line-to and having to deal with 
;;;             : making sure the lines are redrawn when there is a pm-proc-display.
;;;             : Based entirely on Mike's view-line.lisp.
;;; Bugs        : 
;;; 
;;; Todo        :
;;; ----- History -----
;;; 01.02.14 Dan Bothell
;;;             : incept date
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; The base class for the dialog based lines.  All it adds is a color slot.

(defclass liner (drawable)
  ((color :accessor color :initarg :color :initform 'black)
   (start-pt :accessor start-pt :initarg :start-pt :initform (list 0 0))
   (end-pt :accessor end-pt :initarg :end-pt :initform (list 0 0)))
  (:default-initargs
   :width 1
    :height 1
    :left -2
    :top 0
    :on-redisplay 'draw-view-line))


(defun draw-view-line (di stream)
  (declare ignore-if-unused stream)
  (let* ((real-stream (parent di)))
    (with-foreground-color (real-stream (color di))
      (draw-line real-stream (make-position (first (start-pt di)) (second (start-pt di)))
                 (make-position (first (end-pt di)) (second (end-pt di)))))))


(defmethod build-features-for ((lnr liner) (vis-mod vision-module))
  "Convert the view to a feature to be placed into the visual icon"
  (make-instance 'line-feature
     :color (win-color->symbol (color lnr))
     :end1-x (first (start-pt lnr)) 
     :end1-y (second (start-pt lnr))
     :end2-x (first (end-pt lnr)) 
     :end2-y (second (end-pt lnr))
     :x (loc-avg (first (start-pt lnr)) (first (end-pt lnr)))
     :y (loc-avg (second (start-pt lnr)) (second (end-pt lnr)))
     :width (abs (- (first (start-pt lnr)) (first (end-pt lnr))))
     :height (abs (- (second (start-pt lnr)) (second (end-pt lnr))))))





(defun rpm-view-line (wind start-pt end-pt &optional (color black))
  "Adds a dialog-item representing the line to the specified window 
   which will draw a line from the start-pt to the end-pt on the window
   using the optional color specified (defaulting to black). "
  (let* ((dis (dialog-items wind)))
    (setf (dialog-items wind) (cons (make-instance 'liner
                                      :color color
                                      :start-pt start-pt 
                                      :end-pt end-pt) dis))))



(defun win-color->symbol (color)
  "Return a symbol that names the color for the 'recognized' colors.   
   Any other color gets mapped to a symbol color-RRRRR-GGGGG-BBBBB where the 
   R's, G's, and B's are the red, green, and blue components of the 
   color left padded with zeros to 5 digits."
  (cond ((equal color red) 'red)
        ((equal color blue) 'light-blue)
        ((equal color green) 'green)
        ((equal color black) 'black)
        ((equal color white) 'white)
        ((equal color magenta) 'pink)
        ((equal color yellow) 'yellow)
        ((equal color dark-green) 'dark-green)
        ((equal color dark-blue) 'blue)
        ((equal color dark-magenta) 'purple)
        ((equal color dark-yellow) 'brown)
        ((equal color light-gray) 'light-gray)
        ((equal color gray) 'gray)
        ((equal color dark-gray) 'dark-gray)
        (t (intern (format nil "COLOR-~5,'0d-~5,'0d-~5,'0d" 
                                (rgb-red color) 
                                (rgb-green color) 
                                (rgb-blue color))))))

(defun color-symbol->win-color (color)
  "this may look like it should do the inverse of the above, but right now
   it doesn't exactly.  If the color isn't one of the default ones then
   the black color is returned.  It's only being used by the UWI right now,
   so it's simplified for that purpose."
  (cond ((equal color 'red) red)
        ((equal color 'blue) dark-blue)
        ((equal color 'green) green)
        ((equal color 'black) black)
        ((equal color 'white) white)
        ((equal color 'pink)  magenta)
        ((equal color 'yellow) yellow)
        ((equal color 'dark-green) dark-green)
        ((equal color 'light-blue) blue)
        ((equal color 'purple) dark-magenta)
        ((equal color 'brown) dark-yellow)
        ((equal color 'light-gray) light-gray)
        ((equal color 'gray) gray)
        ((equal color 'dark-gray) dark-gray)
        (t black)))