Open Mash Cross Reference
mash/tcl/indiva/lib/cap-switchable.tcl

   # cap-switchable --
   #
   #   Implementation of the switchable GUI.
   #
   # Copyright (c) 1996-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
   # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  #
  # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/indiva/lib/cap-switchable.tcl,v 1.1 2002/07/11 19:20:15 weitsang Exp $
  
  import Capability
  Class Capability/Switchable -superclass Capability
  
  Capability/Switchable proc gui { from to w action } {
      # We can create gui for either the whole switch, or just a 
      # segment in a flow.
      if {[$from is_instance_of MobPort] && $from != $to}  {
          return [$self segment_gui $from $to $w $action]
      } elseif {[$from is_instance_of MobRoutingSwitcher] || 
          ([$from is_instance_of MobPort] && $from == $to)} {
          return [$self device_gui $from $w $action]
      } else {
          return ""
      }
  }
  
  Capability/Switchable proc segment_gui { from to w action } {
      set items {}
      set device [$from device]
      
      foreach in [$device get_switchable_inputs] {
          lappend in_items([$in get_attribute type]) "[$in get_attribute portid] [$in get_attribute friendlyname]"
      }
  
      set toport [$to get_attribute portid]
  
      set layout ""
      set commands ""
      set count 0
      foreach type [array names in_items] {
          if {$type != [$to get_attribute type]} {
              continue
          }
          set list [lsort -integer -index 0 $in_items($type)]
          set f $w.f$count
          set v in${w}${count}
          set curr "[$from get_attribute portid] [$from get_attribute friendlyname]"
          append layout "
              global $v
              frame $f
              label $f.l -text [rstr Input ($type)] -anchor e
              tk_optionMenu $f.in $v $list
              set $v [reval join [rstr $curr]]
              pack $f.l $f.in -side left -expand 1 -fill both
              pack $f -fill x -expand 1
          "
          lappend commands variable $v \
             "$action $type [reval lindex [rvar $v] 0] $toport"
          incr count
      }
      return [list $layout $commands]
  }
  
  Capability/Switchable proc device_gui { from to w action } {
      MashLog info "DEVICE GUI called"
  }
  
  proc reval { args } {
      return \[[join $args]\]
  }
  
  proc rvar { var } {
      return \$\{$var\}
  }
  
  proc rstr { args } {
      return \"$args\"
 }