;;########################################################################
;; mmrmob3.lsp
;; options dialog (non-unix) for multivariate multiple regression object
;; Copyright (c) 1991-97 by Forrest W. Young
;;########################################################################

(require "vista")

(defmeth mmr-model-object-proto :options ()
"Args: none
Constructs and displays the options dialog window for regression models.
Returns nil or a four element list.  Returns nil when dialog canceled or when no response or predictor variables selected, returns four element list otherwise.  The first element of the list is a list of response variable indices.  The second element is a list of predictor variable indices. The third element is the index of the weight variable, or nil for unweighted analysis.  The fourth element is T for intercept models, nil for non-intercept models."
  (when (not (send self :dialog))
        (send self :iv ($position (send self :predictors)
                                  (send self :variables)))
        (send self :dv ($position (send self :responses)
                                  (send self :variables))))
  (when (send self :dialog)
  (let* ((mob self)
         (box-text-item (send text-item-proto :new 
                              "Multivariate Multiple Regression Options"
                              :location (list 112 5)))
         (select-toggle (send choice-item-proto :new (list
                              "Select Response  Variables"
                              "Select Predictor Variables"
                              "Select Weighting Variable") 
                              :value 0
                              :location (list 10 25)))
         (intercept     (send toggle-item-proto :new "Include the Intercept Term" 
                              :value t
                              :location (list 250 47) )) ;240 47
         (use-text  (send text-item-proto :new "Use" :location (list 250 28))) ; 240 28
         (redun (send edit-text-item-proto :new "0" 
                      :size
#+msdos               (list 44 23)
#+macintosh           (list 44 16)
#+X11                 (list 44 16)
                      :location 
#+msdos               (list 280 24)
#+macintosh           (list 280 28)
#+X11                 (list 280 28)
                      )) 
         (redun-text (send text-item-proto :new "Redundancy Variates"
                              :location (list 328 28))) ; 328 28
         (weight-var-text (send text-item-proto :new "Weight Var:"
                                :location 
#+msdos                         (list 250 73) 
#+macintosh                     (list 250 66)
#+X11                           (list 250 66)
                                )) ; 240 66
         (weight-var    (send list-item-proto :new (list "")
                              :size (list 150 18)
                              :location 
#+msdos                       (list 330 73)
#+macintosh                   (list 330 66)
#+X11                         (list 330 66)
                              ));330 66
         (var-text-item (send text-item-proto :new "Selectable Variables"
                              :location (list 15 90)))
         (rsp-text-item (send text-item-proto :new "Selected Responses"
                              :location (list 175 90)))
         (prd-text-item (send text-item-proto :new "Selected Predictors"
                              :location (list 335 90)))
         (var-list (send self :variables))
         (rsp-list (repeat " " (length var-list)))
         (prd-list (repeat " " (length var-list)))
         (rsp-nums nil)
         (prd-nums nil)
         (weight-num nil)
         (var-list-item (send list-item-proto :new var-list
                              :action #'(lambda () (move-vars &optional dc))
                              :size (list 150 192)))
         (rsp-list-item (send list-item-proto :new rsp-list
                              :size (list 150 192)))
         (prd-list-item (send list-item-proto :new prd-list
                              :size (list 150 192)))
         
         (ok        (send modal-button-proto :new "OK"
                          :location (list 150 323)))
         (cancel    (send modal-button-proto :new "Cancel"
                          :location (list 250 323)))
         (reg-dialog (send modal-dialog-proto :new
                     (list box-text-item
                           (list select-toggle intercept 
                                 weight-var-text weight-var 
                                 use-text redun redun-text)
                           (list var-text-item rsp-text-item prd-text-item)
                           (list var-list-item rsp-list-item prd-list-item)
                           (list ok cancel))
                           :default-button ok)))

    (defmeth ok :do-action ()
      (let ((dialog (send ok :dialog))
            )
        (send mob :intercept (send intercept :value))
        (send mob :weights weight-num)
        (send mob :iv prd-nums)
        (send mob :dv rsp-nums)
        (send mob :redundancy (number-from-string (send redun :text)))
        (cond 
          ((or (> 1 (length prd-nums))
               (> 1 (length rsp-nums)))
           (error-message "You must select at least one response and one predictor variable.")
           (send dialog :modal-dialog-return nil))
          (t (send dialog :modal-dialog-return t)))
        ))

    (defmeth cancel :do-action ()
      (let ((dialog (send cancel :dialog)))
        (send dialog :modal-dialog-return nil)))

    (defmeth var-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (s (select (send self :slot-value 'list-data) n))
             (m nil))
        (when (and n (not (equal s " ")))
              (send self :set-text n " ") ;OK
              (when (= 0 (send select-toggle :value))
                    (setf m (position " " 
                               (send rsp-list-item :slot-value  'list-data)
                                      :test 'equal))
                    (send rsp-list-item :set-text m s)
                    (setf rsp-nums (concatenate 'list rsp-nums (list n))))
              (when (= 1 (send select-toggle :value))
                    (setf m (position " " 
                               (send prd-list-item :slot-value  'list-data)
                                      :test 'equal))
                    (send prd-list-item :set-text m s)
                    (setf prd-nums (concatenate 'list prd-nums (list n))))
              (when (and (not weight-num) (= 2 (send select-toggle :value)))
                    (send weight-var :set-text 0 s)
                    (setf weight-num n))
              (send self :selection nil))))

    (defmeth rsp-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length rsp-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (when (> L n) 
                    (setf m (select rsp-nums n))
                    (when (< n (1- L))
                          (dolist (i (iseq n (- L 2)))
                                  (send self :set-text i 
                                        (select (send self :slot-value 
                                                      'list-data) (1+ i)))))
                    (send self :set-text (1- L) " ")
                    (send var-list-item :set-text m s)
                    (send self :selection nil)
                    (setf rsp-nums (remove m rsp-nums))))))

    (defmeth prd-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length prd-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (when (> L n)
                    (setf m (select prd-nums n))
                    (when (< n (1- L))
                          (dolist (i (iseq n (- L 2)))
                                  (send self :set-text i 
                                        (select (send self :slot-value
                                                      'list-data) (1+ i)))))
                    (send self :set-text (1- L) " ")
                    (send var-list-item :set-text m s)
                    (send self :selection nil)
                    (setf prd-nums (remove m prd-nums))))))

    (defmeth weight-var :do-action (&optional dbl-clk) 
      (let* ((s (select (send self :slot-value 'list-data) 0))
             )
        (when (not (equal s ""))
              (send self :set-text 0 "")
              (send var-list-item :set-text weight-num s)
              (send self :selection nil)
              (setf weight-num nil))))

    (if (send reg-dialog :modal-dialog)
        (list rsp-nums prd-nums weight-num (send intercept :value) 
              (send redun :text));:value


        nil))))
  
(provide "mmrmob3")
(require "mmrmob2")