Open Mash Cross Reference
mash/tcl/indiva/lib/indiva-controller.tcl

   import MobHub
   import MashTimer
   Class IndivaController
   
   global curr_frame
   set curr_frame 0 
   
   IndivaController instproc init { mobs imgr } {
       $self instvar imgr_ lb_ frames_
      set imgr_ $imgr
      set w [$self init_gui]
  
      $self add_guis $mobs $imgr $w 
  }
  
  IndivaController instproc add_guis {mobs imgr w} {
      $self instvar lb_ frames_
      set count 0
      foreach mob [join $mobs] {
          set path [$imgr path $mob]
  
          set from [lindex $path 0]
          set tos [lrange $path 1 end]
          if {$tos == ""} {
              # make sure we enter the for loop at least once.
              set tos {""}
          }
          foreach to $tos {
              if {[MobHub is_hub $to]} {
                  continue
              }
              set dev [$imgr info $from -device]
              if {![info exists processed($dev,$from)]} {
                  set processed($dev,$from) 1
                  set label [lindex [$imgr info $dev -friendlyname] 0]
                  set servicename [$imgr info service $from $to -friendlyname]
                  if {$servicename != ""} {
                      set label "$label ($servicename)"
                  }
                  set str [$imgr gui $from $to $w.$count -tk]
                  if {$str != ""} {
                      frame $w.$count
                      lappend frames_($dev,$servicename) $w.$count
                      if {[llength $frames_($dev,$servicename)] == 1} {
                          radiobutton $lb_.$count -text $label \
                              -anchor nw \
                              -variable dev \
                              -value $dev \
                              -indicatoron 0 \
                              -selectcolor white \
                              -relief flat \
                              -bd 0 \
                              -command "$self switch_frame $dev \"$servicename\""
                          pack $lb_.$count -expand 1 -fill x
                      } 
                      if [catch {$self add_gui $from $to $str} err] {
                          global errorInfo
                          puts "ERROR when adding GUI :$err"
                          puts $errorInfo
                      }
                  } 
              }
              incr count
              set from $to
          }
      }
  }
  
  IndivaController instproc refresh { mobs imgr } {
      $self instvar frames_ mainframe_ lb_ 
      set w $mainframe_
      foreach key [array names frames_] {
          foreach frame $frames_($key) {
              destroy $frame
          }
          unset frames_($key)
      }
      destroy $lb_
      set lb_ [frame $w.lb -relief sunken -bd 3]
      pack $w  -expand 1 -fill both
      pack $lb_ -expand 1 -fill x
  
      $self add_guis $mobs $imgr $w
  }
  
  IndivaController instproc init_gui { } {
      $self instvar lb_ topframe_ mainframe_
      toplevel .top
      wm title .top "Indiva Controller"
      set topframe_ [frame .top.topframe -class IndivaControl]
      set f [frame $topframe_.main]
      set lb_ [frame $f.lb -relief sunken -bd 3]
      pack $topframe_ $f -expand 1 -fill both
      pack $lb_ -expand 1 -fill both
  
      set mainframe_ $f
  
      global tcl_platform
      if {$tcl_platform(platform) == "windows"} {
         set font Tahoma
     } else {
         set font Lucida
     }
     option add *IndivaControl*font "$font 11 normal"
     option add *IndivaControl*Label.Relief groove
     option add *IndivaControl*Label.Font "$font 9 bold"
     option add *IndivaControl*Scale.Relief groove
     option add *IndivaControl*Scale.Font "$font 9 normal"
 
     return $f
 }
 
 
 IndivaController instproc add_gui { from to str } {
     set layout [lindex $str 0]
     set commands [lindex $str 1]
     eval $layout
     $self instvar imgr_
     foreach {type object cmd} $commands {
         switch $type {
             widget {
                 # If the object is a scale, we delay sending the command
                 # until t ms user stop sliding.  Otherwise we will be
                 # sending unnecessary messages to $imgr_.
                 set cls [winfo class $object]
                 switch $cls {
                     Scale {
                         $object configure -command "$self on_scale_changed $object $imgr_ control $from $to $cmd"
                     }
                     default {
                         $object configure -command "$self control $from $to $cmd"
                     }
                 }
             } 
             variable {
                 set traceproc "
                     proc ${object}_trace {var index op} {
                         global $object
                         $imgr_ control $from $to $cmd
                 }"
                 uplevel #0 $traceproc
                 trace variable $object w ${object}_trace
                 #for tcl >= 8.4
                 #trace add variable $object w "$imgr_ control $from $to $cmd"
             }
             default {
                 puts "WARNING: unknown command type $type"
             }
         }
     }
 }
 
 IndivaController instproc control { from to args } {
     set args [join $args]
     $self instvar imgr_
     if {[catch {$imgr_ control $from $to $args} err]} {
         puts stderr "Unable to control $from $to. Tcl encountered an error\n$err" 
     }
 }
 
 IndivaController public topframe { } {
     $self instvar topframe_
     return $topframe_
 }
 
 
 IndivaController private on_scale_changed { scale args } {
     $self instvar after_ids_
     if [info exists after_ids_($scale)] {
         after cancel $after_ids_($scale)
     }
     set after_ids_($scale) [after 300 eval $args]
 }
 
 IndivaController private switch_frame {dev name} {
     $self instvar frames_ curr_frames_
     catch {eval pack forget $curr_frames_}
     eval pack [set curr_frames_ $frames_($dev,$name)]
 }