; $Id: rmd_arrows.pro,v 1.2 2005/02/03 18:04:12 azuah Exp $
;###############################################################################
; 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 of if the code in this file is
;  included in another product.
;
;###############################################################################
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro rmd_arrows::cleanup
ptr_free,self.storage
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows::set_property,  value = value
if n_elements(value) ne 0 then self.value = value
return,1
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows::get_property,  tlb = tlb,              $
                                    value = value
tlb = self.tlb
value = self.value
return,1
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro rmd_arrows_kill_notify,id
widget_control,id,get_uvalue = object
obj_destroy,object
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro rmd_arrows_set_value,id,val
stash = widget_info(id,/child)
widget_control,stash,get_uvalue = object
ret = object->set_property(value = val)
; Update the field
field_id = widget_info(id,find_by_uname = 'FIELD')
widget_control,field_id,set_value = strtrim(string(val),2)
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows_get_value,id
stash = widget_info(id,/child)
widget_control,stash,get_uvalue = object
ret = object->get_property(value = value)
return,value
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows::rmd_arrows_event_handler,event
this_event =   {  rmd_arrows_event,    id:self.tlb,            $
                                       top:event.top,          $
                                       handler:event.handler,  $
                                       value:self.value,       $
                                       object:self             }

if self.event_pro ne '' then begin
   call_procedure,self.event_pro,this_event
   this_event = 0
endif
if self.event_func ne '' then begin
   ret = call_function(self.event_func,this_event)
   this_event = 0
endif
; Which widget got us to this handler?
uname = widget_info(event.id,/uname)
case uname of
'RIGHT_ARROW': $
   begin
      self.value = (self.value+1) < self.maximum
      field_id = widget_info(event.top,find_by_uname = 'FIELD')
      widget_control,field_id,set_value = strtrim(string(self.value),2)
   end
'FIELD':       $
   begin
      widget_control,event.id,get_value = val
      val = fix(val)
      if (val gt self.maximum) or $
         (val lt self.minimum) then begin
         widget_control,event.id,set_value = strtrim(string(self.value),2)
         return,this_event
      endif
      self.value = val
   end
'LEFT_ARROW':  $
   begin
      self.value = (self.value-1) > self.minimum
      field_id = widget_info(event.top,find_by_uname = 'FIELD')
      widget_control,field_id,set_value = strtrim(string(self.value),2)
   end
else:
endcase
return,this_event
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows_event,event
widget_control,event.id,get_uvalue = object
the_event = object->rmd_arrows_event_handler(event)
return,the_event
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows::init, parent,                    $
                           EVENT_FUNC = event_func,   $
                           EVENT_PRO = event_pro,     $
                           _Extra = extra,            $
                           UNAME = uname,             $
                           UVALUE = uvalue,           $
                           VALUE = value,             $
                           MAXIMUM = maximum,         $
                           MINIMUM = minimum,         $
                           XSIZE = xsize,             $
                           TITLE = title

if n_params() eq 0 then return,0
if n_elements(title) eq 0 then title = ''
if n_elements(xsize) eq 0 then xsize = 5
self.xsize = 5
if n_elements(uname) eq 0 then uname = ''
self.uname = uname
if n_elements(uvalue) eq 0 then uvalue = ''
self.storage = ptr_new(uvalue)
if n_elements(value) eq 0 then value = 0
self.value = value
if n_elements(maximum) eq 0 then maximum = 1
if n_elements(minimum) eq 0 then minimum = 0
self.maximum = maximum
self.minimum = minimum
if self.value gt self.maximum then self.value = self.maximum
if self.value lt self.minimum then self.value = self.minimum
if n_elements(event_func) eq 0 then event_func = ''
if n_elements(event_pro) eq 0 then event_pro = ''
self.event_func = event_func
self.event_pro = event_pro

; Create the widgets
self.tlb = widget_base(parent,uvalue = self.storage,  $
   func_get_value = 'rmd_arrows_get_value',           $
   pro_set_value = 'rmd_arrows_set_value',            $
   uname = self.uname, _Extra = extra,/col            )
label = widget_label(self.tlb,value = title,uvalue = self)
base = widget_base(self.tlb,/row)
left_id = widget_button(base,value = '<',uname = 'LEFT_ARROW', $
   kill_notify = 'rmd_arrows_kill_notify',uvalue = self, $
   event_func = 'rmd_arrows_event')
text_id = widget_text(base,value = strtrim(string(self.value),2),$
   uvalue = self,event_func = 'rmd_arrows_event', uname = 'FIELD', $
   xsize = self.xsize,/editable)
right_id = widget_button(base,value = '>',uname = 'RIGHT_ARROW', $
   kill_notify = 'rmd_arrows_kill_notify',uvalue = self, $
   event_func = 'rmd_arrows_event')

return,1
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro rmd_arrows__define
define = {  rmd_arrows,                      $
            tlb:0L,                          $
            event_pro:'',                    $
            event_func:'',                   $
            value:0,                         $
            maximum:0,                       $
            minimum:0,                       $
            xsize:0,                         $
            uname:'',                        $
            storage:ptr_new()                }
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function rmd_arrows,parent,_Extra = extra, OBJ_REF = obj_ref
obj_ref = obj_new('rmd_arrows',parent,_Extra = extra)
if ~obj_valid(obj_ref) then return,0L
ret = obj_ref->get_property(tlb = tlb)
return,tlb
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
