lib/maracasVisuLib/src/interface/tcl/to_change/WidgetObject.tcl

   1 # These procs allow widgets to behave like objects with their own
   2 # state variables of processing objects.
   3
   4
   5 # generate a "unique" name for a widget variable
   6 proc GetWidgetVariable {widget varName} {
   7    regsub -all {\.} $widget "_" base
   8
   9    return "$varName$base"
  10 }
  11
  12 # returns an object which will be associated with a widget
  13 # A convienience method that creates a name for you
  14 # based on the widget name and varible value/
  15 proc NewWidgetObject {widget type varName} {
  16    set var "[GetWidgetVariable $widget $varName]_Object"
  17    # create the vtk object
  18    $type $var
  19
  20    # It is better to keep interface consistent
  21    # setting objects as variable values, and NewWidgetObject.
  22    SetWidgetVariableValue $widget $varName $var
  23
  24    return $var
  25 }
  26
  27 # obsolete!!!!!!!
  28 # returns the same thing as GetWidgetVariableValue
  29 proc GetWidgetObject {widget varName} {
  30    puts "Warning: obsolete call: GetWidgetObject"
  31    puts "Please use GetWidgetVariableValue"
  32    return "[GetWidgetVariable $widget $varName]_Object"
  33 }
  34
  35 # sets the value of a widget variable
  36 proc SetWidgetVariableValue {widget varName value} {
  37    set var [GetWidgetVariable $widget $varName]
  38    global $var
  39    set $var $value
  40 }
  41
  42 # This proc has alway eluded me.
  43 proc GetWidgetVariableValue {widget varName} {
  44    set var [GetWidgetVariable $widget $varName]
  45    global $var
  46    set temp ""
  47    catch {eval "set temp [format {$%s} $var]"}
  48
  49    return $temp
  50 }
  51
  52