; $Id: cw_color_bgroup.pro,v 1.5 2005/06/09 18:42:32 rdimeo Exp $
; +
; NAME:
;  CW_COLOR_BGROUP
;
; PURPOSE:
;  CW_COLOR_BGROUP is a compound widget similar to CW_BGROUP
;  which comes with the IDL distribution.  The main difference
;  between the CW_COLOR_BGROUP and CW_BGROUP is that the former
;  provides a color button mechanism.
;
; CATEGORY:
;  Compound widgets
;
; CALLING SEQUENCE:
;  ID = CW_COLOR_BGROUP(PARENT,NAMES,COLORS)
;
;  To set or get the value of CW_COLOR_BGROUP, use the GET_VALUE and
;  SET_VALUE keywords to WIDGET_CONTROL.  The value of CW_COLOR_BGROUP
;  is:
;
;     Type              Value
;     ----              -----
;     Exclusive         Index of currently set button
;     Nonexclusive      Vector indicating the position of each button
;                       (1-Set, 0-Unset)
;
; PARAMETERS:
;
;  PARENT:     The ID of the parent widget. (required)
;  NAMES:      A string array, containing one string per button,
;              giving the name of each button. (required)
;  COLORS:     String array of colors for each button.  This array
;              must have the same number of elements as NAMES. Valid
;              values for elements of the COLORS vector are "red",
;              "green","blue","yellow", and "purple".  If not specified
;              then the default color of each button is "green."
;
; KEYWORDS:
;
;  BUTTON_SIZE:   Diameter of the button in pixels.
;  BUTTON_UVALUE: An array of user values to be associated with each
;                 button and returned in the event structure.
;  LABEL:         String value to be displayed to the left of a ROW
;                 CW_COLOR_BGROUP or at the top of a COL CW_COLOR_BGROUP.
;  UNAME:         Set this keyword to a string that can be used to identify
;                 the widget in your code.  You can associate a name with each
;                 widget in a specific hierarchy, and then use that name to
;                 query the widget hierarchy and get the correct widget ID.
;  UVALUE:        A user value to assign to the CW.  This value can be
;                 of any type.
;  EVENT_FUNC:    Event function to be called when button is released.
;  EVENT_PRO:     Event procedure to be called when button is released.
;  ROW:           Set this keyword to arrange the label on the left of the button.  The
;                 default is to place the label just above the button.
;  VALUE:         The initial value of the buttons.
;  RETURN_ID:     If set, the VALUE field of returned events will be the widget ID
;                 of the button.
;  RETURN_INDEX:  If set, the VALUE field of returned events will be the zero-based
;                 index of the button within the base.  DEFAULT.
;  RETURN_NAME:   If set, the VALUE field of returned events will be the name of the
;                 button within the base.
;  RETURN_BUTTON_UVALUE:   If set, the VALUE field of returned events will be the UVALUE
;                          of the button within the base (as set with the BUTTON_UVALUE
;                          keyword).
;
; EVENT STRUCTURE:
;  EVENT =  {  ID:0L,TOP:0L,HANDLER:0L,SELECT:SELECT,VALUE:VALUE}
;
;     The SELECT field is passed through from the CW_COLOR_BUTTON event.
;     VALUE is either the INDEX of the selected button (if EXCLUSIVE) or
;     an array of button values (if NONEXCLUSIVE).
;
; SIDE EFFECTS:
;  -This widget generates button events upon button release only.
;
; COMMON BLOCKS:
;  None
;
; REQUIRED PROGRAMS:
;  CW_COLOR_BUTTON.PRO (and all programs therein)
;
; REQUIRED RESOURCES:
;  BIG_STOP.PNG (from CW_COLOR_BUTTON.PRO)
;
; REQUIREMENTS:
;  IDL 6.0 and higher (due to use of ARRAY_INDICES in CW_COLOR_BUTTON.PRO)
;  24-Bit color required
;
; EXAMPLE USAGE: (appended to end of this file)
;  Compile this file then
;  IDL> CWCBGROUP_EXAMPLE
;
; AUTHOR:
;  Robert M. Dimeo, Ph.D.
;  NIST Center for Neutron Research
;  100 Bureau Drive
;  Mail Stop 8562
;  Gaithersburg, MD 20899
;  Phone: (301) 975-8135
;  E-mail: robert.dimeo@nist.gov
;  http://www.ncnr.nist.gov/staff/dimeo
;
; MODIFICATION HISTORY:
;  Written 06/01/05
;
; LICENSE:
;  The software in this file is written by an employee of
;  National Institute of Standards and Technology
;  as part of the DAVE software project.
;
;  The DAVE software package is not subject to copyright protection
;  and is in the public domain. It should be considered as an
;  experimental neutron scattering data reduction, visualization, and
;  analysis system. As such, the authors assume no responsibility
;  whatsoever for its use, and make no guarantees, expressed or
;  implied, about its quality, reliability, or any other
;  characteristic. The use of certain trade names or commercial
;  products does not imply any endorsement of a particular product,
;  nor does it imply that the named product is necessarily the best
;  product for the stated purpose. We would appreciate acknowledgment
;  if the DAVE software is used or if the code in this file is
;  included in another product.
; -
; ************************************************************ ;
pro cw_color_bgroup::cleanup
ptr_free,self.storage,self.value_ptr,self.name_ptr
ptr_free,self.color_ptr,self.button_uvalue_ptr
ptr_free,self.button_id_ptr,self.obutton_ptr
end
; ************************************************************ ;
pro cw_color_bgroup::set_property,value = value
if n_elements(value) ne 0 then begin
   *self.value_ptr = value
   self->get_property,  button_ids = button_ids,               $
                        obuttons = obuttons,                   $
                        exclusive = exclusive
   nbids = n_elements(button_ids)
   if exclusive then begin
      ; Toggle all buttons to the "off" position
      for i = 0,nbids-1 do begin
         obuttons[i]->set_property,state = 0B
         ret = obuttons[i]->off()
      endfor
      obuttons[value]->set_property,state = 1B
      ret = obuttons[value]->on()
   endif else begin
      for i = 0,nbids-1 do begin
         obuttons[i]->set_property,state = value[i]
         if value[i] then ret = obuttons[i]->on() else $
            ret = obuttons[i]->off()
      endfor
   endelse
endif
end
; ************************************************************ ;
pro cw_color_bgroup::get_property,  tlb = tlb,                       $
                                    value = value,                   $
                                    colors = colors,                 $
                                    button_uvalue = button_uvalue,   $
                                    button_ids = button_ids,         $
                                    obuttons = obuttons,             $
                                    exclusive = exclusive,           $
                                    names = names,                   $
                                    nonexclusive = nonexclusive

names = *self.name_ptr
exclusive = self.exclusive
nonexclusive = self.nonexclusive
tlb = self.tlb
value = *self.value_ptr
colors = *self.color_ptr
button_uvalue = *self.button_uvalue_ptr
button_ids = *self.button_id_ptr
obuttons = *self.obutton_ptr
end
; ************************************************************ ;
pro cwcbg_set_val,id,value
stash = widget_info(id,/child)
widget_control,stash,get_uvalue = the_object
the_object->set_property,value = value

end
; ************************************************************ ;
function cwcbg_get_val,id
stash = widget_info(id,/child)
widget_control,stash,get_uvalue = the_object
the_object->get_property,value = value
return,value
end
; ************************************************************ ;
pro cwcbg_kill_notify,id
widget_control,id,get_uvalue = the_object
obj_destroy,the_object
end
; ************************************************************ ;
function cw_color_bgroup::eventhandler,event
; Process the "internal" button events
self->get_property,  button_ids = button_ids,                  $
                     obuttons = obuttons,                      $
                     button_uvalue = button_uvalue,            $
                     names = names
nbids = n_elements(button_ids)
; Determine the index of the button just pressed
index = where(button_ids eq event.id)

if self.exclusive then begin
   ; Only one button can be depressed at a time
   ; First toggle all buttons "off"
   for i = 0,nbids-1 do begin
      obuttons[i]->set_property,state = 0B
      ret = obuttons[i]->off()
   endfor
   ; Now turn on only the one just pressed
   obuttons[index[0]]->set_property,state = 1B
   ret = obuttons[index[0]]->on()
   *self.value_ptr = index[0]
endif else begin
   ; No limitation on the number of buttons that are pressed
   states = bytarr(nbids)
   for i = 0,nbids-1 do begin
      obuttons[i]->get_property,state = state
      states[i] = state
   endfor
   *self.value_ptr = states
endelse

if self.return_index then value = *self.value_ptr
if self.return_name then value = names[index[0]]
if self.return_id then value = button_ids[index[0]]
if self.return_button_uvalue then value = button_uvalue[index[0]]

ev =  {  id:self.tlb,                     $
         top:event.top,                   $
         handler:event.handler,           $
         select:index[0],                 $
         value:value                      }

if self.event_pro ne '' then begin
   call_procedure,self.event_pro,ev
   return,0B
endif
if self.event_func ne '' then begin
   void = call_function(self.event_func,ev)
   return,0B
endif
return,ev
end
; ************************************************************ ;
function cwcbgroup_internal,event
stash = widget_info(event.id,/parent)
widget_control,stash,get_uvalue = the_object
the_event = the_object->eventhandler(event)
return,the_event
end
; ************************************************************ ;
function cw_color_bgroup::build_widgets
; Define the widgets
row = self.row & col = ~self.row
self.tlb = widget_base(self.parent,/row,                          $
            uname = self.uname,pro_set_value = 'cwcbg_set_val',   $
            func_get_value = 'cwcbg_get_val',                     $
            frame = self.frame,                                   $
            uvalue = *self.storage                                )

; Create the first child base as the "STASH" into which we'll store
; the object reference.
self.base = widget_base(self.tlb,col = col,row = row,             $
            /base_align_right,uvalue = self,                      $
            kill_notify = 'cwcbg_kill_notify',                    $
            event_func = 'cwcbgroup_internal'                     )

if self.label ne '' then $
   label_id = widget_label(self.base,value = self.label)
state = *self.value_ptr
obutton_array = objarr(n_elements(*self.name_ptr))
for i = 0,n_elements(*self.name_ptr)-1 do begin

   if n_elements(state) gt 1 then begin
      current_state = state[i]
   endif else begin
      if state eq i then current_state = 1B else current_state = 0B
   endelse

   bcolor = (*self.color_ptr)[i]
   value = (*self.name_ptr)[i]
   uvalue = (*self.button_uvalue_ptr)[i]

   id = cw_color_button(   self.base,                                $
                           button_size = self.button_size,           $
                           red = (strlowcase(bcolor) eq 'red'),      $
                           green = (strlowcase(bcolor) eq 'green'),  $
                           blue = (strlowcase(bcolor) eq 'blue'),    $
                           yellow = (strlowcase(bcolor) eq 'yellow'),$
                           purple = (strlowcase(bcolor) eq 'purple'),$
                           row = keyword_set(col),                   $
                           uvalue = uvalue,                          $
                           radio = 1B,                               $
                           state = current_state,                    $
                           value = value,                            $
                           obj_ref = o                               )

   if i eq 0 then bids = id else bids = [bids,id]
   obutton_array[i] = o
endfor
*self.button_id_ptr = bids
*self.obutton_ptr = obutton_array
return,1B
end
; ************************************************************ ;
function cw_color_bgroup::init,  parent,names,colors,                         $
                                 uname = uname,                               $
                                 uvalue = uvalue,                             $
                                 event_pro = event_pro,                       $
                                 event_func = event_func,                     $
                                 button_size = button_size,                   $
                                 exclusive = exclusive,                       $
                                 nonexclusive = nonexclusive,                 $
                                 row = row,                                   $
                                 button_uvalue = button_uvalue,               $
                                 return_index = return_index,                 $
                                 return_name = return_name,                   $
                                 return_id = return_id,                       $
                                 return_button_uvalue = return_button_uvalue, $
                                 frame = frame,                               $
                                 label = label,                               $
                                 value = value

self.return_index = keyword_set(return_index)
self.return_name = keyword_set(return_name)
self.return_id = keyword_set(return_id)
self.return_button_uvalue = keyword_set(return_button_uvalue)
if    ~(self.return_index or self.return_name or self.return_id or            $
      self.return_button_uvalue) then $
      self.return_index = 1B
self.parent = parent
if n_params() eq 2 then begin
   colors = replicate('green',n_elements(names))
endif
if n_elements(label) eq 0 then label = ''
self.label = label
if n_elements(frame) eq 0 then frame = 0
self.frame = frame
if n_elements(event_pro) eq 0 then event_pro = ''
if n_elements(event_func) eq 0 then event_func = ''
self.event_pro = event_pro
self.event_func = event_func
if n_elements(button_size) eq 0 then button_size = 30
self.button_size = button_size
self.row = keyword_set(row)

if n_elements(uname) eq 0 then uname = ''
self.uname = uname
if n_elements(uvalue) eq 0 then uvalue = ''
self.storage = ptr_new(/allocate_heap)
*self.storage = uvalue

self.exclusive = keyword_set(exclusive)
self.nonexclusive = keyword_set(nonexclusive)

if n_elements(value) eq 0 then begin
   if self.nonexclusive then begin
      ; NONEXCLUSIVE default is to set none of the buttons
      value = bytarr(n_elements(names))
   endif else begin
      ; EXCLUSIVE default is to set the first button
      value = 0
   endelse
endif

self.button_id_ptr = ptr_new(/allocate_heap)
self.obutton_ptr = ptr_new(/allocate_heap)
self.value_ptr = ptr_new(/allocate_heap)
*self.value_ptr = value
self.name_ptr = ptr_new(/allocate_heap)
*self.name_ptr = names
self.color_ptr = ptr_new(/allocate_heap)
*self.color_ptr = colors
if n_elements(button_uvalue) eq 0 then $
   button_uvalue = replicate('',n_elements(names))
self.button_uvalue_ptr = ptr_new(/allocate_heap)
*self.button_uvalue_ptr = button_uvalue
return,1B
end
; ************************************************************ ;
pro cw_color_bgroup__define
void =   {  cw_color_bgroup,                                   $
            storage:ptr_new(),                                 $
            value_ptr:ptr_new(),                               $
            name_ptr:ptr_new(),                                $
            color_ptr:ptr_new(),                               $
            button_uvalue_ptr:ptr_new(),                       $
            button_id_ptr:ptr_new(),                           $
            obutton_ptr:ptr_new(),                             $
            return_id:0B,                                      $
            return_name:0B,                                    $
            return_index:0B,                                   $
            return_button_uvalue:0B,                           $
            frame:0B,                                          $
            base:0L,                                           $
            label:'',                                          $
            event_pro:'',                                      $
            event_func:'',                                     $
            uname:'',                                          $
            parent:0L,                                         $
            tlb:0L,                                            $
            row:0B,                                            $
            exclusive:0B,                                      $
            nonexclusive:0B,                                   $
            button_size:0L                                     }
end
; ************************************************************ ;
function cw_color_bgroup,  parent,                             $
                           names,                              $
                           colors,                             $
                           _Extra = extra,                     $
                           obj_ref = obj_ref

if n_params() lt 2 then return,0B
obj_ref = obj_new('cw_color_bgroup',parent,names,colors,       $
                  _Extra = extra)
ret = obj_ref->build_widgets()
obj_ref->get_property,tlb = tlb
return,tlb
end
; ************************************************************ ;
; *************** EXAMPLE IMPLEMENTATION ********************* ;
; ************************************************************ ;
pro cwcbgroup_example_event,event
uname = widget_info(event.id,/uname)
case uname of
'QUIT':  widget_control,event.top,/destroy
'COLOR_BGROUP':   $
   begin
      widget_control,event.id,get_value = val
      print,'Button values: ',val
      print,event
      print
   end
else:
endcase
end
; ************************************************************ ;
pro cwcbgroup_example
tlb = widget_base(/col,/tlb_frame_attr)
names = ['Rob','Paul','Richard','Larry']
colors = replicate('red',n_elements(names))

void = cw_color_bgroup( tlb,names,colors,                      $
                        /row,button_size = 25,                 $
                        uname = 'COLOR_BGROUP',                $
                        /exclusive,/frame,                     $
                        /return_index,                         $
                        label = 'Test label'                   )

void = widget_button(tlb,value = 'exit',uname = 'QUIT')
widget_control,tlb,/realize
xmanager,'cwcbgroup_example',tlb,/no_block
end