Open Mash Cross Reference
mash/tcl/mb/ui-srclist.tcl

   # ui-srclist.tcl --
   #
   #       manages the list of sources
   #
   # Copyright (c) 1993-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.
  
  
  import Observable Callback
  
  Class SrcList -superclass { Callback Observable }
  
  SrcList instproc init { } {
          $self instvar canv_ bottom_ mainW_ bg_ font_ \
                          trackwidth_ trackX_ nameX_ srcHdr_
  
          set bottom_ 2
          set mainW_ [toplevel .srclist]
  
          wm withdraw $mainW_
          wm geometry $mainW_ 230x140
          bind $mainW_ <Enter> "focus $mainW_"
          wm title $mainW_ "MB Members"
  
          frame $mainW_.b -relief sunken -borderwidth 1
          scrollbar $mainW_.b.scroll -command "$mainW_.b.list yview" -width 12
          #
          # Note that we make the canvas dimensions small so that
          # if the user resizes the window, the dismiss button
          # doesn't disappear.  The default size is set by the
          # wm geometry command above.
          #
          set canv_ [canvas $mainW_.b.list -relief groove -borderwidth 1 \
                          -height 10 -width 10 -confine 1 -relief raised \
                          -yscrollcommand "$mainW_.b.scroll set"]
          set bg_ [$canv_ cget -bg]
  
          $canv_ xview moveto 0
          $canv_ yview moveto 0
          bind $canv_ <Configure> "$self reconfig_canv %w %h"
  
          set bottom [frame $mainW_.bottom -borderwidth 0]
          button $bottom.dismiss -text "Dismiss" -command "$self dismiss" \
                          -underline 0
  
          checkbutton $bottom.autoraise -text "Auto Raise" \
                          -command "$self toggle_auto_raise"
          $self tkvar followAny_
          checkbutton $bottom.followany -text "Follow Activity" \
                          -variable [$self tkvarname followAny_] \
                          -command "$self followAny"
  
          pack $mainW_.b -fill both -expand 1
          pack $mainW_.b.list -side left -expand 1 -fill both
          pack $mainW_.b.scroll -side right -fill y -pady 2 -padx 0
          pack $bottom.dismiss $bottom.autoraise $bottom.followany -side right \
                          -anchor se -padx 2 -pady 2
          pack $bottom -side bottom -expand false -fill x
          $self set auto_raise_ 0
          $self set currTrack_ {}
  
          # construct the header
          set font_ [$self get_option medfont]
          set trackX_ 0
          set trackhdrbut [button $canv_.track -text "Follow" -pady 0 -anchor w]
          set trackhdr [$canv_ create window $trackX_ 0 \
                          -anchor nw -window $trackhdrbut]
          set bbox [$canv_ bbox $trackhdr]
          set trackwidth_ [expr {[lindex $bbox 2] - [lindex $bbox 0]}]
          set nameX_ [expr [lindex $bbox 2] + 8]
          set srchdrbut [button $canv_.srchdr -text "Source Name" \
                          -anchor w -pady 0]
          set srcHdr_ [$canv_ create window [lindex $bbox 2] 0 \
                          -window $srchdrbut -anchor nw]
          set bottom_ [lindex [$canv_ bbox $srcHdr_ $trackhdr] 3]
          incr bottom_ 4
         return
         set entryheight_ [expr {[lindex [$canv_ bbox $srcHdr_ $trackhdr] 3] \
                         - 2}]
         set y [expr {$entryheight_ + 2}]
         set separator [$canv_ create line $trackX_ $y 250 $y -width 1]
 #                       -fill blue]
         set bottom_ [lindex [$canv_ bbox $separator] 3]
         incr bottom_ 2
 }
 
 SrcList instproc reconfig_canv {w h} {
         $self instvar nameX_ srcHdr_ canv_
 puts "w:$w h:$h"
  puts "c: [winfo width $canv_] [$canv_ cget -width]"
         set w [expr {[winfo width $canv_] - $nameX_ + 3}]
         $canv_ itemconfig $srcHdr_ -width $w
 }
 
 SrcList instproc dismiss {} {
         $self toggle_window 0
         $self callback dismiss
 }
 
 SrcList instproc toggle_auto_raise {} {
         $self instvar auto_raise_
         if {$auto_raise_} {
                 set auto_raise_ 0
         } else {
                 set auto_raise_ 1
         }
 }
 
 SrcList instproc toggle_window {onoff} {
     $self instvar mainW_
 
     if {$onoff==0} {
         wm withdraw $mainW_
     } else {
         wm deiconify $mainW_
     }
 }
 
 #
 # Register a src in the src display.  This happens for all the
 # srcs participating in the conferencing (e.g., including
 # those not actually sending data).
 #
 SrcList instproc register {src} {
     $self notify_observers register $src
     $self instvar srcstate_ canv_ bottom_ nametag_ map_ unhilitId_ \
                     tracktag_ trackButton_ bg_ font_ nameX_ entryheight_
 
     # already registered
     DbgOut [array names nametag_]
     if [info exists nametag_($src)] {
         return
     }
 
     set srcstate_($src) 1
 
     set varname [$self tkvar trackSrc_]
 #    set trackButton_($src) [radiobutton $canv_.$src -text track \
 #                   -variable $varname -indicatoron 0 -value $src \
 #                   -command "$self track $src"]
 
     set nametag_($src) [$canv_ create text $nameX_ $bottom_ \
                     -font $font_ -text "[$src cname]" -anchor nw]
     if ![info exists entryheight_] {
             set bbox [$canv_ bbox $nametag_($src)]
             set entryheight_ [expr {[lindex $bbox 3] - [lindex $bbox 1]}]
     }
     $self instvar trackwidth_ trackX_
     set rectsize [expr {int(0.6*$entryheight_)}]
     set xoffset [expr {($trackwidth_ - $rectsize)/2}]
     set yoffset [expr {($entryheight_ - $rectsize)/2}]
     set tracktag_($src) [$canv_ create rect  \
                     [expr {$trackX_+$xoffset}] [expr {$bottom_+$yoffset}] \
                     [expr {$trackX_+$xoffset+$rectsize}] \
                     [expr {$bottom_+$yoffset+$rectsize}] \
                     -fill $bg_]
     $canv_ bind $tracktag_($src) <Button-1> "$self toggle_track $src"
     set left [lindex [$canv_ bbox $tracktag_($src)] 2]
 
     set bottom_ [lindex [$canv_ bbox $nametag_($src) $tracktag_($src)] 3]
     incr bottom_ 2
     $canv_ config -scrollregion "0 0 2.5i $bottom_"
     set unhilitId_($src) {}
 }
 
 SrcList instproc adjustNames { thresh h } {
     $self instvar nametag_ srclist bottom_
     foreach s [array names nametag_] {
         set y [lindex [$canv_ coords $nametag_($s)] 1]
         if { $y > $thresh } {
             $canv_ move $nametag_($s) 0 -$h
         }
     }
     incr bottom_ -$h
     $canv_ config -scrollregion "0 0 2.5i $bottom_"
 }
 
 #
 # Remove a src from the src display.  This happens when
 # a party quits or has been dead for a sufficiently long time.
 # We assume the src has already been deactivated.
 #
 SrcList instproc unregister {src} {
     $self notify_observers unregister $src
     $self instvar name_line_ info_line_ nametag_ canv_
 
     destroy_rtp_stats $src
     #
     # Delete name_line_ and info_line_ if they exist.
     # They might not be created until the first NAME
     # report (and they aren't used until a source is activated).
     #
     if [info exists name_line_($src)] {
         unset name_line_($src)
         unset info_line_($src)
     }
     set thresh [lindex [$canv_ coords $nametag_($src)] 1]
     set bb [$canv_ bbox $nametag_($src)]
     set height [expr [lindex $bb 3] - [lindex $bb 1]]
     incr height 2
     if [info exists canv_] {
         $canv_ delete $nametag_($src)
         unset nametag_($src)
         $self adjustNames $thresh $height
     }
 }
 
 # SrcList instproc grayout src {
 #     global nametag_ canv_ srcstate_
 #     if [info exists canv_] {
 #         $canv_ itemconfigure $nametag_($src) -stipple gray50
 #     }
 #     set srcstate_($src) 2
 # }
 
 # SrcList instproc embolden src {
 #     global nametag_ canv_
 #     if [info exists canv_] {
 #         $canv_ itemconfigure $nametag_($src) -stipple {}
 #     }
 #     set srcstate_($src) 1
 # }
 
 #
 # hilit the source
 #    - sets a timeout to unhilit the receiver and execute $command then
 #
 SrcList instproc hilit {src} {
     $self notify_observers hilit $src
     $self instvar map_ canv_ nametag_ unhilitId_ mainW_
 
     if ![winfo ismapped $mainW_] {
         return
     }
     set tag $nametag_($src)
 
     $canv_ itemconfigure $tag -fill blue
     if [$self set auto_raise_] {
             raise $mainW_
     }
     if {$unhilitId_($src)!={}} {
         after cancel $unhilitId_($src)
     }
     set unhilitId_($src) [after 200 $self unhilit $src $tag]
 }
 
 # change the name of a source
 SrcList instproc update_src_info {src cname} {
         $self notify_observers update_src_info $src $cname
 
         $self instvar nametag_ canv_
         $canv_ itemconfigure $nametag_($src) -text "$cname"
 
 }
 
 #
 # unhighlight the source and execute command
 #
 SrcList instproc unhilit {src tag} {
         $self instvar canv_
         $canv_ itemconfigure $tag -fill black
         set unhilitId_($src) {}
 }
 
 SrcList instproc toggle_track {src} {
         $self instvar canv_ tracktag_ currTrack_ bg_
         $self notify_observers toggle_track $src
         if {$currTrack_!={}} {
                 if {$currTrack_ == $src} {
                         # uncheck and return without checking the new entry
                         $canv_ itemconfig $tracktag_($src) -fill $bg_
                         set currTrack_ {}
                         $self callback track $src 0
                         return
                 } else {
                         $canv_ itemconfig $tracktag_($currTrack_) -fill $bg_
                 }
         }
         # checking different entry
         $canv_ itemconfig $tracktag_($src) -fill blue
         set currTrack_ $src
         $self callback track $src 1
         $self tkvar followAny_
         if {$followAny_ == 1} {
                 set followAny_ 0
                 $self callback followAny_ 0
         }
 }
 
 SrcList instproc set_followAny {on} {
         $self tkvar followAny_
         set followAny_ $on
 }
 
 SrcList instproc followAny {} {
         $self tkvar followAny_
         $self instvar currTrack_
         if {$currTrack_!={}} {
                 $self toggle_track $currTrack_
         }
         $self callback followAny $followAny_
 }