#!/bin/sh
# the exec restarts using tclsh which in turn ignores
# the command because of this backslash: \
exec mash-VERSION "$0" -name bin/vic -- "$@"

#
# Copyright (c) 1993-1996 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:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. 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.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the University of
#	California, Berkeley and the Network Research Group at
#	Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS 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/src/mash/repository/mash/mash-1/head.tcl,v 1.3 1997/08/15 07:23:36 mccanne Exp $ (LBL)
#
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_
	set arg_option_($flag) $option
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_ 
	$self instvar arg_option_ arg_bool_ arg_bool_val_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_option_($arg)] {
			$self add_option $arg_option_($arg) $val
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		$self usage
		$self fatal "unknown command option: $arg"
	}
	return $argv
}
Configuration public usage {} {
	puts "usage: [Application name] [join [$self arg_info]]"
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	set req ""
	set opt ""
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			set opt [join "$opt \[$arg $r ($d)\]"]
		} else {
			set req [join "$req $arg $r"]
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        set opt [join "$opt \[$arg ($d)\]"]
		} else {
			set opt [join "$opt \[$arg\]"]
		}
	}
	return "{$opt} {$req}"
}
Configuration public load_preferences suffixList {
	set mash [glob ~]/.mash
	if [file isdirectory $mash] {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
Class RTPApplication -superclass Application
RTPApplication instproc init name {
	$self next $name
}
RTPApplication instproc run_resource_dialog { name email } {
	set font [$self get_option medfont]
	set w .form
	global V
	frame $w
	frame $w.msg -relief ridge
	label $w.msg.label -font $font -wraplength 4i \
		-justify left -text \
"Please specify values for the following resources. \
These strings will identify you by name and by email address \
in any RTP-based conference.  Please use your real name and \
affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
The values you enter will be saved in ~/.mash/prefs so you will \
not have to re-enter them." -relief ridge
	pack $w.msg.label -padx 6 -pady 6
	pack $w.msg -side top
	foreach i {name email} {
		frame $w.$i -bd 2
		entry $w.$i.entry -relief sunken
		label $w.$i.label -width 10 -anchor e
		pack $w.$i.label -side left
		pack $w.$i.entry -side left -fill x -expand 1 -padx 8
	}
	$w.name.label config -text rtpName:
	$w.email.label config -text rtpEmail:
	pack $w.msg -pady 10
	pack $w.name $w.email -side top -fill x
	$w.$i.entry insert 0 [email_heursitic]
	frame $w.buttons
	button $w.buttons.accept -text Accept -command "set dialogDone 1"
	button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
	pack $w.buttons.accept $w.buttons.dismiss \
		-side left -expand 1 -padx 20 -pady 10
	pack $w.buttons
	pack $w -padx 10
	global dialogDone
	while { 1 } {
		set dialogDone 0
		focus $w.name.entry
		tkwait variable dialogDone
		if { $dialogDone < 0 } {
			exit 0
		}
		set name [string trim [$w.name.entry get]]
		if { [string length $name] <= 3 } {
			new ErrorWindow "please enter a reasonable name"
			continue
		}
		set email [string trim [$w.email.entry get]]
		if { [string first . $email] < 0 || \
			[string first @ $email] < 0 } {
			new ErrorWindow "email address should have form user@host.domain"
			continue
		}
		break
	}
	set mash [glob ~]/.mash
	if ![file exists $mash] {
		file mkdir $mash
	}
	set f [open $mash/prefs a+ 0644]
	puts $f "rtpName: $name"
	puts $f "rtpEmail: $email"
	close $f
	pack forget $w
	destroy $w
}
RTPApplication public check_rtp_sdes {} {
	set name [$self get_option rtpName]
	if { $name == "" } {
		set name [$self get_option sessionName]
		option add *rtpName $name startupFile
	}
	set email [$self get_option rtpEmail]
	if { $name == "" || $email == "" } {
		$self run_resource_dialog $name $email
	}
}
RTPApplication private check_hostspec { argv } {
	$self instvar name_
	if { $argv == "" } {
		if { [$self get_option megaSession] == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 0]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
Class AddressBlock -configuration { defaultTTL 1 }
Class AddressBlock/RTP -superclass AddressBlock
Class AddressBlock/Simple -superclass AddressBlock
AddressBlock instproc init spec {
	$self next
	$self set nchan_ 0
	foreach s [split $spec ,] {
		set err [$self parse $s]
		if { $err != "" } {
			$self fatal $err
		}
	}
}
AddressBlock instproc data-port p {
	return [expr $p &~ 1]
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr k {
	return [$self set addr_($k)]
}
AddressBlock instproc sport k {
	return [$self set sport_($k)]
}
AddressBlock instproc rport k {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl k {
	return [$self set ttl_($k)]
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" } {
		$self add_option defaultFormat $fmt
		$self add_option audioFormat $fmt
	}	
	if [info exists confid] {
		$self add_option confid $confid
	}	
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 3072000
			} elseif { $ttl <= 64 } {
				set maxbw 1024000
			} elseif  { $ttl <= 128 } {
				set maxbw 128000
			} elseif { $ttl <= 192 } {
				set maxbw 53000
			} else {
				set maxbw 32000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
Class CoordinationBus
CoordBus set channel_ 0
CoordinationBus instproc init channel {
	$self instvar bus_
	set bus_ [new CoordBus $channel]
	$bus_ handler "$self handle"
}
CoordinationBus instproc debug msg {
	puts stderr "CB DEBUG: $msg"
}
CoordinationBus instproc handle { bus msg } {
	$self instvar dispatch_ argcnt_
	if { [llength $msg] < 1 } {
		$self debug "bad confbus message: $msg"
		return
	}
	set cls [lindex $msg 0]
	if ![info exists dispatch_($cls)] {
		$self debug "no such confbus method: $cls"
		return
	}
	set method $dispatch_($cls)
	set actuals [lrange $msg 1 end]
	if { [llength $actuals] != $argcnt_($cls) } {
		$self debug "confbus arg mismatch: $cls ($formals)/($actuals)"
		return		
	}
	eval "$self $method $actuals"
}
CoordinationBus instproc send msg {
	[$self set bus_] send $msg
}
CoordinationBus instproc register { cls method } {
	$self instvar dispatch_ argcnt_
	set dispatch_($cls) $method
	set argcnt_($cls) [llength [$self lookupArgs $method]]
}
CoordinationBus instproc inList { s list } {
	foreach item $list {
		if [string match $s $item] {
			return 1
		}
	}
	return 0
}
CoordinationBus instproc lookupArgs method {
	if [$self inList $method [$self info procs]] {
		return [$self info args $method]
	}
	return [$self lookupClassArgs $method [$self info class]]
}
CoordinationBus instproc lookupClassArgs { method cls } {
	if [$self inList $method [$cls info instprocs]] {
		return [$cls info instargs $method]
	}
	set argList ""
	if { $cls == "Object" } {
		return ""
	} else {
		foreach c [$cls info superclass] {
			set argList [$self lookupClassArgs $method $c]
			if { $argList != "" } {
				break
			}
		}
	}
	return $argList	
}
Class GlobalBus -superclass CoordinationBus
GlobalBus instproc init {} {
	$self next 0
}
proc confbusHandler { cb msg } {
	global cb_dispatch
	if { [llength $msg] < 1 } {
		debug "bad confbus message: $msg"
		return
	}
	set class [lindex $msg 0]
	if ![info exists cb_dispatch($class)] {
		debug "no such confbus method: $class"
		return
	}
	set proc $cb_dispatch($class)
	set formals [info args $proc]
	set actuals [lrange $msg 1 end]
	if { [llength $actuals] != [llength $formals] } {
		debug "confbus arg mismatch: $class ($formals)/($actuals)"
		return		
	}
	eval "$proc $actuals"
}
Object instproc get_argcnt method {
    if { [$self info procs $method]!={} } {
	return [llength [$self info args $method]]
    }
    return [[$self info class] class_get_argcnt $method]
}
Object instproc class_get_argcnt { method } {
    if { [$self info instprocs $method]!={} } {
	return [llength [$self info instargs $method]]
    }
    foreach class [$self info superclass] {
	set cnt [$class class_get_argcnt $method]
	if { $cnt != -1 } { return $cnt }
    }
    return -1;
}
CBChannel instproc __handle__ { cb src_appType src_session \
	src_instance dst_appType dst_session dst_instance event argv } {
    set object ""
    set method ""
    set argcnt  -1
    if { ![__find_handler__ $self $event object method argcnt] } {
	if { ![__find_handler__ $cb $event object method argcnt] } {
	    return
	}
    }
    if { $object=="" || $method=="" || $argcnt==-1 } {
	error "Huh? What happened? This shouldn't have happened"
    }
    if { [llength $argv] != $argcnt } {
	return
    }
    set info "__info__"
    set ${info}(bus)          $cb
    set ${info}(channel)      $self
    set ${info}(src,appType)  $src_appType
    set ${info}(src,session)  $src_session
    set ${info}(src,instance) $src_instance
    set ${info}(dst,appType)  $dst_appType
    set ${info}(dst,session)  $dst_session
    set ${info}(dst,instance) $dst_instance
    set ${info}(event)        $event
    eval $object $method $info $argv
}
proc __find_handler__ {self event objectVar methodVar argcntVar} {
    upvar $objectVar object $methodVar method $argcntVar argcnt
    $self instvar dispatch_
    if { (![info exists dispatch_($event,object)]) || \
	    (![info exists dispatch_($event,method)]) || \
	    (![info exists dispatch_($event,argcnt)]) } {
	return 0
    } else {
	set object $dispatch_($event,object)
	set method $dispatch_($event,method)
	set argcnt $dispatch_($event,argcnt)
	return 1
    }
}
proc __cb_register__ { self event object method } {
    $self instvar dispatch_
    set cnt [$object get_argcnt $method]
    if { $cnt==-1 } {
	error "$self register: could not find method '$method' for object '$object'"
    }
    if { $cnt==0 } {
	error "cb-handler method must have at least one arg: the event-info array"
    }
    set dispatch_($event,object) $object
    set dispatch_($event,method) $method
    set dispatch_($event,argcnt) [expr $cnt-1]
}
proc __cb_unregister__ { self event } {
    $self instvar dispatch_
    if { [info exist dispatch_($event,object)] } { 
	unset dispatch_($event,object) 
    }
    if { [info exist dispatch_($event,method)] } { 
	unset dispatch_($event,method) 
    }
    if { [info exist dispatch_($event,argcnt)] } { 
	unset dispatch_($event,argcnt) 
    }
}
CoordinationBus instproc register { event method } {
    switch [llength $method] {
	1 { __cb_register__ $self $event $self $method }
	2 { __cb_register__ $self $event [lindex $method 0] [lindex $method 1]}
	default { 
	    error "Invalid method in CoordinationBus::register: '$method'" 
	}
    }
}
CoordinationBus instproc unregister { event } {
    __cb_unregister__ $self $event
}
CBChannel instproc register { event method } {
    switch [llength $method] {
	1 { __cb_register__ $self $event $self $method }
	2 { __cb_register__ $self $event [lindex $method 0] [lindex $method 1]}
	default { 
	    error "Invalid method in CoordinationBus::register: '$method'" 
	}
    }
}
CBChannel instproc unregister { event } {
    __cb_unregister__ $self $event
}
Class Network/IP -superclass Network
Network/IP instproc init args {
	puts stderr "Network/IP called... change to Network"
	eval $self next $args
}
Network instproc port args {
	eval $self sport $args
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
Class NetworkLayer
Class NetworkManager
NetworkManager instproc graphics-init n {
	$self instvar nchan_
	set nchan_ $n
	toplevel .l
	set k 0
	while { $k < $nchan_ } {
		radiobutton .l.b$k -command "$self set-subscription-level $k" \
			-text "Level $k" \
			-variable nLayers -value $k
		pack .l.b$k
		incr k
	}
	wm withdraw .l
	bind . <l> { 
		if [winfo ismapped .l] {
			wm withdraw .l
		} else {
			wm deiconify .l
		}
	}
}
NetworkManager instproc set-subscription-level n {
	$self instvar agent_ nchan_ session_ net_
	$agent_ set_maxchannel $n
	$session_ set loopbackLayer_ [expr $n + 1]
	$self instvar session_
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
}
NetworkLayer instproc init { session addr sport rport ttl channel } {
	$self next
	$self instvar session_ addr_ port_ ttl_ dn_ cn_ channel_ active_
	set addr_ $addr
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	$dn_ open $addr_ $sport_ $rport_ $ttl_
	set cn_ [new Network]
	$cn_ open $addr_ [expr $sport_ + 1] [expr $rport + 1] $ttl_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	delete $dn_
	delete $cn_
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
		$session_ data-net "" $channel_
		$session_ ctrl-net "" $channel_
	}
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
        set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
					$sport $rport $ttl $nchan_]
		incr nchan_
	}
	$net_(0) enable
	$self set-subscription-level [expr $nchan_ - 1]
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar dc_ cc_ net_
	if [info exists dc_] {
		delete $dc_
	}
	if [info exists cc_] {
		delete $cc_
	}
	foreach dn [array names net_] {
		delete $net_($dn)
	}
	$self next
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_ 
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
Object instproc has_method { method } {
	if { [$self info procs $method]!="" } {
		return 1
	}
	return [[$self info class] has_method $method]
}
Class instproc has_method { method } {
	if { [$self info instprocs $method]!="" } {
		return 1
	}
	foreach cl [$self info heritage] {
		if { [$cl info instprocs $method]!="" } {
			return 1
		}
	}
	return 0
}
proc version {} {
	global mash
	return $mash(version)
}
proc local_fqdn {} {
	set host ""
	catch {set host [lookup_host_name [localaddr]]}
	if { [string first . $host] < 0 } {
		return ""
	}
	return $host
}
proc email_heursitic {} {
	set user [user_heuristic]
	set addr [local_fqdn]
	if { $addr == "" } {
		return ""
	}
	return $user@$addr
}
proc user_heuristic {} {
	global env
	if [info exists env(USER)] {
		set user $env(USER)
	} elseif [info exists env(LOGNAME)] {
		set user $env(LOGNAME)
	} else {
		catch {set env(USER) [getusername]}
		if [info exists env(USER)] {
			return $env(USER)
		}
		return "UNKNOWN"
	}
}
proc format_fps f {
	set fps $f
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	return $fps
}
proc format_bps b {
	set bps $b
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.1f kb/s" [expr $bps / 1000.]]
	} else {
		set bps [format "%.2f Mb/s" [expr $bps / 1000000.]]
	}
	return $bps
}
proc gettime {sec} {
    clock format $sec
}
proc sdr_gettimeofday {} {
    clock seconds
}
proc gettimenow {} {
    gettime [clock seconds]
}
proc getreadabletime {} {
    return [clock format [clock seconds] -format {%H:%M, %d/%m/%y}]
}
proc unix_to_ntp {unixtime} {
    set oddoffset 2208988800
    if {$unixtime==0} {return 0}
    return [format %u [expr $unixtime + $oddoffset]]
}
proc ntp_to_unix {ntptime} {
    set oddoffset 2208988800
    if {($ntptime==0)||($ntptime==1)} {return $ntptime}
    return [format %u [expr $ntptime - $oddoffset]]
}
proc duration_readable {secs {option terse}} {
	set ret ""
	set r [expr round($secs)]
	set h [expr $r / 3600]
	set r [expr $r % 3600]
	set m [expr $r / 60]
	set s [expr $r % 60]
	if {$option == "verbose"} then {
		if {$h} {
			set ret "$ret $h\h"
		} 
		if {$m} {
			set ret "$ret $m\m"
		} 
		if {$s} {
			set ret "$ret and $s\s"
		} 
	} else {
		set ret "$h:$m:$s"
	}
		return $ret
}
Class Observer
Observer instproc init { args } {
	eval [list $self] next $args
}
Observer instproc update { method args } {
	if [$self has_method $method] {
		eval [list $self] [list $method] $args
	}
}
Class Observable
Observable instproc init { args } {
	eval [list $self] next $args
	$self set observers_ { }
}
Observable instproc attach_observer { observer } {
	$self instvar observers_
	lappend observers_ $observer
}
Observable instproc detach_observer { observer } {
	$self instvar observers_
	set idx [lsearch $observers_ $observer]
	if { $idx != -1 } {
		set observers_ [lreplace $observers_ $idx $idx]
	}
}
Observable instproc notify_observers { method args } {
	$self instvar observers_
	if [info exists observers_] {
		foreach observer $observers_ {
			eval [list $observer] update [list $method] $args
		}
	}
}
Source/RTP set reportLoss 0
Session/RTP set nb_ 0
Session/RTP set nf_ 0
Session/RTP set np_ 0
Session/RTP set loopback_ 1
Source/RTP set badsesslen_ 0
Source/RTP set badsessver_ 0
Source/RTP set badsessopt_ 0
Source/RTP set badsdes_ 0
Source/RTP set badbye_ 0
SourceLayer/RTP set nchan_ 1
Session/RTP set badversion_ 0
Session/RTP set badoptions_ 0
Session/RTP set badfmt_ 0
Session/RTP set badext_ 0
Session/RTP set nrunt_ 0
Session/RTP set loopbackLayer_ 1000
Source/RTP public layer-stat which {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set s [expr $s + [$l set $which]]
	}
	return $s
}
Source/RTP public ns {} {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set s [expr $s + [$l set cs_] - [$l set fs_]]
	}
	return $s
}
Source/RTP public missing {} {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set nm [expr [$l set cs_] - [$l set fs_] - [$l set np_]]
		if { $nm > 0 } {
			set s [expr $s + $nm]
		}
	}
	return $s
}
Source/RTP instproc is_mixer {} {
	return [expr [$self srcid] != [$self ssrc]]
}
SourceLayer/RTP set nrunt_ 0
SourceLayer/RTP set ndup_ 0
SourceLayer/RTP set fs_ 0
SourceLayer/RTP set cs_ 0
SourceLayer/RTP set np_ 0
SourceLayer/RTP set nf_ 0
SourceLayer/RTP set nb_ 0
SourceLayer/RTP set nm_ 0
Source/RTP public init { sm srcid ssrc addr } {
	$self next $srcid $ssrc $addr
	$self set sm_ $sm
	$self instvar layers_
	set k 0
	if { [$sm info vars network_] != "" } {
		set net [$sm set network_]
		set n [$net set nchan_]
	} else {
		set n [SourceLayer/RTP set nchan_]
	}
	while { $k < $n } {
		set l [new SourceLayer/RTP]
		lappend layers_ $l
		$self layer $k $l
		incr k
	}
}
Source/RTP public getid {} {
	set name [$self sdes name]
	if { $name == "" } {
		set name [$self sdes cname]
		if { $name == "" } {
			set name [$self addr]
		}
	}
	return $name
}
Source/RTP public format_name {} {
	$self instvar sm_
	return [$sm_ rtp_type [$self format]]
}
Class MediaAgent -superclass {SourceManager Observable}
foreach method "unregister activate deactivate \
		trigger_media \
		trigger_format \
		trigger_sdes \
		trigger_idle \
		notify" {
	Source/RTP public $method {} \
		"\$self instvar sm_ ; \$sm_ $method \$self"
	MediaAgent public $method src "\$self notify_observers $method \$src"
}
MediaAgent public init {} {
	$self next
	$self set sources_ ""
}
MediaAgent public active_list {} {
	$self instvar active_
	if ![info exists active_] {
		return ""
	}
	return [array names active_]
}
MediaAgent public activate src {
	$self instvar active_
	set active_($src) 1
	$self notify_observers activate $src
}
MediaAgent public deactivate src {
	$self instvar active_
	unset active_($src)
	$self notify_observers deactivate $src
}
MediaAgent public unregister src {
	$self notify_observers unregister $src
	$self instvar sources_
	set k [lsearch -exact $sources_ $src]
	set sources_ [lreplace $sources_ $k $k]
}
MediaAgent public attach o {
	$self attach_observer $o
	$self instvar sources_ active_
	foreach s $sources_ {
		$o update register $s
		if [info exists active_($s)] {
			$o update activate $s
			$s enable_trigger
		}
	}
}
MediaAgent public detach o {
	$self detach_observer $o
	$self instvar sources_ active_
	foreach s $sources_ {
		if [info exists active_($s)] {
			$o update deactivate $s
		}
		$o update unregister $s
	}
}
MediaAgent public create-source { srcid ssrc addr srcsess } {
	set s [new Source/RTP $self $srcid $ssrc $addr]
	$s set session_ $srcsess
	$self instvar sources_
	lappend sources_ $s
	return $s
}
Class RTPAgent -superclass MediaAgent
RTPAgent public init ab {
	$self next
	$self instvar session_ mtu_
	set session_ [$self create_session]
	$session_ sm $self
	$session_ buffer-pool [new BufferPool]
	if { $ab != "" } {
		$self reset $ab
	}
	set mtu_ [$self get_option mtu]
	global V
	set V(sm) $self
}
RTPAgent public destroy {} {
	$self instvar session_ network_
	delete $session_
	delete $network_
	$self next
}
RTPAgent public reset_spec spec {
	set ab [new AddressBlock $spec]
	$self reset $ab
	delete $ab
}
RTPAgent public reset ab {
	$self instvar network_ session_ sources_
	if [info exists network_] {	
		delete $network_
	}
	set network_ [new NetworkManager $ab $session_ $self]
	$self app_loopback 1
	$self net_loopback [$self get_option loopback]
	set key [$self get_option sessionKey]
	if { $key != "" } {
		$network_ install-key $key
	}
	$self instvar local_
	if ![info exists local_] {
		$self mk_local_source
	}
	$session_ max-bandwidth [expr [$ab set maxbw_(0)]/1000.]
	catch {[Application instance] reset $ab}
}
RTPAgent public stats {} {
	set s [$self set session_]
	return " \
		Bad-RTP-version [$s set badversion_] \
		Bad-RTPv1-options [$s set badoptions_] \
		Bad-Payload-Format [$s set badfmt_] \
		Bad-RTP-Extension [$s set badext_] \
		Runts [$s set nrunt_]"
}
RTPAgent private mk_local_source {} {
	$self instvar network_ session_ local_
	set net [$network_ data-net 0]
	set a [$net addr]
	set srcid [$session_ random-srcid $a]
	set src [$self create-local $srcid [$net interface]]
	set local_ $src
	$self notify_observers register $local_
	set cname [$self get_option cname]
	if { $cname == "" } {
		set interface [$net interface]
		if { $interface == "0.0.0.0" } {
			set interface [$session_ local-addr-heuristic]
		}
		set cname [user_heuristic]@$interface
	}
	$src sdes name [$self get_option rtpName]
	$src sdes email [$self get_option rtpEmail]
	$src sdes cname $cname
	set tool [Application name]\-[version]
	global tcl_platform
	if {[info exists tcl_platform(os)] && $tcl_platform(os) != "" && \
			$tcl_platform(os) != "unix"} {
		set p $tcl_platform(os)
		if {$tcl_platform(osVersion) != ""} {
			set p $p-$tcl_platform(osVersion)
		}
		if {$tcl_platform(machine) != ""} {
			set p $p-$tcl_platform(machine)
		}
		set tool "$tool/$p"
	}
	$src sdes tool $tool
	return $src
}
RTPAgent public have_network {} {
	$self instvar network_
	return [info exists network_]
}
RTPAgent public have_localsrc {} {
	$self instvar local_
	return [info exists local_]
}
RTPAgent public install-key key {
	$self instvar network_
	if [info exists network_] {
		$network_ install-key $key
	}
}
RTPAgent public network {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [$network_ data-net 0]
}
RTPAgent public session-addr {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] addr]
}
RTPAgent public session-port {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] port]
}
RTPAgent public session-rport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] rport]
}
RTPAgent public session-sport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] sport]
}
RTPAgent public get_local_srcid {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	$self instvar local_
	return [$local_ srcid]
}
RTPAgent public get_transmitter {} {
	return [$self set session_]
}
RTPAgent public session-ttl {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] ttl]
}
RTPAgent public local-name {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	$self instvar local_
	return [$local_ sdes name]
}
RTPAgent public set_local_sdes { which value } {
	$self instvar local_
	$local_ sdes $which $value
}
RTPAgent public crypt_clear {} {
	if [info exists network_] {
		$network_ crypt_clear
	}
}
RTPAgent public shutdown {} {
	$self instvar session_
	$session_ exit
}
RTPAgent public set_maxchannel n {}
RTPAgent public set-bandwidth bps {
	[$self set session_] data-bandwidth $bps
}
RTPAgent public net_loopback enable {
	$self instvar network_
	$network_ loopback $enable
}
RTPAgent public app_loopback enable {
	$self instvar session_
	$session_ set loopback_ $enable
}
RTPAgent public set-bandwidth bps {
	[$self set session_] data-bandwidth $bps
}
Class RTP
Class RTP/Video -superclass RTP
Class RTP/Audio -superclass RTP
RTP private init {} {
	eval $self next
	$self instvar rtp_ptoa_ 
        set rtp_ptoa_(-1) ""
}
RTP/Audio public init args {
	$self next
	$self instvar rtp_ptoa_ rtp_atop_
	array set rtp_ptoa_ {
		0 pcm 1 celp 2 g721 3 gsm 5 dvi 6 dvi 7 lpc
		8 pcma 9 g722 10 lin16 11 lin16 14 mpa 15 g728
	}
	foreach pt [array names rtp_ptoa_] {
		set rtp_atop_($rtp_ptoa_($pt)) $pt
	}
}
RTP/Video public init args {
	$self next
	$self instvar rtp_ptoa_ rtp_atop_
	array set rtp_ptoa_ {
		20 ldct 21 pvh 22 bvc 25 cellb 26 jpeg 27 cuseeme 28 nv
		29 picw 30 cpv 31 h261 32 mpeg 33 mpegs
		127 h261v1
	}
	foreach pt [array names rtp_ptoa_] {
		set rtp_atop_($rtp_ptoa_($pt)) $pt
	}
	$self instvar classmap_
	set classmap_(pvh) PVH
	set classmap_(ldct) LDCT
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
}
RTP/Video public classmap type {
	$self instvar classmap_
	return $classmap_($type)
}
RTP public rtp_type pt {
	$self instvar rtp_ptoa_
	if [info exists rtp_ptoa_($pt)] {
		return $rtp_ptoa_($pt)
	} elseif { $pt < 0 }  {
		return ""
	} else {
		return fmt-$pt
	}
}
RTP public rtp_fmt_number fmt {
	$self instvar rtp_atop_
	if [info exists rtp_atop_($fmt)] {
		return $rtp_atop_($fmt)
	} else {
		return -1
	}
}
RTP public rtp_format src {
	$self instvar rtp_ptoa_
	return [$self rtp_type [$src format]]
}
RTP instproc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
RTP public rtp_representation src {
	set fmt [$self rtp_format $src]
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set srcname $addr
			set srcinfo $addr/$fmt
		} else {
			set srcname $cname
			set srcinfo $addr/$fmt
		}
	} elseif [$self cname_redundant $name $cname] {
		set srcname $name
		set srcinfo $addr/$fmt
	} else {
		set srcname $name
		set srcinfo $cname/$fmt
	}
	return "{$srcname} {$srcinfo}"
}
Class VideoAgent -superclass { RTPAgent RTP/Video }
VideoAgent public init args {
	eval $self next $args 
	$self site-drop-time [$self resource siteDropTime]
	$self instvar decoders_
	set decoders_ ""
}
VideoAgent public create_session {} {	
	return [new Session/RTP/Video]
}
VideoAgent public activate src {
	$self instvar decoders_
	set d [$self create_decoder $src]
	lappend decoders_ $d
	$src handler $d
	$self next $src
}
VideoAgent public deactivate src {
	$self instvar decoders_
	set d [$src handler]
	set k [lsearch -exact $decoders_ $d]
	set decoders_ [lreplace $decoders_ $k $k]
	$self next $src
	delete $d
}
VideoAgent public sessionbw b {
	$self set sessionbw_ $b
	$self notify_observers sessionbw $b
}
VideoAgent public local_bandwidth b {
	[$self set session_] data-bandwidth $b
}
Module/VideoDecoder public parameters_changed {} {
	$self instvar agent_ src_
	$agent_ dispatch "decoder_changed $src_"
}
VideoAgent public set_maxchannel n {
	$self instvar decoders_
	if [info exists decoders_] {
		foreach d $decoders_ {
			$d set maxChannel_ $n
		}
	}
}
VideoAgent public create_decoder src {
	set d [$src handler]
	if { $d != "" } {
		delete $d
	}
	set c [$self classmap [$src format_name]]
	set decoder [new Module/VideoDecoder/$c]
	if { $decoder == "" } {
		set decoder [new Module/VideoDecoder/Null]
	}
	$decoder set agent_ $self
	$decoder set src_ $src
	return $decoder
}
Module instproc frame-format {} "return 422"
Module/VideoEncoder/Pixel/H261 instproc frame-format {} "return cif"
Module/VideoEncoder/Pixel/PVH instproc frame-format {} "return 411"
Module/VideoEncoder/Pixel/LDCT instproc frame-format {} "return 411"
Module/VideoEncoder set nb_ 0
Object Device
Device proc register_class c {
	$c proc nickname {} {
		return [$self set nickname_]
	}
	$c proc attributes {} {
		return [$self set attributes_]
	}
	foreach method "get_attribute supports" {
		$c proc $method args "eval Device $method $c \$args"
	}
}
Device proc get_attribute { cl attr } {
	$cl instvar attributes_
	set k [lsearch -exact $attributes_ $attr]
	if { $k >= 0 } {
		incr k
		return [lindex $attributes_ $k]
	}
	return ""
}
Device proc supports { cl key item } {
	set itemList [$self get_attribute $cl $key]
	if { $item == "*" } {
		if { $itemList == "" } {
			return 0
		} else {
			return 1
		}
	} else {
		return [inList $item $itemList]
	}
}
if [TclObject is-class VideoCapture] {
	foreach c [VideoCapture info subclass] {
		Device register_class $c
	}
}
proc inList { item L } {
	return [expr [lsearch -exact $L $item] >= 0]
}
Class VideoTap
VideoTap public init {} {
	$self next
	$self instvar device_ running_ fps_ bps_ decimate_
	set device_ ""
	set running_ 0
	set fps_ 8
	set bps_ 128000
	set decimate_ 2
}
VideoTap public target { target encoder } {
	$self instvar grabber_
	$grabber_ encoder $encoder
	$grabber_ target $target
}
VideoTap public running {} {
	return [$self set running_]
}
VideoTap public input_devices {} {
	if ![TclObject is-class VideoCapture] {
		return ""
	}
	return [VideoCapture info subclass]
}
VideoTap public release {} {
	$self instvar grabber_
	if [info exists grabber_] {
		$self close
	}
}
VideoTap public close {} {
	$self instvar grabber_ capwin_
	$self stop
	delete $grabber_
	unset grabber_
	if [info exists capwin_] {
		delete $capwin_
		destroy [winfo toplevel capwin_]
		unset capwin_
	}
}
VideoTap public stop {} {
	$self instvar running_ grabber_ capwin_
	if $running_ {
		$grabber_ send 0
		set running_ 0
		if [info exists capwin_] {
			wm withdraw [winfo toplevel $capwin_]
		}
	}
}
VideoTap public start {} {
	$self instvar running_ grabber_ capwin_
	if !$running_ {
		if ![info exists grabber_] {
			set err [$self open_device]
			if { $err != "" } {
				return $err
			}
		}
		if [info exists capwin_] {
			wm deiconify [winfo toplevel $capwin_]
			update idletasks
		}
		$grabber_ send 1
		set running_ 1
	}
	return ""
}
VideoTap public fillrate v {
	$self instvar grabber_
	if [info exists grabber_] {
		$grabber_ fillrate $v
	}
}
VideoTap public open { device videoType } {
	global useJPEGforH261
	$self instvar grabber_ device_ capwin_ fps_ bps_ decimate_ port_
	if [info exists grabber_] {
		$self close
	}
	set device_ $device
	set grabber_ [new $device_ $videoType]
	if { $grabber_ == "" && $videoType == "411" } {
		set grabber_ [new $device_ cif]
	}
	if { $grabber_ == "" } {
		$self fatal "couldn't set up grabber/encoder for $videoType->$format_"
	}
	set error [$grabber_ status]
	if { $error < 0 } {
		$self close
		if { $error == -2 } {
			return "Can't use jvideo with $format_ format"
		}
		return "can't open [$device_ nickname] capture device"
	}
	if { [$grabber_ need-capwin] && ![info exists capwin_] } {
		toplevel .capture -class Vic
		wm title .capture "Video Capture Window"
		$grabber_ create-capwin .capture.video
		set capwin_ .capture.video
		pack .capture.video
		bind .capture <Visibility> "raise .capture"
	}
	$grabber_ fps $fps_
	$grabber_ bps $bps_
	$grabber_ decimate $decimate_
	if [info exists port_] {
		$grabber_ port $port_
	}
	return ""
}
VideoTap instproc grabber args {
	$self instvar grabber_
	if [info exists grabber_] {
		eval $grabber_ $args
	}
}
VideoTap instproc set_bps v {
	$self instvar grabber_ bps_
	set bps_ $v
	if [info exists grabber_] {
		$grabber_ bps $v
	}
}
VideoTap instproc set_fps v {
	$self instvar grabber_ fps_
	set fps_ $v
	if [info exists grabber_] {
		$grabber_ fps $v
	}
}
VideoTap instproc set_decimate v {
	$self instvar grabber_ decimate_
	set decimate_ $v
	if [info exists grabber_] {
		$grabber_ decimate $v
	}
}
VideoTap instproc set_port p {
	$self instvar grabber_ port_
	set port_ $p
	if [info exists grabber_] {
		$grabber_ port $p
	}
}
Class VideoPipeline -superclass RTP/Video
VideoPipeline public init session {
	$self next
	$self instvar format_ tap_ session_ quality_
	set tap_ [new VideoTap]
	set session_ $session
	set format_ ""
	set quality_ 10
}
VideoPipeline public running {} {
	return [[$self set tap_] running]
}
VideoPipeline public input_devices {} {
	return [[$self set tap_] input_devices]
}
VideoPipeline public set_bps args {
	return [eval [$self set tap_] set_bps $args]
}
VideoPipeline public set_fps args {
	return [eval [$self set tap_] set_fps $args]
}
VideoPipeline public start args {
	return [eval [$self set tap_] start $args]
}
VideoPipeline public stop args {
	return [eval [$self set tap_] stop $args]
}
VideoPipeline public set_port args {
	return [eval [$self set tap_] set_port $args]
}
VideoPipeline public fillrate args {
	return [eval [$self set tap_] fillrate $args]
}
VideoPipeline public hardware args {
	return [eval [$self set tap_] grabber $args]
}
VideoPipeline public available_formats d {
	set sizes [$d get_attribute size]
	set formats [$d get_attribute format]
	set fmtList ""
	if [inList 422 $formats] {
		set fmtList "$fmtList nv nvdct cellb jpeg"
	}
	if [inList 411 $formats] {
		set fmtList "$fmtList pvh"
	}
	if [inList cif $sizes] {
		set fmtList "$fmtList h261"
	}
	if [inList jpeg $formats] {
		set fmtList "$fmtList jpeg"
		global useJPEGforH261
		if $useJPEGforH261 {
			set fmtList "$fmtList h261"
		}
	}
	return $fmtList
}
VideoPipeline public release_device {} {
	$self instvar tap_
	if [$tap_ running] {
		$self close
	}
}
VideoPipeline private close {} {
	$self instvar encoder_ tap_
	$tap_ release
	if [info exists encoder_] {
		delete $encoder_
		unset encoder_
	}
}
VideoPipeline public select { device format } {
	$self instvar tap_
	set running [$tap_ running]
	$self close
	$self open $device $format
	if $running {
		$self start
	}
}
VideoPipeline private create_encoder fmt {
	if { $fmt == "nvdct" } {
		set encoder [new Module/VideoEncoder/Pixel/NV]
		$encoder use-dct 1
	} else {
		set fmt [$self classmap $fmt]
		set encoder [new Module/VideoEncoder/Pixel/$fmt]
	}
	if { $encoder == "" } {
		$self fatal "cannot allocate $fmt encoder"
	}
	return $encoder
}
VideoPipeline instproc open { device format } {
	global useJPEGforH261
	$self instvar tap_ encoder_ format_ bufferPool_ session_ quality_
	$tap_ release
	set format_ $format
	set DF [$device get_attribute format]
	set DS [$device get_attribute size]
	if [inList $format_ $DF] {
		set encoder_ [$self create_encoder $format_]
		set grabtarget $encoder
		set grabq ""
	} elseif { $format_ == "h261" && [inList jpeg $DF] && \
			$useJPEGforH261 } {
		set transcoder [new transcoder/jpeg/dct]
		set encoder_ [new Module/VideoEncoder/DCT/H261]
		$transcoder target $encoder_
		set grabtarget $transcoder
		set grabq "70"
	} elseif { [inList $format_ [$self available_formats $device] ] } {
		set encoder_ [$self create_encoder $format_]
		set grabtarget $encoder_
		set grabq ""
	}
	$encoder_ mtu [$self get_option mtu]
	if ![info exists bufferPool_] {
		set bufferPool_ [new BufferPool/RTP]
		$bufferPool_ srcid [$session_ get_local_srcid]
	}
	$encoder_ buffer-pool $bufferPool_
	$encoder_ target [$session_ get_transmitter]
	set ff [$grabtarget frame-format]
	set err [$tap_ open $device $ff]
	if { $err != "" } {
		return $err
	}
	$tap_ target $grabtarget $encoder_
	$self set_quality $quality_
	return ""
}
VideoPipeline public set_quality q {
	$self instvar format_ quality_
	set quality_ $q
	if { [catch "$self setq_$format_ $q" val] == 0 } {
		return $val
	}
	return -1
}
VideoPipeline private setq_jpeg value {
	incr value
	if { $value > 95 } {
		set value 95
	} elseif { $value < 5 } {
		set value 5
	}
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
VideoPipeline instproc setq_h261 value {
	set value [expr int((1 - $value / 100.) * 29) + 1]
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
VideoPipeline instproc setq_nv value {
	set value [expr (100 - $value) / 10]
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
set pvh_shmap { 0 1 2 1 }
set pvh_shs {
	{ lum-dct 0 5-1--11- }
	{ lum-dct 1 ---5111- }
	{ lum-dct 2 --51-11- }
	{ lum-sbc 0 ----4--2 }
	{ lum-sbc 1 ----4--2 }
	{ lum-sbc 2 ----4--2 }
	{ chm     0 -5---1-- }
	{ chm     1 ---5-1-- }
	{ chm     2 --5--1-- }
}
VideoPipeline instproc setq_pvh value {
	$self instvar encoder_
	if ![info exists encoder_] {
		return -1
	}
	global pvh_shmap pvh_shs
	set n [llength $pvh_shmap]
	set i 0
	while { $i < $n } {
		$encoder_ shmap $i [lindex $pvh_shmap $i]
		incr i
	}
	set i 0
	foreach tuple $pvh_shs {
		set compID [lindex $tuple 0]
		set shID [lindex $tuple 1]
		set pattern [lindex $tuple 2]
		$encoder_ comp $compID $shID $pattern
	}
	return -1
}
Module/AudioEncoder set nb_ 0
if [TclObject is-class Audio] {
	Audio set duplex_ 1
}
AudioController set echo_thresh_ 0
AudioController set echo_suppress_time_ 0
AudioController set idle_drop_time_ 0
Class AudioAgent -superclass { RTPAgent RTP/Audio }
AudioAgent public init { app args } {
	eval $self next $args 
	$self compute_controller_defaults
	$self site-drop-time [$self get_option siteDropTime]
	$self instvar bufferPool_ silenceThresh_ decoders_ audioTest_
	set decoders_ ""
	set silenceThresh_ 0
	set audioTest_ none
	if ![info exists bufferPool_] {
		set bufferPool_ [new BufferPool/RTP]
	}
	$self instvar classmap_
	set classmap_(pcm) PCM
	set classmap_(lpc) LPC
	set classmap_(gsm) GSM
	set classmap_(dvi) ADPCM
	set devList [$self device_list]
	if { $devList == "" } {
		$self fatal "no suitable audio device found."
	}
	foreach d $devList {
		if { "$d" != "AF" } {
			break
		} elseif [$self yesno useAF] {
			break
		}
	}
	$self open_device $d
	$self select_format PCM 2
	$self set_input_mute 1
	$self set_output_mute 0
	$self set_output_gain 5
	if ![$self have_audio] {
		$self obtain
	}
}
AudioAgent public destroy {} {
	$self instvar bufferPool_ audio_
	delete $bufferPool_
	$self close_device
	$self next
}
AudioAgent private compute_controller_defaults {} {
	set AUDIO_SPS 8000
	set TALK_LEAD 4
	set TALK_TAIL 32
	set AUDIO_FRAMESIZE 160
	set SS_GRANULARITY 1440
	set v [expr [$self get_option maxPlayout] * $AUDIO_SPS]
	if [expr $v < ($TALK_LEAD + $TALK_TAIL + 2) * $AUDIO_FRAMESIZE] {
		set w [expr (($TALK_LEAD + $TALK_TAIL + 2) * \
			$AUDIO_FRAMESIZE + $AUDIO_SPS - 1) / $AUDIO_SPS]
		puts stderr "max playout delay $v too short - using $w sec"
		set v [expr ($TALK_LEAD + $TALK_TAIL + 2) * $AUDIO_FRAMESIZE]
	}
	set v [expr ($v + ($SS_GRANULARITY - 1)) / $SS_GRANULARITY]
	set v [expr $v * $SS_GRANULARITY / $AUDIO_FRAMESIZE]
	AudioController set max_playout_ $v
	AudioController set echo_suppress_time_ [expr \
		[$self get_option echoSuppressTime] / 20 * $AUDIO_FRAMESIZE]
}
AudioAgent private activate src {
	$self instvar decoders_
	set d [$self create_decoder $src]
	lappend decoders_ $d
	$src handler $d
	$self next $src
}
AudioAgent private deactivate src {
	$self instvar decoders_
	set d [$src handler]
	set k [lsearch -exact $decoders_ $d]
	set decoders_ [lreplace $decoders_ $k $k]
	$self next $src
	delete $d
}
AudioAgent private trigger_media src {
	$self instvar cb_
	if [info exists cb_] {
		set cname [$src sdes cname]
		if { "$cname" != "" } {
			$cb_ send "focus $cname"
		}
	}
	$self next $src
}
AudioAgent public attach_coordbus cb {
	$self set cb_ $cb
}
AudioAgent private set_maxchannel n {
	global active
	foreach s [array names active] {
		set d [$s handler]
		$d set maxChannel_ $n
	}
}
AudioAgent public create_decoder src {
	$self instvar controller_ classmap_
	set decoder [new Module/AudioDecoder/$classmap_([$src format_name])]
	if { $decoder == "" } {
		set decoder [new Module/AudioDecoder/Null]
	}
	if ![info exists controller_] {
		puts stderr "AudioAgent: no audio controller."
		exit 0
	}
	$decoder set agent_ $self
	$decoder set src_ $src
	$decoder controller $controller_
	$src handler $decoder
	return $decoder
}
AudioAgent public select_format { fmt blksPerPkt } {
	$self instvar encoder_ bufferPool_ mtu_ session_ \
			controller_ blksPerPkt_ classmap_
	if [info exists encoder_] {
		delete $encoder_
	}
	set encoder_ [new Module/AudioEncoder/$fmt]
	set blksPerPkt_ $blksPerPkt
	if [info exists controller_] {
		$controller_ encoder $encoder_
		$controller_ blocks-per-packet $blksPerPkt
	}
	if { "$encoder_" == "" } {
		return -1
	}
	$encoder_ target $session_
	$encoder_ buffer-pool $bufferPool_
	return 0
}
AudioAgent private create_session {} {
	return [new Session/RTP/Audio]
}
AudioAgent public reset ab {
	$self next $ab
	$self app_loopback 0
	$self net_loopback [$self get_option loopback]
	$self set-bandwidth 128000
	$self instvar set_pool_srcid_
	if ![info exists set_pool_srcid_] {
		$self instvar bufferPool_
		if ![info exists bufferPool_]  {
			set bufferPool_ [new BufferPool/RTP]
		}
		$bufferPool_ srcid [$self get_local_srcid]
		set set_pool_srcid_ 1
	}
}
AudioAgent instproc reset_source_offsets {} {
	$self instvar decoders_
	foreach d $decoders_ {
		$d reset-offset
	}
}
AudioAgent public device_list {} {
	if ![TclObject is-class Audio] {
		return ""
	}
	return [Audio info subclass]
}
AudioAgent public bind_transducer { which o } {
	$self instvar meter_ controller_
	set meter_($which) $o
	if [info exists controller_] {
		$controller_ $which-meter $o
	}
}
AudioAgent private open_device dev {
	$self instvar audio_ meter_ controller_ silenceThresh_
	if [info exists audio_] {
		delete $audio_
		unset audio_
	}
	if [info exists controller_] {
		delete $controller_
		unset controller_
	}
	set audio_ [new $dev]
	$self instvar gain_
	set names [$self get_input_ports]
	foreach port $names {
		if {[$self get_option $port\Gain]!={}} {
			set gain_($port) [$self get_option $port\Gain]
		} else {
			set gain_($port) [$self get_option inputGain]
		}
	}
	set names [$self get_output_ports]
	foreach port $names {
		if {[$self get_option $port\Gain]!={}} {
			set gain_($port) [$self get_option $port\Gain]
		} else {
			set gain_($port) [$self get_option outputGain]
		}
		$self set_speakerphone $port [$self get_option $port\Mode]
	}
	$self instvar port_
	set port_(input) ""
	set port_(output) ""
}
AudioAgent private install_controller {} {
	$self instvar audio_ encoder_ blksPerPkt_ silenceThresh_ meter_ \
		controller_
	if [$audio_ set duplex_] {
		set duplex FullDuplex
	} else {
		set duplex HalfDuplex
		if ![$self have_audio] {
			$self obtain
		}
		if { [$self yesno forceFullDuplex] || [$audio_ set duplex_] } {
			set duplex FullDuplex
		}
	}
	set controller_ [new AudioController/$duplex]
	$controller_ audio $audio_
	if [info exists meter_(input)] {
		$controller_ input-meter $meter_(input)
	}
	if [info exists meter_(output)] {
		$controller_ output-meter $meter_(output)
	}
	$controller_ silence-thresh $silenceThresh_
	if [info exists encoder_] {
		$controller_ encoder $encoder_
		$controller_ blocks-per-packet $blksPerPkt_
	}
	$controller_ agc-input [$self get_option mikeAGCLevel]
	$controller_ agc-output [$self get_option speakerAGCLevel]
	$controller_ silence-thresh [$self get_option silenceThresh]
}
AudioAgent public obtain {} {
	$self instvar audio_ controller_
	$audio_ obtain
	if { ![info exists controller_] && [$audio_ have] } {
		$self install_controller
	}
}
AudioAgent public release {} {
	[$self set audio_] release
}
AudioAgent public set_silence_thresh thresh {
	$self instvar silenceThresh_ controller_
	set silenceThresh_ $thresh
	if [info exists controller_] {
		$controller_ silence-thresh $silenceThresh_
	}
}
AudioAgent public have_audio {} {
	$self instvar audio_
	if [info exists audio_] {
		return [$audio_ have]
	}
	return 0
}
AudioAgent public set_input_mute val {
	$self instvar audio_
	$audio_ set_input_mute $val
}
AudioAgent public set_output_mute val {
	$self instvar audio_
	$audio_ set_output_mute $val
}
AudioAgent public get_input_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_input_ports]]
}
AudioAgent public get_output_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_output_ports]]
}
AudioAgent public is_halfduplex {} {
	$self instvar audio_
	return [expr ![$audio_ set duplex_]]
}
AudioAgent public get_input_portno { } {
	$self instvar audio_
	return [$audio_ get_input_port]
}
AudioAgent public get_output_portno { } {
	$self instvar audio_
	return [$audio_ get_output_port]
}
AudioAgent public set_speakerphone { port mode } {
	$self instvar speakerphone_ port_
	set speakerphone_($port) $mode	
	if { [info exists port_(output)] && $port == $port_(output) } {
		$self instvar audio_
		$audio_ set_speakerphone $mode
	}
}
AudioAgent public audio_test type {
	$self instvar audioTest_ controller_
	$self set audioTest_ $type
	if [info exists controller_] {
		if { $type == "loopback" } {
			$controller_ test_tone none
			$controller_ loopback 1
		} else {
			$controller_ test_tone $type
			$controller_ loopback 0
		}
	}
}
AudioAgent private port_name_to_num { which name } {
	set L [$self get_$which\_ports]
	return [lsearch -exact $L $name]
}
AudioAgent public set_input_port port {
	$self instvar audio_ port_ gain_ speakerphone_
	set port_(input) $port
	$audio_ set_input_port [$self port_name_to_num input $port]
	$self set_input_gain $gain_($port)
}
AudioAgent public set_output_port port {
	$self instvar audio_ port_ gain_ speakerphone_
	set port_(output) $port
	$audio_ set_output_port [$self port_name_to_num output $port]
	$self set_output_gain $gain_($port)
	$self set_speakerphone $port $speakerphone_($port)
}
AudioAgent public set_input_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(input)) $gain
	return [$audio_ set_input_gain $gain]
}
AudioAgent public set_output_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(output)) $gain
	return [$audio_ set_output_gain $gain]
}
AudioAgent public get_input_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(input))
}
AudioAgent public get_output_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(output))
}
AudioAgent private close_device {} {
	if [info exists audio_] {
		delete $audio_
		unset audio_
		delete $controller_
		unset controller_
	}
}
AudioAgent public is_active {} {
	$self instvar controller_ audioTest_
	if [info exists controller_] {
		if { $audioTest_ != "none" } {
			return 1
		}
		return [$controller_ active]
	}
	return 0
}
AudioAgent public clear_active {} {
	$self instvar controller_
	if [info exists controller_] {
		$controller_ active 0
	}
}
AudioAgent instproc unix_time {} {
	$self instvar controller_
	if [info exists controller_] {
		return [$controller_ unix_time]
	}
	return 0
}
AudioAgent instproc ntp_time {} {
	$self instvar controller_
	if [info exists controller_] {
		return [$controller_ ntp_time]
	}
	return 0
}
bind Entry <Enter> {
	catch {
		global entryTab
		if $entryTab(%W:focus) {
			focus %W
		}
	}
}
bind Entry <Return> {
	focus .
	%W select clear
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		set oldval $entryTab(%W:value)
		set v [%W get]
		set entryTab(%W:value) $v
		if [$entryTab(%W:object) update $v] {
			set entryTab(%W:value) $oldval
			%W delete 0 end
			%W insert 0 $oldval
		}
	}
}
bind Entry <Escape> {
	focus .
	%W select clear
	%W delete 0 end
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		%W insert 0 $entryTab(%W:value)
	}
}
bind Entry <Control-g> [bind Entry <Escape>]
bind Entry <Control-u> {
    tkEntrySetCursor %W 0
    %W delete insert end
}
proc mk.entry { w action text } {
	puts stderr "Use the new Entry class"
	exit 1
}
Class Entry
Entry instproc init { w value {obj {}} } {
	$self instvar win_
	set win_ $w
	entry $w -relief raised -borderwidth 1 -exportselection 1 \
		-font [$self get_option entryFont]
	global entryTab
	if {$obj == {}} {
		set entryTab($w:object) $self
	} else {
		set entryTab($w:object) $obj
	}
	set entryTab($w:value) $value
	$w insert 0 $value
}
Entry instproc entry-value { } {
	global entryTab		
	$self instvar win_
	return $entryTab($win_:value)
}
Entry instproc clear { } {
	global entryTab
	$self instvar win_
	set entryTab($win_:value) 0
	$win_ insert 0 ""
}
set nids 0
proc uniqueID { } {
	global nids
	incr nids
	return $nids
}
proc isCIF fmt {
	if { $fmt == "h261" } {
		return 1
	}
	return 0
}
proc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
set current_icon_mark "XXX"
proc mk.key w {
	puts stderr "Use the new KeyEditor class"
	exit 1
}
Class KeyEditor
KeyEditor instproc init { w crypt } {
	$self instvar crypt_ entry_ win_
	set crypt_ $crypt
	set win_ $w
	frame $w.key
	checkbutton $w.key.button -text "Encryption Key:" -relief flat \
		-font [$self get_option smallfont] \
		-command "$self toggle" -variable [$self tkvarname encryptOn_]\
		-disabledforeground gray40
	set key [$self get_option sessionKey]
	set entry_ [new Entry $w.key.entry $key $self]
	$self set-key $key
	pack $w.key.button -side left
	pack $w.key.entry -side left -fill x -expand 1
}
KeyEditor instproc disable {} {
	$self instvar win_
	$win_.key.button configure -state disabled
}
KeyEditor instproc enable {} {
	$self instvar win_
	$win_.key.button configure -state normal
}
KeyEditor instproc set-key key {
	$self tkvar encryptOn_
	$self instvar crypt_
	if { $key == "" } {
		$crypt_ crypt_clear
		set encryptOn_ 0
		$self disable
	} elseif { [$crypt_ install-key $key] != "" } {
		$self disable
		set encryptOn_ 0
		$self clear
	} else {
		$self enable
		set encryptOn_ 1
	}
}
KeyEditor instproc toggle {} {
	$self instvar crypt_ entry_
        $self tkvar encryptOn_
	if $encryptOn_ {
		$crypt_ install-key [$entry_ entry-value]
	} else {
		$crypt_ install-key ""
	}
}
KeyEditor instproc update key {
	set key [string trim $key]
	$self set-key $key
	return 0
}
Class TextEntry -superclass Entry
TextEntry instproc init { target w text } {
	$self next $w $text
	$self set target_ $target
}
TextEntry instproc update s {
	$self instvar target_
	if { $s != "" } {
		set s [string trim $s]
	}
	return [eval $target_ \"$s"]
}
Class TkWindow
Class TopLevelWindow -superclass TkWindow
TkWindow instproc init path {
	$self next
	$self instvar path_
	set path_ $path
}
TkWindow instproc destroy {} {
	$self instvar path_
	if [winfo exists $path_] {
		destroy $path_
	}
	$self next
}
TopLevelWindow instproc build_window {} {
	$self instvar path_
	if ![winfo exists $path_] {
		$self build $path_
	}
}
TopLevelWindow instproc toggle {} {
	$self build_window
	$self instvar path_
	set w $path_
	$self instvar __mappedBefore__
	if { [winfo ismapped $w] } {
		wm withdraw $w
		return
	} elseif ![info exists __mappedBefore__] {
		set __mappedBefore__ 1
		wm transient $w .
		update idletasks
		set x [winfo rootx .]
		set y [winfo rooty .]
		incr y [winfo height .]
		incr y -[winfo reqheight $w]
		incr y -20
		incr x [winfo vrootx .]
		incr y [winfo vrooty .]
		if { $y < 0 } { set y 0 }
		if { $x < 0 } {
			set x 0
		} else {
			set right [expr [winfo screenwidth .] - \
					[winfo reqwidth $w]]
			if { $x > $right } {
				set x $right
			}
		}
		wm geometry $w +$x+$y
	}
	wm deiconify $w
}
TopLevelWindow instproc create-window { w title } {
	Application toplevel $w
	set title [$self get_option iconPrefix]$title
	wm transient $w .
	wm title $w $title
	wm iconname $w $title
	bind $w <Enter> "focus $w"
	wm withdraw $w
}
Class HelpWindow -superclass TopLevelWindow
HelpWindow instproc create-window { w title items } {
	$self next $w $title
	frame $w.frame -borderwidth 0 -relief flat
	set p $w.frame
	set n 0
	foreach m $items {
		set h $w.h$n
		incr n
		frame $h
		$self helpitem $h $m
		pack $h -expand 1 -fill both
	}
	button $w.frame.ok -text " Dismiss " -borderwidth 2 -relief raised \
		-command "wm withdraw $w" -font [$self get_option medfont] 
	pack $w.frame.ok -pady 6 -padx 6 -anchor e
	pack $w.frame -expand 1 -fill both
}
HelpWindow instproc helpitem { w text } {
	set f [$self get_option helpFont]
	canvas $w.bullet -width 12 -height 12 
	$w.bullet create oval 6 3 12 9 -fill black
	message $w.msg -justify left -anchor w -font $f -width 450 -text $text
	pack $w.bullet -side left -anchor ne -pady 5
	pack $w.msg -side left -expand 1 -fill x -anchor nw
}
Class ErrorWindow -superclass TopLevelWindow
ErrorWindow instproc init text {
	set w .dialog    
	$self next $w
	catch "destroy $w"
	global V
	$self create-window $w "[Application name] error"
	label $w.label -text "[Application name]: $text" -font [$self get_option medfont] \
		-borderwidth 2 -relief groove
	button $w.button -text OK -command "$self destroy" \
			-font [$self get_option medfont]
	pack $w.label -expand 1 -fill x -ipadx 4 -ipady 4
	pack $w.button -pady 4
	wm withdraw $w
	update idletasks
	set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
		- [winfo vrootx [winfo parent $w]]]
	set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
		- [winfo vrooty [winfo parent $w]]]
	wm geom $w +$x+$y
	wm deiconify $w
	bind $w <Enter> "focus $w"
	tkwait window .dialog
}
Class CheckButton
CheckButton instproc init { w args } {
	$self instvar var_ path_
	set path_ $w
	set var_ [TclObject getid]
	eval checkbutton $w -variable $var_ $args
}
CheckButton instproc get-val {} {
	$self instvar var_
	global $var_
	return [set $var_]
}
CheckButton instproc set-val v {
	$self instvar var_
	global $var_
	set $var_ $v
}
CheckButton instproc unknown args {
	$self instvar path_
	eval $path_ $args
}
Class Timer
Class Timer/Periodic -superclass Timer 
Class Timer/Adaptive -superclass Timer
Class Timer/Adaptive/ConstBW -superclass Timer/Adaptive
Timer instproc destroy {} {
	$self cancel
	$self next
}
Timer instproc init {} {
	$self next 
	$self randomize no
	$self set randwt_ 1.0
}
Timer instproc randomize args {
	set yesno [lindex $args 0]
	set argc [llength $args]
	if { $argc == 2 } {
		set wt [lindex $args 1]
		$self set randwt_ $wt
	}
	$self set randomize_ $yesno
}
Timer instproc sched { t } {
	$self msched $t
}
Timer instproc msched { t } {
	$self instvar id_ manager_ callback_ randomize_ randwt_
	if [info exists id_] {
		puts stderr "warning: $self ($class): overlapping timers."
	}
	if { $randomize_ ==  "yes" } {
		set r [expr [random]/double(0x7fffffff)-0.5]
		set t [expr $t+$t*$r*$randwt_]
	}
	set t [expr int($t+0.5)]
	set id_ [after $t "$self local_timeout"]
}
Timer instproc local_timeout {} {
	$self instvar id_
	if ![info exists id_] {
		puts stderr "warning: $self ($class) no timer id_"
	} else {
		unset id_
	}
	$self timeout
}
Timer instproc cancel {} {
	$self instvar id_
	if [info exists id_] {
		after cancel $id_
		unset id_
	}
}
Timer/Periodic instproc start { period } {
	$self instvar period_
	$self set period_ $period
	$self msched $period_
}
Timer/Periodic instproc local_timeout {} {
	$self instvar period_
	$self next
	$self msched $period_
}
Timer/Periodic instproc stop {} {
	$self cancel
}
Timer/Adaptive instproc schedule_timer {} {
	$self instvar interval_
	set interval_ [$self adapt]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive/ConstBW instproc init { bw } {
	$self next
	$self instvar size_gain_ avgsize_ nsrcs_ bw_ thresh_ interval_
	set size_gain_ 0.125
	set avgsize_ 28
	set nsrcs_ 0
	set bw_ $bw
	set thresh_ 500
	set interval_ $thresh_
}
Timer/Adaptive/ConstBW instproc sample-size { cc } {
	$self instvar avgsize_ size_gain_
	set avgsize_ [expr $avgsize_ + $size_gain_ * ($cc + 28 - $avgsize_)]
}
Timer/Adaptive/ConstBW instproc adapt {} {
	$self instvar avgsize_ bw_ nsrcs_ thresh_
	set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
	if { $t < $thresh_ } {
		return $thresh_
	} else {
		return $t
	}
}
Class QuitWindow -superclass TopLevelWindow
Class InfoWindow -superclass {QuitWindow Timer}
Class ScubaInfoWindow -superclass {QuitWindow Timer Observer}
Class StatWindow -superclass {QuitWindow Timer}
Class RtpStatWindow -superclass StatWindow
Class GlobalStatWindow -superclass StatWindow
QuitWindow instproc init { path quitMethod } {
	$self next $path
	$self instvar quitMethod_
	set quitMethod_ $quitMethod
}
QuitWindow instproc quit {} {
	$self instvar quitMethod_
	eval $quitMethod_
}
proc get-playout src {
	set d [$src handler]
	if { "$d" != "" } {
		return [expr [$d playout] >> 3]
	}
	return 0
}
StatWindow instproc create-row { r name width cmd relief } {
	set f [$self get_option smallfont]
	button $r.name -text $name -font $f -anchor w -width $width \
		-command $cmd -pady 2 -padx 2 -borderwidth 2 \
		-highlightthickness 0 -relief raised
	label $r.smooth -font $f -anchor e -width 8 \
		-relief $relief -borderwidth 1 -pady 1
	label $r.diff -font $f -anchor e -width 8 \
		-relief $relief -borderwidth 1 -pady 1
	label $r.total -font $f -anchor e -width 8 \
		-relief ridge -borderwidth 1 -pady 1
	pack $r.name -anchor w -fill x -side left -pady 1 -padx 4
	pack $r.smooth $r.diff $r.total \
		-expand 1 -fill both -anchor e -side left
}
StatWindow instproc create-panel { w stats } {
	set f [$self get_option smallfont]
	set p $w.f
	frame $p
	set top [winfo toplevel $w]
	set gain [$self get_option statsFilter]
	set r $p.legend
	frame $r
	label $r.smooth -font $f -anchor c -width 8 -text EWA \
		-relief ridge -borderwidth 1
	label $r.diff -font $f -anchor c -width 8 -text Delta \
		-relief ridge -borderwidth 1
	label $r.total -font $f -anchor c -width 8 -text Total \
		-relief ridge -borderwidth 1
	pack $r.total $r.diff $r.smooth -side right
	pack $r -anchor e
	$self instvar statCache_
	set statCache_ $stats
	set n [llength $stats]
	$self instvar width_
	set width_ 10
	set i 0
	while { $i < $n } {
		set v [string len [lindex $stats $i]]
		if { $v > $width_ } {
			set width_ $v
		}
		incr i 2
	}
	$self instvar rv_diff_ rv_smooth_
	set i 0
	while { $i < $n } {
		set name [lindex $stats $i]
		incr i
		set value [lindex $stats $i]
		incr i
		set id [string tolower $name]
		set r $p.$id
		frame $r 
		set cmd "$self create-plot-window $name"
		$self create-row $r $name $width_ $cmd ridge
		pack $r -pady 0
		set rv_diff_($id) $value
		set rv_smooth_($id) $value
		rate_variable rv_diff_($id) 1.0 "%.1f"
		rate_variable rv_smooth_($id) $gain "%.1f"
	}
	$self instvar statWindow_
	set statWindow_ $p
	pack $w.f -anchor c
}
StatWindow instproc stats-changed { s1 s2 } {
	set n [llength $s1]
	if { $n != [llength $s2] } {
		return 1
	}
	set i 0
	while { $i < $n } {
		if { [lindex $s1 $i] != [lindex $s2 $i] } {
			return 1
		}
		incr i 2
	}
	return 0
}
StatWindow instproc stat-update {} {
	$self instvar rv_diff_ rv_smooth_ statCache_
	$self instvar method_ statWindow_
	set stats [eval $method_]
	if [$self stats-changed $stats $statCache_] {
		unset_rvs $w
		pack forget $w.frame
		destroy $w.frame
		frame $w.frame -borderwidth 2 -relief groove
		$self create-panel $w.frame $stats
		pack $w.frame -after $w.title -expand 1 -fill x -anchor center
	}
	set p $statWindow_
	set i 0
	set n [llength $stats]
	while { $i < $n } {
		set id [string tolower [lindex $stats $i]]
		incr i
		set cntr [lindex $stats $i]
		incr i
		set rv_diff_($id) $cntr
		set rv_smooth_($id) $cntr
		$p.$id.total configure -text $cntr
		$p.$id.diff configure -text $rv_diff_($id)
		$p.$id.smooth configure -text $rv_smooth_($id)
	}
	$self instvar src_
	if [winfo exists $p.playout.total] {
		$p.playout.total configure -text [get-playout $src_]ms
	}
}
StatWindow instproc unset_rvs {} {
	$self instvar statCache_ rv_diff_ rv_smooth_
	if [info exists statCache_] {
		set n [llength $statCache_]
		for { set i 0 } { $i < $n } { incr i 2 } {
			set id [string tolower [lindex $statCache_ $i]]
			unset rv_diff_($id) rv_smooth_($id)
		}
		unset statCache_
	}
}
proc stat_destroy w {
	unset_rvs $w
	destroy $w
	global stat_method win_src
	unset stat_method($w) win_src($w)
}
InfoWindow instproc info_destroy { w src } {
	global info_x info_y
	set info_x($src) [winfo rootx $w]
	set info_y($src) [winfo rooty $w]
	destroy $w
}
ScubaInfoWindow instproc info_destroy { w src } {
	global info_x info_y
	set info_x($src) [winfo rootx $w]
	set info_y($src) [winfo rooty $w]
	destroy $w
}
StatWindow instproc timeout {} {
	$self stat-update	
	$self sched 1000
}
StatWindow instproc init { w windowName titleText method quitCmd } {
	$self next $w $quitCmd
	$self create-window $w $windowName
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.main -borderwidth 0 -anchor w -text $titleText
	label $w.title.name -borderwidth 0 -anchor w
	frame $w.frame -borderwidth 2 -relief groove
	$self instvar method_
	set method_ $method
	$self create-panel $w.frame [eval $method]
	pack $w.title.name -anchor w
	pack $w.title.main -anchor w
	pack $w.title -fill x
	pack $w.frame -expand 1 -fill x -anchor center
	wm geometry $w +[winfo pointerx .]+[winfo pointery .]
	wm deiconify $w
	$self sched 1000
	button $w.dismiss -relief raised -font $f \
		-command "$self quit" -text Dismiss
	pack $w.dismiss -anchor c -pady 4
}
StatWindow instproc destroy {} {
	$self instvar plot_win_
	foreach w [array names plot_win_] {
		$self delete-plot-window $w
	}
	$self next
}
RtpStatWindow instproc init { w src titleText method quitCmd } {
	$self next $w [$src getid] $titleText $method $quitCmd
	$w.title.name configure -textvariable src_nickname($src)
	$self instvar src_
	set src_ $src
	$self instvar statWindow_ width_
	set r $statWindow_.playout
	frame $r
	set cmd "$self create-plot-window Playout"
	$self create-row $r Playout $width_ $cmd flat
	pack $r -pady 0
}
RtpStatWindow instproc stat-get id {
	$self instvar method_
	set stats [eval $method_]
	set k [lsearch -exact $stats $id]
	return [lindex $stats [expr $k + 1]]
}
RtpStatWindow instproc create-plot-window name {
	$self instvar plot_win_ src_
	set id [string tolower $name]
	set w .plot$src_$id
	if [info exists plot_win_($w)] {
		$self delete-plot-window $w
	} else {
		set plot_win_($w) [new PlotWindow $w $src_ $name \
					"$self stat-get $name" \
					"$self delete-plot-window $w"]
	}
}
RtpStatWindow instproc delete-plot-window w {
	$self instvar plot_win_
	delete $plot_win_($w)
	unset plot_win_($w)
}
Class GlobalWindow -superclass StatWindow
GlobalWindow instproc init { w titleText method quitCmd } {
	$self next $w "RTP Stats" $titleText $method $quitCmd
}
proc has_src w {
	global win_src
	if [string compare $win_src($w) GLOBAL] {
		return 1
	} else {
		return 0
	}
}
Class PlotWindow -superclass {QuitWindow Timer}
PlotWindow instproc timeout {} {
	$self instvar rv_plot_ generator_ path_
	set rv_plot_ [eval $generator_]
	$path_.frame.sc set $rv_plot_
	$self sched 1000
}
proc relabel_stripchart {w min max perDiv} {
	$w configure -text " range $min to $max,  $perDiv/div"
}
PlotWindow instproc init { w src name generator quitCmd } {
	$self next $w $quitCmd
	$self create-window $w "plot window"
	catch "wm resizable $w true false"
	$self instvar generator_
	set generator_ $generator
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.main -borderwidth 0 -anchor w -text $name
	frame $w.frame -borderwidth 2 -relief groove 
	stripchart $w.frame.sc -max 200 -min 1 -stripwidth 1 -width 1 \
		-autoscale 2 -rescale_command "relabel_stripchart $w.bf.lab" \
		-relief groove -striprelief flat -tickcolor gray95 -hticks 30
	pack $w.frame.sc -expand 1 -fill both
	frame $w.brace -width 250
	pack $w.brace
	if [string match Source/* [$src info class]] {
		label $w.title.name -borderwidth 0 -anchor w \
			-textvariable src_nickname($src)
		pack $w.title.name -anchor w
	}
	pack $w.title.main -anchor w
	pack $w.title -fill x
	pack $w.frame -expand 1 -fill both -anchor center
	$self instvar rv_plot_
	if { "$name" != "Playout" } {
		rate_variable rv_plot_ 1.0 "%.1f"
	}
	wm geometry $w +[winfo pointerx .]+[winfo pointery .]
	wm deiconify $w
	$self sched 1000
	frame $w.bf
	label $w.bf.lab -borderwidth 0 -font $f -anchor w -text "No data"
	pack $w.bf.lab -side left -expand 1 -fill x
	button $w.bf.dismiss -relief raised -font $f -anchor e \
		-command "$self quit" -text Dismiss
	pack $w.bf.dismiss -side right -pady 4 -padx 4
	pack $w.bf -expand 1 -fill x
}
InfoWindow instproc init { w src parent } {
	$self instvar src_
	set src_ $src
	$self next $w "$parent delete-info-window"
	$self create-window $w [$src getid]
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.name -borderwidth 0 -font $f -anchor w \
		-textvariable src_nickname($src)
	label $w.title.info -borderwidth 0 -font $f -anchor w \
		-text [$src addr]
	label $w.title.timeData -borderwidth 0 -font $f -anchor w
	label $w.title.timeCtrl -borderwidth 0 -font $f -anchor w
	frame $w.frame -borderwidth 2 -relief groove
	pack $w.title.name $w.title.info -fill x
        foreach sdes [$self get_option sdesList] {
		label $w.title.$sdes -borderwidth 0 -font $f -anchor w
		pack $w.title.$sdes -fill x
	}
	label $w.title.srcid -borderwidth 0 -font $f -anchor w
	pack $w.title.srcid -fill x
	pack $w.title.timeData $w.title.timeCtrl -fill x
	pack $w.title -fill x
	set p $w.bot
	frame $p
	set m $p.mb.menu
	menubutton $p.mb -text Stats... -menu $m -relief raised -width 8 \
		-font $f
	menu $m
	$m add command -label RTP -command "$parent create-rtp-window" -font $f
	$m add command -label Decoder \
		-command "$parent create-decoder-window $src" -font $f
	button $p.dismiss -relief raised -font $f \
		-command "$self quit" -text Dismiss
	pack $p.mb -side left -padx 8
	pack $p.dismiss -side right -padx 8
	pack $p -anchor c -pady 4 -fill x
	$self info_update
	global info_x info_y
	if [info exists info_x($src) ] {
		set x $info_x($src)
		set y $info_y($src)
	} else {
		set x [winfo pointerx .]
		set y [winfo pointery .]
	}
	update idletasks
	if ![winfo exists $w] { return }
	set right [expr [winfo screenwidth .] - [winfo reqwidth $w] - 5]
	if { $x > $right } {
		set x $right
	}
	set bot [expr [winfo screenheight .] - [winfo reqheight $w] - 5]
	if { $y > $bot } {
		set y $bot
	}
	wm geometry $w +$x+$y
	wm deiconify $w
	$self sched 3000
}
InfoWindow instproc info_update {} {
	$self instvar path_ src_
	set w $path_
	set src $src_
	set decoder [$src handler]
	set fmt [$src format_name]
	if { $fmt == "" } { set fmt "?" }
	$w.title.info configure -text [info_text $src]
	set t [$src lastdata]
	if { $t == "" } { set t "never" }
	$w.title.timeData configure -text "last data $t"
	set t [$src lastctrl]
	if { $t == "" } { set t "never" }
	$w.title.timeCtrl configure -text "last control $t"
	foreach sdes [$self get_option sdesList] {
		$w.title.$sdes configure -text "$sdes: [$src sdes $sdes]"
	}
	$w.title.srcid configure -text "srcid: [$src srcid]/[$src addr]"
	if { [$src srcid] != [$src ssrc] } {
		if ![winfo exists $w.title.mixer] {
			label $w.title.mixer -borderwidth 0 \
				-font [$self get_option smallfont] -anchor w
			pack $w.title.mixer -after $w.title.srcid -fill x
		}
		$w.title.mixer configure -text "mixer: [$src ssrc]/[$src addr]"
	} elseif [winfo exists $w.title.mixer] {
		pack forget $w.title.mixer
		destroy $w.title.mixer
	}
	set note [$src sdes note]
	if { $note != "" } {
		set bg [$self get_option infoHighlightColor]
	} else {
		set bg [$self get_option background]
	}
	$w.title.note configure -background $bg
}
InfoWindow instproc timeout {} {
	$self info_update
	$self sched 3000
}
ScubaInfoWindow instproc timeout {} {
	$self info_update
	$self sched 1000
}
ScubaInfoWindow instproc init { w src parent scuba_sess } {
	$self instvar src_ parent_ scuba_sess_
	set src_ $src
	set scuba_sess_ $scuba_sess
	$self next $w "$parent delete-scuba-window"
	$self create-window $w [$src getid]
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.name -borderwidth 0 -anchor w \
		-textvariable src_nickname($src)
	label $w.title.info -borderwidth 0 -anchor w -text "SCUBA Votes"
	frame $w.frame -borderwidth 2 -relief groove
	pack $w.title.name $w.title.info -fill x
	pack $w.title -fill x
	frame $w.frame.total -relief ridge -borderwidth 1 
	label $w.frame.total.t -text "Aggregate Vote:" -font $f 
	label $w.frame.total.val -text 0 -font $f 
	pack $w.frame.total.t $w.frame.total.val -side left -anchor w
	pack $w.frame.total -fill x -expand 1 -side bottom
	pack $w.frame -fill both -expand 1 -side top
	set p $w.bot
	frame $p
	button $p.dismiss -relief raised -font $f \
		-command "$self quit" -text Dismiss
	pack $p.dismiss 
	pack $p -anchor c -pady 4 -fill x
	global scubainfo_x scubainfo_y
	if [info exists scubainfo_x($src) ] {
		set x $scubainfo_x($src)
		set y $scubainfo_y($src)
	} else {
		set x [winfo pointerx .]
		set y [winfo pointery .]
	}
	update idletasks
	if ![winfo exists $w] { return }
	set right [expr [winfo screenwidth .] - [winfo reqwidth $w] - 5]
	if { $x > $right } {
		set x $right
	}
	set bot [expr [winfo screenheight .] - [winfo reqheight $w] - 5]
	if { $y > $bot } {
		set y $bot
	}
	wm geometry $w +$x+$y
	wm deiconify $w
}
ScubaInfoWindow instproc info_update {} {
	$self instvar path_ src_ scuba_sess_
	set w $path_.frame
	set sm [$scuba_sess_ source-manager]
	if { [$sm info vars local_] == "" } {
		return
	}
	set localsrc [$sm set local_]
	set total 0
	set al [$sm active_list]
	foreach src $al {
		set srcid [$src srcid]
		set voters [$scuba_sess_ array names scoretab_ *:$srcid]
		set subtotal 0
		foreach v $voters {
			set subtotal \
			    [expr $subtotal+[$scuba_sess_ set scoretab_($v)]]
		}
		set tot($src) $subtotal
		set total [expr $total+$subtotal]
	}
	if { $total > 0 } {
		set avg [expr $tot($src_)/$total]
	} else {
		set avg 0
	}
	set srcid [$src_ srcid]
	set voters [$scuba_sess_ array names scoretab_ *:$srcid]
	set sm [$scuba_sess_ source-manager]
	foreach s [$sm set sources_] {
		if { $s == $src_ } {
			continue
		}
		$w.s$s.v configure -text "= 0.0"
	}
	foreach v $voters {
		set sender [lindex [split $v :] 0]
		$w.s$sender.v configure \
				-text "= [$scuba_sess_ set scoretab_($v)]"
	}
	$w.total.val configure -text $avg
}
ScubaInfoWindow instproc register { src } {
	$self instvar path_ scuba_sess_ src_
	if { $src == $src_ } {
		return
	}
	set f [$self get_option smallfont]
	set w $path_.frame
	global src_nickname
	frame $w.s$src
	set sm [$scuba_sess_ source-manager]
	if { [$sm set local_] == $src } {
		label $w.s$src.t -text "Local Receiver" -font $f
	} else {
		label $w.s$src.t -textvariable src_nickname($src) -font $f
	}
	label $w.s$src.v -text  "= 0.0" -font $f
	pack $w.s$src.t -side left  -anchor w
	pack $w.s$src.v -side right -anchor e
	pack $w.s$src -fill both -expand 1
}
ScubaInfoWindow instproc unregister { src } {
	$self instvar path_ src_
	if { $src == $src_ } {
		return
	}
	set w $path_.frame
	destroy $w.s$src
}
ScubaInfoWindow instproc deactivate { src } {
	$self instvar src_ path_
	if { $src == $src_ } {
		destroy $path_
	}
}
proc create_mtrace_window {src dir} {
	set w .mtrace$src
	if ![winfo exists $w] {
		create_toplevel $w "[$src getid] mtrace"
		set f [$self get_option smallfont]
		frame $w.t
		scrollbar $w.t.yscroll -command "$w.t.text yview" -relief sunken
		scrollbar $w.t.xscroll -command "$w.t.text xview" -relief sunken \
			-orient horiz
		text $w.t.text -height 24 -width 80 -setgrid true -wrap none \
			-font fixed -relief sunken -borderwidth 2 \
			-xscrollcommand "$w.t.xscroll set" \
			-yscrollcommand "$w.t.yscroll set"
		pack $w.t.yscroll -side right -fill y
		pack $w.t.xscroll -side bottom -fill x
		pack $w.t.text -side left -padx 0 -pady 0 -fill both -expand yes
		set p $w.b
		frame $p
		button $p.dismiss -relief raised -font $f \
			-command "destroy $w" -text Dismiss
		pack $p.dismiss -side right -padx 8
		pack $w.t -side top -fill both -expand yes
		pack $p -side bottom -pady 2 -fill x
		wm geometry $w +[winfo pointerx .]+[winfo pointery .]
		wm deiconify $w
		update idletasks
		if ![winfo exists $w] { return }
	} else {
		$w.t.text yview end
	}
	global V
	if {$dir=="to"} {
		set net $V(data-net-0)
		set cmd "|mtrace [$net interface] [$net addr] [$src addr]"
	} else {
		set cmd "|mtrace [$src addr] [$net addr]"
	}
	if [catch "open {$cmd} r" fd] {
		$w.t.text insert end "mtrace error: $fd"
		return
	}
	fconfigure $fd -blocking 0
	fileevent $fd readable "read_mtrace $fd $w"
}
proc read_mtrace {fd w} {
	if [winfo exists $w] {
		$w.t.text insert end [read $fd 1]
		$w.t.text yview end
		if [eof $fd] {
			fileevent $fd readable {}
			catch "close $fd"
		}
	} else {
		fileevent $fd readable {}
		catch "close $fd"
	}
}
proc destroy_rtp_stats src {
	if [winfo exists .rtp$src] {
		stat_destroy .rtp$src
	}
}
Class ControlMenu -superclass TopLevelWindow -configuration {
	recvOnly 0
}
ControlMenu proc fork_histtolut { } {
	$self tkvar ditherStyle_
	$self instvar ui_ optionsMenu_
	if { $ditherStyle_ == "gray" } {
		new ErrorWindow "cannot optimize grayscale rendering"
		return
	}
	set ch [[$ui_ set colorModel_] create-hist]
	set active 0
	foreach src [$ui_ active-sources] {
		set d [$src handler]
		if { ![$src mute] && $d != "" } {
			$d histogram $ch
			set active 1
		}
	}
	if !$active {
		new ErrorWindow "no active, unmuted sources"
		delete $ch
		return
	}
	set pid [pid]
	set outfile /tmp/vicLUT.$pid
	set infile /tmp/vicHIST.$pid
	if { [$ch dump $infile] < 0 } {
		new ErrorWindow "couldn't create $infile"
		delete $ch
		return
	}
	delete $ch
	set eflag ""
	if { $ditherStyle_ == "ed" } {
		set eflag "-e"
	}
	if [catch \
	  "open \"|histtolut $eflag -n 170 -o $outfile $infile\"" pipe] {
		new ErrorWindow "histtolut not installed in your path"
		return
	}
	fileevent $pipe readable "$self finish_histtolut $pipe $infile $outfile"
	$optionsMenu_ entryconfigure "Optimize Colormap" \
		-state disabled
	.menu configure -cursor watch
}
ControlMenu proc finish_histtolut { pipe infile outfile } {
	.menu configure -cursor ""
	$self instvar optionsMenu_ ui_
	$optionsMenu_ entryconfigure "Optimize Colormap" -state normal
	set cm [$ui_ set colorModel_]
	$cm free-colors
	$cm lut $outfile
	if ![$cm alloc-colors] {
		$ui_ revert_to_gray
	}
	foreach src [$ui_ active-sources] {
		set d [$src handler]
		if { $d != "" } {
			$d redraw
		}
	}
	fileevent $pipe readable ""
	close $pipe
}
ControlMenu instproc have_transmit_permission {} {
	$self instvar vpipe_
	if { [$vpipe_ input_devices] != "" } {
		return ![$self yesno recvOnly]
	}
	return 0
}
ControlMenu instproc init { app mainUI agent vpipe } {
	$self next .menu
	$self instvar ui_ videoAgent_ qval_ lastFmt_ path_ app_ vpipe_
	set ui_ $mainUI
	set app_ $app
	set videoAgent_ $agent
	set vpipe_ $vpipe
	set lastFmt_ ""
	set qval_(h261) 68
	set qval_(nv) 80
	set qval_(nvdct) 80
	set qval_(pvh) 60
	set qval_(ldct) 68
	set qval_(jpeg) 29
	$self tkvar useHardwareDecode_ ditherStyle_
	set ditherStyle_ [$ui_ set dither_]
	set useHardwareDecode_ [$self yesno useHardwareDecode]
	$self tkvar muteNewSources
	set muteNewSources [$self yesno muteNewSources]
}
ControlMenu instproc build w {
	$self create-window $w "vic menu"
	wm withdraw $w
	catch "wm resizable $w false false"
	$self instvar ui_
	frame $w.session
	frame $w.cb
	$self build.xmit $w.cb
	if { [$ui_ use_scuba] && [$self get_option megaSession] != ""} {
		frame $w.scuba
		$self build.scuba $w.scuba
	}
	frame $w.encoder
	$self build.encoder $w.encoder
	frame $w.decoder
	$self build.decoder $w.decoder
	$self instvar videoAgent_
	$self build.session $w.session \
		[$videoAgent_ session-addr] \
		[$videoAgent_ session-sport]:[$videoAgent_ session-rport] \
		[$videoAgent_ get_local_srcid] \
		[$videoAgent_ session-ttl] \
		[$videoAgent_ local-name]
	button $w.dismiss -text Dismiss -borderwidth 2 -width 8 \
		-relief raised -anchor c \
		-command "$self toggle" -font [$self get_option medfont]
	pack $w.cb -padx 6 -fill x -expand 1
	if { [$ui_ use_scuba] && [$self get_option megaSession] != "" } {
		pack $w.scuba -padx 6 -fill x -expand 1
	}
	pack $w.encoder $w.decoder $w.session -padx 6 -fill x -expand 1
	pack $w.dismiss -anchor c -pady 4 
	if [$self have_transmit_permission] {
		$self selectInitialDevice
	}
}
ControlMenu instproc selectInitialDevice {} {
	$self instvar vpipe_ device_
	set L [$vpipe_ input_devices]
	set d [$self get_option defaultDevice]
	foreach v $L {
		if { [$v nickname] == "$d" && \
			[$v attributes] != "disabled" } {
			set device_ $v
			$self select_device $v
			return
		}
	}
	foreach v $L {
		if { "[$v attributes]" != "disabled" &&
			"[$v nickname]" != "still" } {
			set device_ $v
			$self select_device $v
			return
                }
	}
}
ControlMenu instproc create_global_window {} {
	$self instvar src_ global_win_
	if [info exists global_win_] {
		$self delete_global_window
	} else {
		set global_win_ [new GlobalWindow .globalStats "Session Stats" "$self stats" "$self delete_global_window"]
	}
}
ControlMenu instproc delete_global_window {} {
	$self instvar global_win_
	delete $global_win_
	unset global_win_
}
ControlMenu instproc stats {} {
	return [[$self set videoAgent_] stats]
}
ControlMenu instproc new_hostspec {} {
	$self instvar videoAgent_ addrspec_ namespec_
	if ![info exists addrspec_] {
		return
	}
	set dst [$videoAgent_ session-addr]
	set port [$videoAgent_ session-sport]:[$videoAgent_ session-rport]
	set ttl [$videoAgent_ session-ttl]
	set srcid [$videoAgent_ get_local_srcid]
	$addrspec_ configure -text \
			"Dest: $dst   Port: $port  ID: $srcid  TTL: $ttl"
	set name [$videoAgent_ local-name]
	$namespec_.entry delete 0 end
	$namespec_.entry insert 0 $name
	$self instvar transmitButton_
	$transmitButton_ configure -state normal
}
ControlMenu instproc build.session { w dst port srcid ttl name } {
	set f [$self get_option smallfont]	
	label $w.title -text Session
	pack $w.title -fill x
	frame $w.nb -relief sunken -borderwidth 2
	pack $w.nb -fill x
	frame $w.nb.frame
	pack append $w.nb \
		$w.nb.frame { top fillx }
	$self instvar addrspec_ namespec_
	label $w.nb.frame.info -font $f -anchor w \
		-text "Dest: $dst   Port: $port  ID: $srcid  TTL: $ttl"
	set addrspec_ $w.nb.frame.info
	frame $w.nb.frame.name
	label $w.nb.frame.name.label -text "Name: " -font $f -anchor e -width 6
	new TextEntry "$self update_name" $w.nb.frame.name.entry $name
	pack $w.nb.frame.name.label -side left
	pack $w.nb.frame.name.entry -side left -expand 1 -fill x -pady 2
	set namespec_ $w.nb.frame.name
	frame $w.nb.frame.msg
	label $w.nb.frame.msg.label -text "Note: " -font $f -anchor e -width 6
	new TextEntry "$self update_note" $w.nb.frame.msg.entry ""
	pack $w.nb.frame.msg.label -side left
	pack $w.nb.frame.msg.entry -side left -expand 1 -fill x -pady 2
	$self instvar videoAgent_
	new KeyEditor $w.nb.frame $videoAgent_
	frame $w.nb.frame.b
	button $w.nb.frame.b.stats -text "Global Stats" -borderwidth 2 \
		-anchor c -font $f -command create_global_window
	$w.nb.frame.b.stats configure -state disabled
	$self instvar ui_
	button $w.nb.frame.b.members -text Members -borderwidth 2 \
		-anchor c -font $f -command "$ui_ toggle"
	pack $w.nb.frame.b.stats $w.nb.frame.b.members \
		-side left -padx 4 -pady 2 -anchor c
	pack $w.nb.frame.info $w.nb.frame.name $w.nb.frame.msg \
		$w.nb.frame.key \
		-fill x -padx 2 -expand 1
	pack $w.nb.frame.b -pady 2 -anchor c
}
ControlMenu instproc setFillRate {} {
	$self instvar vpipe_
	global sendingSlides 
	$self tkvar transmitButtonState_
	if $transmitButtonState_ {
		if $sendingSlides {
			$vpipe_ fillrate 16
		} else {
			$vpipe_ fillrate 2
		}
	}
}
ControlMenu instproc update_name name {
	if { $name != ""} {
		$self instvar videoAgent_
		$videoAgent_ set_local_sdes name $name
		return 0
	}
	return -1
}
ControlMenu instproc update_note note {
	$self instvar videoAgent_
	$videoAgent_ set_local_sdes note $note
	return 0
}
ControlMenu instproc transmit { } {
	$self instvar vpipe_ device_
	$self tkvar transmitButtonState_
	global  videoFormat V useJPEGforH261
	if $transmitButtonState_ {
		$vpipe_ select $device_ $videoFormat
		set err [$vpipe_ start]
		if { $err != "" } {
			set transmitButtonState_ 0
			new ErrorWindow $err
			$self select_device $device_
			return
		}
		$self tx-init
	} else {
		$vpipe_ stop
	}
}
ControlMenu instproc release {} {
	[$self set vpipe_] release_device
}
ControlMenu instproc build.buttons w {
	set f [$self get_option smallfont]
	$self instvar transmitButton_
	$self tkvar transmitButtonState_
	set transmitButton_ $w.send
	set transmitButtonState_ 0
	checkbutton $w.send -text "Transmit" \
		-relief raised -command "$self transmit" \
		-anchor w -variable [$self tkvarname transmitButtonState_] \
		-font $f \
		-state disabled -highlightthickness 0
	button $w.release -text "Release" \
		-relief raised -command "$self release" \
		-font $f -highlightthickness 0
	pack $w.send $w.release -fill both
}
ControlMenu instproc invoke_transmit {} {
	$self instvar transmitButton_
	$transmitButton_ invoke
}
ControlMenu instproc set_sessionbw { w value } {
	$self instvar videoAgent_
	$videoAgent_ sessionbw $value
	$w configure -text [format_bps $value]
	update idletasks
}
ControlMenu instproc set_bps { w value } {
	$self instvar vpipe_ videoAgent_
	$vpipe_ set_bps $value
	$videoAgent_ local_bandwidth $value    
	$w configure -text [format_bps $value]
	update idletasks
}
ControlMenu instproc set_fps { w value } {
	$self instvar vpipe_
	$vpipe_ set_fps $value
	$w configure -text "$value f/s"
	update idletasks
}
ControlMenu instproc build.sliders w {
	set f [$self get_option smallfont]
	global V
	global btext ftext
	$self instvar videoAgent_ app_
	set key [$videoAgent_ set session_]
	set ftext($key) "0.0 f/s"
	set btext($key) "0.0 kb/s"
	$self instvar ui_
	if [$ui_ use_scuba] {
		set rctext "Rate Control (SCUBA)"
		set maxbw [$app_ get_option maxSessionBW]
	} else {
		set rctext "Rate Control"
		set maxbw [$app_ get_option maxbw]
	}
	frame $w.info
	label $w.info.label -text $rctext -font $f
	label $w.info.fps -textvariable ftext($key) -width 6 \
		-font $f -pady 0 -borderwidth 0
	label $w.info.bps -textvariable btext($key) -width 8 \
		-font $f -pady 0 -borderwidth 0
	pack $w.info.label -side left
	pack $w.info.bps $w.info.fps -side right
	frame $w.bps
	scale $w.bps.scale -orient horizontal -font $f \
		-showvalue 0 -from 1 -to $maxbw \
		-command "$self set_bps $w.bps.value" -width 12 \
		-relief groove
	label $w.bps.value -font $f -width 8 -anchor w
	frame $w.fps
	scale $w.fps.scale -font $f -orient horizontal \
		-showvalue 0 -from 1 -to 30 \
		-command "$self set_fps $w.fps.value" -width 12 \
		-relief groove
	label $w.fps.value -font $f -width 8 -anchor w
	pack $w.info -fill x
	pack $w.bps $w.fps -fill x
	pack $w.bps.scale -side left -fill x -expand 1
	pack $w.bps.value -side left -anchor w 
	pack $w.fps.scale -fill x -side left -expand 1
	pack $w.fps.value -side left -anchor w
	if [$ui_ use_scuba] {
		set s [$videoAgent_ set session_]
		$w.bps.scale set [$s data-bandwidth]
		$w.fps.scale set 30
	} else {
		$w.bps.scale set [$app_ get_option bandwidth]
		$w.fps.scale set [$app_ get_option framerate]
		$w.bps.scale configure -resolution 1000
		$w.bps.scale configure -from 1000
	}
	global fps_slider bps_slider
	set fps_slider $w.fps.scale
	set bps_slider $w.bps.scale
}
ControlMenu instproc insert_grabber_panel devname {
	set k [string first - $devname]
	if { $k >= 0 } {
		incr k -1
		set devname [string range $devname 0 $k]
	}
	set k [string first " " $devname]
	if { $k >= 0 } {
		incr k -1
		set devname [string range $devname 0 $k]
	}
	set devname [string tolower $devname]
	set w .menu.$devname
	global grabberPanel
	if [info exists grabberPanel] {
		if { "$grabberPanel" == "$w" } {
			return
		}
		pack forget $grabberPanel
		unset grabberPanel
	}
	if { [$class info instprocs build.$devname] != "" } {
		if ![winfo exists $w] {
			frame $w
			label $w.label -text "Grabber ($devname)"
			frame $w.frame -relief sunken -borderwidth 0
			$self build.$devname $w.frame
			pack $w.label $w.frame -side top -fill x -expand 1
		}
		pack $w -before .menu.encoder -padx 6 -fill x
		set grabberPanel $w
	}
}
ControlMenu instproc select_device device {
	global formatButtons \
		videoFormat defaultFormat lastDevice defaultPort inputPort
	$self instvar videoAgent_ vpipe_ sizeButtons_ portButton_ \
		transmitButton_ 
	$self tkvar transmitButtonState_ 
	set wasTransmitting $transmitButtonState_
	if [info exists lastDevice] {
		set defaultFormat($lastDevice) $videoFormat
		set defaultPort($lastDevice) $inputPort
	}
	set lastDevice $device
	$vpipe_ release_device
	set fmtList [$vpipe_ available_formats $device]
	foreach b $formatButtons {
		set fmt [lindex [$b configure -value] 4]
		if { [inList $fmt $fmtList] } {
			$b configure -state normal
		} else {
			$b configure -state disabled
		}
	}
	if [$videoAgent_ have_network] {
		$transmitButton_ configure -state normal
	}
	if [$device supports size small] {
		$sizeButtons_.b0 configure -state normal
	} else {
		$sizeButtons_.b0 configure -state disabled
	}
	if [$device supports size large] {
		$sizeButtons_.b2 configure -state normal
	} else {
		$sizeButtons_.b2 configure -state disabled
	}
	if [$device supports port *] {
		$portButton_ configure -state normal
		$self attach_ports $device
	} else {
		$portButton_ configure -state disabled
	}
	$self insert_grabber_panel [$device nickname]
	set videoFormat $defaultFormat($device)
	$self select_format $videoFormat
	if $wasTransmitting {
		$vpipe_ start
	}
}
ControlMenu instproc build.device w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -menu $m -text Device... \
		-relief raised -width 10 -font $f
	menu $m
	global defaultFormat videoFormat
	set videoFormat [$self get_option defaultFormat]
	if { $videoFormat == "h.261" } {
		set videoFormat h261
	}
	if ![$self have_transmit_permission] {
		$w configure -state disabled
		return
	}
	$self instvar vpipe_
	foreach d [$vpipe_ input_devices] {
		if { [$d nickname] == "still" && ![$self yesno stillGrabber] } {
			set defaultFormat($d) $videoFormat
			continue
		}
		$m add radiobutton -label [$d nickname] \
			-command "$self select_device $d" \
			-value $d -variable device_ -font $f
		if { "[$d attributes]" == "disabled" } {
			$m entryconfigure [$d nickname] -state disabled
		}
		set fmtList [$vpipe_ available_formats $d]
		if [inList $videoFormat $fmtList] {
			set defaultFormat($d) $videoFormat
		} else {
			set defaultFormat($d) [lindex $fmtList 0]
		}
	}
}
ControlMenu instproc format_col { w n0 { n1 {} } {n2 {} }} {
	set f [$self get_option smallfont]
	frame $w
	global formatButtons
	radiobutton $w.b0 -text $n0 -relief flat -font $f -anchor w \
		-variable videoFormat -value $n0 -padx 0 -pady 0 \
		-command "$self select_format $n0"
	pack $w.b0
	lappend formatButtons $w.b0
	if { $n1 != "" } {
		radiobutton $w.b1 -text $n1 -relief flat -font $f -anchor w \
			-variable videoFormat -value $n1 -padx 0 -pady 0 \
			-command "$self select_format $n1"
		pack $w.b1 -fill x 
		lappend formatButtons $w.b1 
	} 
	if { $n2 != "" } {
		radiobutton $w.b2 -text $n2 -relief flat -font $f -anchor w \
			-variable videoFormat -value $n2 -padx 0 -pady 0 \
			-command "$self select_format $n2"
		pack $w.b2 -fill x 
		lappend formatButtons $w.b2
	}
}
ControlMenu instproc build.format w {
	$self format_col $w.p0 nv nvdct cellb 
	$self format_col $w.p1 jpeg h261 pvh 
	$self format_col $w.p2 ldct
	frame $w.glue0
	frame $w.glue1
	pack $w.glue0 -side left -fill x -expand 1
	pack $w.p0 $w.p1 $w.p2 -side left
	pack $w.glue1 -side left -fill x -expand 1
}
ControlMenu instproc set-port p {
	$self instvar vpipe_
	$vpipe_ set_port $p
}
ControlMenu instproc set-decimate p {
	$self instvar vpipe_
	$vpipe_ set_decimate $p
}
ControlMenu instproc build.size w {
	set f [$self get_option smallfont]
	set b $w.b
	frame $b
	radiobutton $b.b0 -text "small" -command "$self set-decimate 4" \
		-padx 0 -pady 0 \
		-anchor w -variable inputSize -font $f -relief flat -value 4
	radiobutton $b.b1 -text "normal" -command "$self set-decimate 2" \
		-padx 0 -pady 0 \
		-anchor w -variable inputSize -font $f -relief flat -value 2
	radiobutton $b.b2 -text "large" -command "$self set-decimate 1" \
		-padx 0 -pady 0 \
		-anchor w -variable inputSize -font $f -relief flat -value 1
	pack $b.b0 $b.b1 $b.b2 -fill x 
	pack $b -anchor c -side left
	global inputSize 
	set inputSize 2
	$self instvar sizeButtons_
	set sizeButtons_ $b
}
ControlMenu instproc build.port w {
	set f [$self get_option smallfont]
	menubutton $w -menu $w.menu -text Port... \
		-relief raised -width 10 -font $f -state disabled
	global inputPort
	$self instvar portButton_
	set portButton_ $w
	set inputPort undefined
}
ControlMenu instproc attach_ports device {
	global inputPort defaultPort
	$self instvar portButton_
	catch "destroy $portButton_.menu"
	set portnames [$device get_attribute port]
	set f [$self get_option smallfont]
	set m $portButton_.menu
	menu $m
	foreach port $portnames {
		$m add radiobutton -label $port \
			-command "$self set-port $port" \
			-value $port -variable inputPort -font $f
	}
	if ![info exists defaultPort($device)] {
		set nn [$device nickname]
		if [info exists defaultPort($nn)] {
			set defaultPort($device) $defaultPort($nn)
		} else {
			set s [$self get_option defaultPort($nn)]
			if { $s != "" } {
				set defaultPort($device) $s
			} else {
				set defaultPort($device) [lindex $portnames 0]
			}
		}
	}
	set inputPort $defaultPort($device)
}
ControlMenu instproc build.type w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Signal... -menu $m -relief raised \
		-width 10 -font $f -state disabled
	menu $m
	$m add radiobutton -label "auto" -command "$self restart" \
		-value auto -variable inputType -font $f
	$m add radiobutton -label "NTSC" -command "$self restart" \
		-value ntsc -variable inputType -font $f
	$m add radiobutton -label "PAL" -command "$self restart" \
		-value pal -variable inputType -font $f
	$m add radiobutton -label "SECAM" -command "$self restart" \
		-value secam -variable inputType -font $f
	global inputType typeButton
	set inputType auto
	set typeButton $w
}
ControlMenu instproc build.encoder_buttons w {
	set f [$self get_option smallfont]
	$self build.encoder_options $w.options
	$self build.device $w.device
	$self build.port $w.port
	pack $w.device $w.port $w.options -fill x
}
ControlMenu instproc build.encoder_options w {
	global useJPEGforH261
	set useJPEGforH261 [$self yesno useJPEGforH261]
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Options... -menu $m -relief raised -width 10 \
		-font $f
	menu $m
    	$m add checkbutton -label "Sending Slides" \
		-variable sendingSlides -font $f -command "$self setFillRate"
    	$m add checkbutton -label "Use JPEG for H261" \
		-variable useJPEGforH261 -font $f -command "$self restart"
}
ControlMenu instproc build.tile w {
	$self instvar ui_
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Tile... -menu $m -relief raised -width 10 \
		-font $f
	menu $m
	set v [$self tkvarname ncol]
	$m add radiobutton -label Single -command "$ui_ redecorate 1" \
		-value 1 -variable $v -font $f
	$m add radiobutton -label Double -command "$ui_ redecorate 2" \
		-value 2 -variable $v -font $f
	$m add radiobutton -label Triple -command "$ui_ redecorate 3" \
		-value 3 -variable $v -font $f
	$m add radiobutton -label Quad -command "$ui_ redecorate 4" \
		-value 4 -variable $v -font $f
}
ControlMenu instproc use-hw {} {
	$self tkvar useHardwareDecode_
	return $useHardwareDecode_
}
ControlMenu instproc mute-new-sources {} {
	$self tkvar muteNewSources
	return $muteNewSources
}
ControlMenu instproc build.decoder_options w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Options... -menu $m -relief raised -width 10 \
		-font $f
	menu $m
    	$m add checkbutton -label "Mute New Sources" \
		-variable [$self tkvarname muteNewSources] -font $f
    	$m add checkbutton -label "Use Hardware Decode" \
		-variable [$self tkvarname useHardwareDecode_] -font $f
	$m add separator
    	$m add command -label "Optimize Colormap" \
		-command "$self fork_histtolut" -font $f
	$self instvar ui_ optionsMenu_
	set optionsMenu_ $m
	$self tkvar ditherStyle_
	if { $ditherStyle_ == "" } {
		$m entryconfigure "Optimize Colormap" -state disabled
	}
}
ControlMenu instproc build.external w {
}
ControlMenu instproc build.external w {
	set f [$self get_option smallfont]
	set m $w.menu
	global outputDeviceList
	if ![info exists outputDeviceList] {
		set outputDeviceList ""
	}
	if { [llength $outputDeviceList] <= 1 } {
		button $w -text External -relief raised \
			-width 10 -font $f -highlightthickness 0 \
			-command "extout_select $outputDeviceList"
	} else {
		menubutton $w -text External... -menu $m -relief raised \
			-width 10 -font $f 
		menu $m
		foreach d $outputDeviceList {
			$m add command -font $f -label [$d nickname] \
				-command "extout_select $d"
		}
	}
	if { $outputDeviceList == "" } {
		$w configure -state disabled
	}
}
ControlMenu instproc set-dither d {
	[$self set ui_] set-dither $d
}
ControlMenu instproc build.dither w {
	set f [$self get_option smallfont]
	$self tkvar ditherStyle_
	if { $ditherStyle_ != "" } {
		set state normal
	} else {
		set state disabled
	}
	set v $w.h0
	frame $v
	set dvar [$self tkvarname ditherStyle_]
	radiobutton $v.b0 -text "Ordered" -command "$self set-dither Dither" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat -value Dither
	radiobutton $v.b1 -text "Error Diff" -command "$self set-dither ED" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat -value ED
	set v $w.h1
	frame $v
	radiobutton $v.b2 -text Quantize -command "$self set-dither Quant" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat \
		-value Quant
	radiobutton $v.b3 -text Gray -command "$self set-dither Gray" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat -value Gray
	pack $w.h0.b0 $w.h0.b1 -anchor w -fill x
	pack $w.h1.b2 $w.h1.b3 -anchor w -fill x
	pack $w.h0 $w.h1 -side left
}
Class GammaEntry -superclass Entry
GammaEntry instproc init { w value ui } {
	$self next $w $value
	$self instvar ui_
	set ui_ $ui
}
GammaEntry instproc update { w s } {
	$self instvar ui_
	return [$ui_ set-gamma $s]
}
ControlMenu instproc build.gamma w {
	$self instvar ui_
	frame $w
	label $w.label -text "Gamma: " -font [$self get_option smallfont] -anchor e
	new GammaEntry $w.entry [$ui_ set gamma_] $ui_
	$w.entry configure -width 6
	$self tkvar ditherStyle_
	if { $ditherStyle_ == "" } {
		$w.entry configure -state disabled -foreground gray60
		$w.label configure -foreground gray60
	}
	pack $w.label -side left
	pack $w.entry -side left -expand 1 -fill x -pady 2
}
ControlMenu instproc build.decoder w {
	set f [$self get_option smallfont]
	label $w.title -text Display
	frame $w.f -relief sunken -borderwidth 2
	set v $w.f.h0
	frame $v
	$self build.external $v.ext
	$self build.tile $v.tile
	$self build.decoder_options $v.options
	pack $v.options $v.tile $v.ext -fill x -expand 1
	set v $w.f.h2
	frame $v
	frame $v.dither -relief groove -borderwidth 2
	$self build.dither $v.dither
	frame $v.bot
	$self build.gamma $v.bot.gamma
	$self instvar ui_
	set top [$ui_ set path_]
	label $v.bot.mode -text "\[[winfo depth $top]-bit\]" -font $f
	pack $v.bot.gamma $v.bot.mode -side left -padx 4
	pack $v.dither $v.bot -anchor c -pady 2
	pack $w.f.h0 -side left -padx 6 -pady 6
	pack $w.f.h2 -side left -padx 6 -pady 6 -fill x -expand 1
	pack $w.title $w.f -fill x
}
ControlMenu instproc build.encoder w {
	label $w.title -text Encoder
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h0 -relief flat
	frame $w.f.h1 -relief flat
	frame $w.f.h0.eb -relief flat
	frame $w.f.h0.format -relief groove -borderwidth 2
	frame $w.f.h0.size -relief groove -borderwidth 2
	frame $w.f.h0.gap -relief flat -width 4
	$self build.encoder_buttons $w.f.h0.eb
	$self build.format $w.f.h0.format
	$self build.size $w.f.h0.size
	$self build.q $w.f.h1
	pack $w.f.h0.eb -side left -anchor n -fill y -padx 6 -pady 4
	pack $w.f.h0.format -side left -anchor n -fill both -expand 1
	pack $w.f.h0.size -side left -anchor c -fill both
	pack $w.f.h0.gap -side left -anchor c
	pack $w.f.h0 -fill x -pady 4
	pack $w.f.h1 -fill x -pady 6
	pack $w.title $w.f -fill x
}
ControlMenu instproc restart { } {
	$self tkvar transmitButtonState_
	$self instvar vpipe_
	if $transmitButtonState_ {
		$vpipe_ stop
		$vpipe_ release_device
		$self tx-init
		$vpipe_ start
	} else {
		$vpipe_ release_device
	}
}
ControlMenu instproc disable_large_button { } {
	$self instvar sizeButtons_
	global inputSize
	if { $inputSize == 1 } {
		set inputSize 2
	}
	$sizeButtons_.b2 configure -state disabled
}
ControlMenu instproc enable_large_button { } {
	$self instvar device_ sizeButtons_
	if { [info exists device_] && \
		[$device_ supports size large] } {
		$sizeButtons_.b2 configure -state normal
	}
}
ControlMenu instproc setq value {
	$self instvar vpipe_ qvalue_
	set v [$vpipe_ set_quality $value]
	$qvalue_ configure -text $v
}
ControlMenu instproc select_format fmt {
	global videoFormat 
	$self instvar qval_ qscale_ qlabel_ lastFmt_
	if { $fmt == "h261" } {
		$self disable_large_button
	} else {
		$self enable_large_button
	}
	set qval_($lastFmt_) [$qscale_ get]
	set lastFmt_ $videoFormat
	if [info exists qval_($fmt)] {
		$qscale_ set $qval_($fmt)
	}
	$self instvar vpipe_ device_
	$vpipe_ select $device_ $fmt
	if { [$vpipe_ set_quality $qval_($fmt)] >= 0 } {
		$qscale_ configure -state normal -command "$self setq"
		$qlabel_ configure -foreground black
	} else {
		$qscale_ configure -state disabled 
		$qlabel_ configure -foreground gray40
	}
}
ControlMenu instproc tx-init {} {
	$self instvar qscale_
	if { [lindex [$qscale_ configure -state] 4] == "normal" } {
		set cmd [lindex [$qscale_ configure -command] 4]
		eval $cmd [$qscale_ get]
	}
	$self instvar portButton_
	global inputPort inputType typeButton
	if { [$portButton_ cget -state] == "normal" } {
		$self set-port $inputPort
	}
	$self setFillRate
	update
}
ControlMenu instproc build.q w {
	set f [$self get_option smallfont]
	frame $w.tb
	label $w.title -text "Quality" -font $f -anchor w
	label $w.tb.value -text 0 -font $f -width 3
	scale $w.tb.scale -font $f -orient horizontal \
		-showvalue 0 -from 0 -to 99 \
		-width 12 -relief groove
	$self instvar qscale_ qvalue_ qlabel_
	set qscale_ $w.tb.scale
	set qvalue_ $w.tb.value
	set qlabel_ $w.title
	pack $w.tb.scale -side left -fill x -expand 1
	pack $w.tb.value -side left
	pack $w.title -padx 2 -side left
	pack $w.tb -fill x -padx 6 -side left -expand 1
}
ControlMenu instproc build.scuba w {
	set f [$self get_option smallfont]
	label $w.label -text SCUBA
	frame $w.frame -relief sunken -borderwidth 2
	pack $w.label -fill x
	pack $w.frame -fill both -expand 1
	set wf $w.frame
	frame $wf.title
	frame $wf.title.lglue 
	frame $wf.title.rglue 
	label $wf.title.l -text "Local Bandwidth: " -font $f
	label $wf.title.value -font $f -width 8 -anchor w
	pack $wf.title.lglue -expand 1 -fill x -side left
	pack $wf.title.l $wf.title.value -side left
	pack $wf.title.rglue -expand 1 -fill x -side right
	pack $wf.title -fill x -expand 1
	frame $wf.sessbw
	scale $wf.sessbw.scale -orient horizontal -font $f \
		-showvalue 0 -from 1000 -to [$self get_option maxSessionBW] \
		-command "$self set_sessionbw $wf.title.value" -width 12 \
		-relief groove -resolution 1000
	pack $wf.sessbw -fill x -expand 1
	pack $wf.sessbw.scale -fill x -side left -expand 1
	$self instvar ui_
	set s [$ui_ set scuba_sess_]
	$wf.sessbw.scale set [$s set sessionbw_]
}
ControlMenu instproc build.xmit w {
	set f [$self get_option smallfont]
	label $w.label -text Transmission
	frame $w.frame -relief sunken -borderwidth 2
	pack $w.label -fill x
	pack $w.frame -fill both -expand 1
	frame $w.frame.buttons
	$self build.buttons $w.frame.buttons
	frame $w.frame.right
	$self build.sliders $w.frame.right
	pack $w.frame.buttons -side left -padx 6 
	pack $w.frame.right -side right -expand 1 -fill x -padx 10 -anchor c
}
ControlMenu instproc build.slicvideo { w } {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	label $w.title -text "Video Input"
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h -relief flat
	label $w.f.h.label  -font $f -anchor e -text "Hue"
	scale $w.f.h.scale -orient horizontal -width 12 -length 20 \
		           -relief groove -showvalue 0 -from -128 -to 127 \
                          -command "$vpipe_ hardware set HUE"
	pack  $w.f.h.label $w.f.h.scale -side left -fill x -expand 1
	frame $w.f.ll -relief flat 
	label $w.f.ll.label  -font $f -text "Luma" -anchor s
	label $w.f.ll.clabel -font $f -text "Contrast" -anchor s
	label $w.f.ll.blabel -font $f -text "Brightness" -anchor s
	pack  $w.f.ll.clabel $w.f.ll.label $w.f.ll.blabel \
			     -side left -fill x -expand 1
	frame $w.f.l  -relief flat
	scale $w.f.l.cscale   -orient horizontal -width 12 -relief groove \
                              -showvalue 0 -from 0 -to 127 \
                              -command "$vpipe_ hardware set LUMA_CONTRAST"
	scale $w.f.l.bscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 255 \
                            -command "$vpipe_ hardware set LUMA_BRIGHTNESS"
	pack  $w.f.l.cscale $w.f.l.bscale  -side left -fill x -expand 1
	frame $w.f.cl  -relief flat
	label $w.f.cl.label  -font $f -text "Chroma" -anchor n
	label $w.f.cl.glabel -font $f -text "Gain" -anchor n
	label $w.f.cl.slabel -font $f -text "Saturation" -anchor n
	pack  $w.f.cl.glabel $w.f.cl.label $w.f.cl.slabel \
			     -side left -fill x -expand 1
	frame $w.f.c -relief flat
	scale $w.f.c.gscale -orient horizontal -width 12 -relief groove \
                             -showvalue 0 -from 0 -to 255 \
                             -command "$vpipe_ hardware set CHROMA_GAIN"
	scale $w.f.c.sscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 127 \
                            -command "$vpipe_ hardware set CHROMA_SATURATION"
	pack  $w.f.c.gscale $w.f.c.sscale -side left -fill x -expand 1
	pack  $w.f.h $w.f.ll $w.f.l $w.f.c $w.f.cl \
	      -fill x -expand 1 -padx 1m 
	pack $w.title $w.f -fill x -expand 1
	$w.f.h.scale  set 0
	$w.f.l.cscale set 64
	$w.f.l.bscale set 128
	$w.f.c.gscale set 44
	$w.f.c.sscale set 64
}
ControlMenu instproc build.still { w } {
    set f [$self get_option smallfont]
    label $w.title -text "Video Input"
    frame $w.f -relief sunken -borderwidth 2
    label $w.f.label  -font $f -anchor e -text "File"
    mk.entry $w.f set.still.frame "frame"
    pack $w.title $w.f -fill x -expand 1
    pack $w.f.label -side left 
    pack $w.f.entry -side left -fill x -expand 1
}
ControlMenu instproc set.still.frame {w s } {
    global lastDevice
    $lastDevice file $s
}
ControlMenu instproc build.qcam { w } {
    $self instvar vpipe_
    global qcamwindow
    set f [$self get_option smallfont]
    label $w.title -text "Video Input"
    frame $w.f -relief sunken -borderwidth 2
    frame $w.f.s -relief flat
    frame $w.f.s.l -relief flat
    label $w.f.s.l.bright -font $f -anchor w -text "Brightness"
    label $w.f.s.l.cont   -font $f -anchor w -text "Contrast"
    label $w.f.s.l.wbal   -font $f -anchor w -text "White balance"
    pack  $w.f.s.l.bright $w.f.s.l.cont $w.f.s.l.wbal \
	-side top -fill x -expand 1
    frame $w.f.s.s -relief flat
    scale $w.f.s.s.bright -orient horizontal -width 12 \
		          -relief groove -showvalue 0 -from 1 -to 254 \
                          -command "$vpipe_ hardware set BRIGHT"
    scale $w.f.s.s.cont   -orient horizontal -width 12 \
                          -relief groove -showvalue 0 \
                          -from 0 -to 1.0 -resolution 0.002 \
                          -command "$vpipe_ hardware contrast"
    frame $w.f.s.s.wbal -relief flat
    scale $w.f.s.s.wbal.scale  -orient horizontal -width 12 \
                             -relief groove -showvalue 0 -from 1 -to 254 \
                             -command "$vpipe_ hardware set WBAL"
    button $w.f.s.s.wbal.button -font $f -text Auto \
	-command "$vpipe_ hardware set WBAL auto"
    pack  $w.f.s.s.wbal.scale $w.f.s.s.wbal.button \
	-side left -fill x -expand 1
    pack $w.f.s.s.bright $w.f.s.s.cont $w.f.s.s.wbal \
        -side top -fill x -expand 1
    pack $w.f.s.l $w.f.s.s -side left -fill x -expand 1
    frame $w.f.bpp -relief flat
    label $w.f.bpp.label  -font $f -anchor w -text "Pixel depth"
    radiobutton $w.f.bpp.bpp4 -font $f -text "4-bit" \
	-variable qcambpp -value 4 -command "$vpipe_ hardware set BPP 4"
    radiobutton $w.f.bpp.bpp6 -font $f -text "6-bit" \
	-variable qcambpp -value 6 -command "$vpipe_ hardware set BPP 6"
    pack $w.f.bpp.label $w.f.bpp.bpp4 $w.f.bpp.bpp6 \
	-side left -fill x -expand 1
    pack  $w.f.s $w.f.bpp \
	 -fill x -expand 1 -padx 1m 
    pack $w.title $w.f -fill x -expand 1
    set qcamwindow(setbright) "$w.f.s.s.bright set"
    set qcamwindow(setcont) "$w.f.s.s.cont set"
    set qcamwindow(setwbal) "$w.f.s.s.wbal.scale set"
    set qcamwindow(setbpp) "set qcambpp"
}
ControlMenu instproc build.brooktree848 { w } {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	label $w.title -text "Video Input"
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h -relief flat
	label $w.f.h.label  -font $f -anchor e -text "Hue"
	scale $w.f.h.scale -orient horizontal -width 12 -length 20 \
		           -relief groove -showvalue 0 -from -128 -to 127 \
                          -command "$vpipe_ hardware set HUE"
	pack  $w.f.h.label $w.f.h.scale -side left -fill x -expand 1
	frame $w.f.ll -relief flat 
	label $w.f.ll.label  -font $f -text "Luma" -anchor s
	label $w.f.ll.clabel -font $f -text "Contrast" -anchor s
	label $w.f.ll.blabel -font $f -text "Brightness" -anchor s
	pack  $w.f.ll.clabel $w.f.ll.label $w.f.ll.blabel \
			     -side left -fill x -expand 1
	frame $w.f.l  -relief flat
	scale $w.f.l.cscale   -orient horizontal -width 12 -relief groove \
                              -showvalue 0 -from 0 -to 127 \
                              -command "$vpipe_ hardware set contrast"
	scale $w.f.l.bscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 255 \
                            -command "$vpipe_ hardware brightness"
	pack  $w.f.l.cscale $w.f.l.bscale  -side left -fill x -expand 1
	frame $w.f.cl  -relief flat
	label $w.f.cl.label  -font $f -text "Chroma" -anchor n
	label $w.f.cl.glabel -font $f -text "Gain" -anchor n
	label $w.f.cl.slabel -font $f -text "Saturation" -anchor n
	pack  $w.f.cl.glabel $w.f.cl.label $w.f.cl.slabel \
			     -side left -fill x -expand 1
	frame $w.f.c -relief flat
	scale $w.f.c.gscale -orient horizontal -width 12 -relief groove \
                             -showvalue 0 -from 0 -to 255 \
                             -command "$vpipe_ hardware set CHROMA_GAIN"
	scale $w.f.c.sscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 127 \
                            -command "$vpipe_ hardware set CHROMA_SATURATION"
	pack  $w.f.c.gscale $w.f.c.sscale -side left -fill x -expand 1
	checkbutton $w.f.b -text PAL -variable signalFormat -onvalue pal \
		-offvalue ntsc -command \
		"$vpipe_ hardware format \$signalFormat"
	pack  $w.f.h $w.f.ll $w.f.l $w.f.c $w.f.cl $w.f.b \
	      -fill x -expand 1 -padx 1m 
	pack $w.title $w.f -fill x -expand 1
	$w.f.h.scale  set 0
	$w.f.l.cscale set 64
	$w.f.l.bscale set 128
	$w.f.c.gscale set 44
	$w.f.c.sscale set 64
}
ControlMenu instproc build.brooktree848 w {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h -relief flat
	label $w.f.h.label  -font $f -text "Hue" -width 12
	scale $w.f.h.hscale -orient horizontal \
		           -relief groove -showvalue 0 -from -128 -to 127 \
                          -command "$vpipe_ hardware hue"
	pack $w.f.h.label -side left 
	pack $w.f.h.hscale -side left -fill x -expand 1
	frame $w.f.l -relief flat
	frame $w.f.l.l
	label $w.f.l.l.clabel -font $f -text "Contrast" -width 12
	scale $w.f.l.l.cscale -orient horizontal -relief groove -width 12 \
                              -showvalue 0 -from 0 -to 127 \
                              -command "$vpipe_ hardware contrast"
	pack  $w.f.l.l.clabel -side left
	pack  $w.f.l.l.cscale -side left -fill x -expand 1
	frame $w.f.l.r
	label $w.f.l.r.blabel -font $f -text "Brightness" -width 12
	scale $w.f.l.r.bscale -orient horizontal -relief groove -width 12 \
                            -showvalue 0 -from -128 -to 127 \
                            -command "$vpipe_ hardware brightness"
	pack  $w.f.l.r.blabel -side left
	pack  $w.f.l.r.bscale -side left -fill x -expand 1
	pack  $w.f.l.l $w.f.l.r  -side top -fill x -expand 1
	frame $w.f.cl  -relief flat
	frame $w.f.cl.l
	label $w.f.cl.l.glabel -font $f -text "Chroma Gain" -width 12
	scale $w.f.cl.l.gscale -orient horizontal -relief groove -width 12 \
                             -showvalue 0 -from 0 -to 255 \
                             -command "$vpipe_ hardware uvgain"
	pack  $w.f.cl.l.glabel -side left
	pack  $w.f.cl.l.gscale -side left -fill x -expand 1
	frame $w.f.cl.r
	label $w.f.cl.r.slabel -font $f -text "Saturation" -width 12
	scale $w.f.cl.r.sscale -orient horizontal -relief groove -width 12 \
                            -showvalue 0 -from 0 -to 127 \
                            -command "$vpipe_ hardware saturation"
	pack  $w.f.cl.r.slabel -side left
	pack  $w.f.cl.r.sscale -side left -fill x -expand 1
	pack  $w.f.cl.r $w.f.cl.l  -side top -fill x -expand 1
	checkbutton $w.f.b -text PAL -variable signalFormat -onvalue pal \
		-offvalue ntsc -command \
		"$vpipe_ hardware format \$signalFormat"
	pack $w.f.l $w.f.h $w.f.cl $w.f.b -side top -fill both -expand 1
	pack $w.f -fill both -expand 1
		$w.f.h.hscale set 0
		$w.f.l.l.cscale set 64
		$w.f.l.r.bscale set 0
		$w.f.cl.l.gscale set 44
		$w.f.cl.r.sscale set 64
}
Class Switcher
Switcher instproc init src {
	$self next
	$self instvar src_
	set src_ $src
	Switcher set all_($self) 1
}
Switcher instproc destroy {} {
	$self cancel_timer
	Switcher unset all_($self)
}
Switcher instproc enable {} {
	$self touch
}
Switcher instproc enabled {} {
	$self instvar ts_
	return [info exists ts_]
}
Switcher instproc disable {} {
	$self instvar ts_
 	unset ts_
}
Switcher instproc set_timer {} {
	$self sched
}
Switcher instproc cancel_timer {} {
	$self instvar timer_id_
	if [info exists timer_id_] {
		after cancel $timer_id_
		unset timer_id_
	}
}
Switcher instproc switch_to src {
	$self instvar src_
	if { $src != $src_ } {
		$self switch $src
		set src_ $src
	}
}
Switcher instproc forward {} {
	$self instvar src_
	$self switch_to [$self next_active_src $src_]
}
Switcher instproc reverse {} {
	$self instvar src_
	$self switch_to [$self prev_active_src $src_]
}
Switcher set clock_ 1
Switcher instproc touch {} {
	Switcher instvar clock_
	$self instvar ts_
	set ts_ $clock_
	incr clock_
}
Switcher proc focus src {
	Switcher instvar ignore_
	if [info exists ignore_($src)] {
		return
	}
	Switcher instvar all_
	set target ""
	foreach o [array names all_] {
		if { [$o enabled] && ( $target == "" || \
			[$o set ts_] < [$target set ts_] ) } {
			set target $o
		}
	}
	if { $target != "" } {
		$target switch_to $src
		$target touch
	}
}
Switcher instproc sched {} {
	$self instvar timer_id_
	set ms [expr 1000 * [$self get_option switchInterval]]
	set timer_id_ [after $ms "$self timeout"]
}
Switcher instproc timeout {} {
	$self instvar timer_id_
	if [info exists timer_id_] {
		$self forward
		$self sched
	}
}
Class UserWindow -superclass Switcher
VideoWindow instproc adjust-voff d {
	set ow [$self width]
	set oh [$self height]
	set iw [$d width]
	set ih [$d height]
	$self voff 0
	if { $ow == 320 && $oh == 240 } {
		if { $iw == 352 && $ih == 288 } {
			$self voff 8
		} elseif { $iw == 176 && $ih == 144 } {
		}
	} elseif { $ow == 640 && $oh == 480 } {
		if { $iw == 352 && $ih == 288 } {
			$self voff 16
		}
	}
}
UserWindow instproc resize { w h } {
	$self instvar vw_
	$self instvar as_
	$as_ detach-window $self
	[$vw_ window] resize $w $h
	update idletasks
	$as_ attach-window $self
}
proc viewing_window w {
	if { [string range $w 0 2] == ".vw"} {
		return 1
	} else {
		return 0
	}
}
UserWindow instproc init { ui as cmenu cb {w {}} } {
	$self next $as
	$self instvar ui_
	$self tkvar switched_ timed_ slow_ hw_
	set ui_ $ui
	set switched_ 0
	set timed_ 0
	set slow_ 0
	set hw_ 0
	if { $cb != "" } {
		$self create-window $w $as $cmenu 1
	} else {
		$self create-window $w $as $cmenu 0
	}
}
UserWindow instproc destroy {} {
	$self instvar ui_ as_ path_ vw_
	set w $path_.frame.video
	$as_ detach-window $self
	$vw_ destroy
	set x [winfo rootx $w]
	set y [winfo rooty $w]
	incr x [winfo vrootx $w]
	incr y [winfo vrooty $w]
	set top [winfo toplevel $w]
	global userwin_x userwin_y userwin_size size$top
	set userwin_x($as_) $x
	set userwin_y($as_) $y
	set userwin_size($as_) [set size$top]
	destroy $top
	$self next
}
UserWindow instproc is-switched {} {
	$self tkvar switched_
	return $switched_
}
UserWindow instproc reallocate_renderer w {
	global win_src
	set src $win_src($w)
	$self instvar ui_
	$ui_ detach_window $src $w
	$ui_ attach_window $src $w
}
Class VideoWidget -superclass TkWindow
VideoWidget instproc init { w width height } {
	$self next $w
	$self instvar window_ is_slow_ 
	set window_ [new VideoWindow $w $width $height]
	set is_slow_ 0
}
VideoWidget instproc window {} {
	return [$self set window_]
}
VideoWidget instproc is-slow {} {
	return [$self set is_slow_]
}
VideoWidget instproc redraw {} {
	[$self set window_] redraw
}
foreach type { TrueColor/24 TrueColor/16 PseudoColor/8/Dither
		PseudoColor/8/ED PseudoColor/8/Gray PseudoColor/8/Quant } {
	set body "return \[new Renderer/$type \$self \$win \$dec]"
	Colormodel/$type instproc alloc-renderer { win dec } $body
	Renderer/$type set nb 0
}
VideoWidget instproc attach-decoder { src colorModel useHW } {
	set d [$src handler]
	$self instvar window_ target_ is_slow_
	set target_ ""
	if { $useHW } {
		set fmt [$src format_name]
		if { $fmt == "jpeg" } {
			set fmt $fmt/[$d decimation]
		}
		if ![catch "new assistor/$fmt" v] {
			set target_ $v
			$target_ window $window_
		}
	}
	if { $target_ == "" } {
		set target_ [$colorModel alloc-renderer $window_ [$d decimation]]
	}
	if $is_slow_ {
		$target_ update-interval [$self get_option stampInterval]
	}
	$window_ adjust-voff $d
	$d attach $target_
}
VideoWidget instproc set_slow {} {
	$self instvar is_slow_ target_
	set is_slow_ 1
	if { [info exists target_] } {
		$target_ update-interval [$self get_option stampInterval]
	}
}
VideoWidget instproc set_normal {} {
	$self instvar is_slow_ target_
	set is_slow_ 0
	if { [info exists target_] } {
		$target_ update-interval 0
	}
}
VideoWidget instproc destroy {} {
	$self instvar target_
	if [info exists target_] {
		delete $target_
		$self next
	}
}
VideoWidget instproc detach-decoder src {
	$self instvar target_
	set d [$src handler]
	$d detach $target_
	delete $target_
	unset target_
}
UserWindow instproc create-window { w as cmenu useCB } {
	set f [$self get_option smallfont]	
	set uid [uniqueID]
	$self instvar ui_
	if { $w=={} } {
		set w .vw$uid
		Application toplevel $w
	} else {
		frame $w
	}
	catch "wm resizable $w false false"
	frame $w.frame
	$self instvar vw_ as_ path_ controlMenu_
	set as_ $as
	set path_ $w
	set useHW [$cmenu use-hw]
	global size$w userwin_x userwin_y userwin_size
	if [info exists userwin_x($as)] {
		if { [winfo toplevel $w]==$w } {
			wm geometry $w +$userwin_x($as)+$userwin_y($as)
			wm positionfrom $w user
		}
		set size$w $userwin_size($as)
		set d [split $userwin_size($as) x]
		set vw_ [new VideoWidget $w.frame.video \
			 [lindex $d 0] [lindex $d 1] ]
	} elseif [$self yesno demo] {
		set vw_ [new VideoWidget $w.frame.video 320 240 ]
		set size$w 320x240
	} elseif [$as isCIF] {
		set vw_ [new VideoWidget $w.frame.video 352 288 ]
		set size$w 352x288
	} else {
		set vw_ [new VideoWidget $w.frame.video 320 240 ]
		set size$w 320x240
	}
	set v $w.frame.video
	frame $w.bar
	button $w.bar.dismiss -text Dismiss -font $f -width 8 \
		-highlightthickness 0 -command "$self destroy"
	set m $w.bar.mode.menu
	menubutton $w.bar.mode -text Modes... -menu $m -relief raised \
		-width 8 -font $f
	menu $m
	$m add checkbutton -label Voice-switched \
		-command "$self set_switched" \
		-font $f -variable [$self tkvarname switched_]
	$m add checkbutton -label Timer-switched \
		-command "$self set_timed" \
		-font $f -variable [$self tkvarname timed_]
	$m add checkbutton -label Save-CPU \
		-command "$self set_slow" \
		-font $f -variable [$self tkvarname slow_]
	$m add checkbutton -label Use-Hardware \
		-command "$self reallocate_renderer $v" \
		-font $f -variable [$self tkvarname hw_]
	if !$useCB {
		$m entryconfigure Voice-switched -state disabled
	}
	set m $w.bar.size.menu
	menubutton $w.bar.size -text Size... -menu $m -relief raised -width 8 \
		-font $f
	menu $m
	$m add radiobutton -label QCIF -command "$self resize 176 144" \
		-font $f -value 176x144 -variable size$w
	$m add radiobutton -label CIF -command "$self resize 352 288" \
		-font $f -value 352x288 -variable size$w
	$m add radiobutton -label SCIF -command "$self resize 704 576" \
		-font $f -value 704x576 -variable size$w
	$m add separator
	$m add radiobutton -label "1/16 NTSC" \
		-command "$self resize 160 120" \
		-font $f -value 160x120 -variable size$w
	$m add radiobutton -label "1/4 NTSC" \
		-command "$self resize 320 240" \
		-font $f -value 320x240 -variable size$w
	$m add radiobutton -label NTSC \
		-command "$self resize 640 480" \
		-font $f -value 640x480 -variable size$w
	$m add separator
	$m add radiobutton -label "1/16 PAL" \
		-command "$self resize 192 144" \
		-font $f -value 192x144 -variable size$w
	$m add radiobutton -label "1/4 PAL" \
		-command "$self resize 384 288" \
		-font $f -value 384x288 -variable size$w
	$m add radiobutton -label PAL \
		-command "$self resize 768 576" \
		-font $f -value 768x576 -variable size$w
	label $w.bar.label -text "" -anchor w -relief raised
	pack $w.bar.label -expand 1 -side left -fill both
	pack $w.bar.size $w.bar.mode $w.bar.dismiss -side left -fill y
	pack $w.frame.video -anchor c
	pack $w.frame -expand 1 -fill both
	pack $w.bar -fill x
	bind $w <Enter> { focus %W }
	bind $w <d> "$self destroy"
	bind $w <q> "$self destroy"
	$w.bar.dismiss configure -command "$self destroy"
	bind $w <Return> "$self forward"
	bind $w <space> "$self forward"
	bind $w <greater> "$self forward"
	bind $w <less> "$self reverse"
	bind $w <comma> "$self reverse"
	$as attach-window $self
}
UserWindow instproc video-widget {} {
	return [$self set vw_]
}
UserWindow instproc attached-source {} {
	return [$self set as_]
}
UserWindow instproc set-name name {
	$self instvar path_
	set w $path_
	if ![$self yesno suppressUserName] {
		$w.bar.label configure -text $name
	}
	puts "todo: move to base class [winfo toplevel $w], $w"
	if { [winfo toplevel $w]==$w } {
		wm iconname $w vic:$name
		wm title $w $name
	}
}
UserWindow instproc switch src {
	$self instvar as_ ui_
	set as [$ui_ set active_($src)]
	if { $as_ != $as } {
		$as_ detach-window $self
		set as_ $as
		$as_ attach-window $self
	}
}
UserWindow instproc next_active_src src {
	[$self set ui_] instvar active_
	set list [array names active_]
	set k [lsearch -exact $list $src]
	incr k
	if { $k >= [llength $list] } {
		set k 0
	}
	return [lindex $list $k]
}
UserWindow instproc prev_active_src src {
	[$self set ui_] instvar active_
	set list [array names active_]
	set k [lsearch -exact $list $src]
	if { $k < 0 } {
		set k 0
	} else {
		if { $k == 0 } {
			set k [llength $list]
		}
		incr k -1
	}
	return [lindex $list $k]
}
UserWindow instproc set_switched {} {
	$self tkvar switched_
	if $switched_ {
		$self enable
	} else {
		$self disable
	}
}
UserWindow instproc set_timed {} {
	$self tkvar timed_
	if $timed_ {
		$self set_timer
	} else {
		$self cancel_timer
	}
}
UserWindow instproc set_slow {} {
	$self tkvar slow_
	$self instvar vw_
	if $slow_ {
		$vw_ set_slow
	} else {
		$vw_ set_normal
	}
}
Class AudioArbiter -superclass {GlobalBus Observable}
AudioArbiter instproc init agent {
	$self next
	$self instvar agent_ activity_ id_ priority_ hold_
	set agent_ $agent
	set hold_ 0
	$self register audio-demand someone_demands
	$self register audio-request someone_requests
	$self register audio-release someone_released
	set activity_ 0
	set priority_ [$self get_option defaultPriority]
	set id_ [after 5000 "$self timeout"]
}
AudioArbiter instproc destroy {} {
	$self instvar id_
	after cancel $id_
	$self next
}
AudioArbiter instproc set-pri p {
	$self instvar priority_
	set priority_ $p
}
AudioArbiter instproc someone_requests { pid pri } {
	$self instvar agent_ priority_ hold_
	global unmuted outputMutebutton
	if { [$agent_ have_audio] && !$hold_ && ($pri > $priority_) } {
		$self give_it_up $pid
	}
}
AudioArbiter instproc release {} {
	$self instvar agent_
	$agent_ release 
	$self indicator_update
}
AudioArbiter instproc give_it_up pid {
	$self release 
	$self send "audio-release $pid"
}
AudioArbiter instproc someone_demands pid {
	$self instvar agent_
	if { [$agent_ have_audio] } {
		$self give_it_up $pid
	}
}
AudioArbiter instproc someone_released pid {
	if { $pid == [pid] } {
		$self grab
		$self notify_observers arbiter_snatch
	}
}
AudioArbiter instproc indicator_update { } {
	$self instvar agent_ activity_ hold_
	if [$agent_ have_audio] {
		$self notify_observers arbiter_have 1
		$agent_ reset_source_offsets
	} else {
		$self notify_observers arbiter_have 0
		set hold_ 0
	}
	set activity_ [$agent_ unix_time]
}
AudioArbiter instproc grab {} {
	$self instvar agent_
	$agent_ obtain
	$self indicator_update
}
AudioArbiter instproc request {} {
	$self instvar agent_ priority_
	$agent_ obtain
	if [$agent_ have_audio] {
		$self indicator_update
	} else {
		$self send "audio-request [pid] $priority_"
	}
}
AudioArbiter instproc demand {} {
	$self instvar agent_
	$agent_ obtain
	if [$agent_ have_audio] {
		$self indicator_update
	} else {
		$self send "audio-demand [pid]"
	}
}
AudioArbiter instproc hold v {
	$self instvar hold_ agent_
	set hold_ $v
	if { $hold_ && ![$agent_ have_audio] } {
		$self demand
	}
}
AudioArbiter instproc timeout {} {
	$self instvar activity_ agent_ id_ hold_
	if { [$agent_ have_audio] && !$hold_ } {
		if [$agent_ is_active] {
			$agent_ clear_active
			set activity_ [$agent_ unix_time]
		} else {
			set r [$self get_option idleDropTime]
			if { $r && [$agent_ unix_time] - $activity_ > \
			    $r } {
				$self give_it_up 0
			}
		}
	}
	set id_ [after 5000 "$self timeout"]
}
Class AudioPanel
AudioPanel instproc init { top agent } {
	frame $top.panel
	pack $top.panel -side right -fill y
	set w $top.panel.audio
	frame $w
	pack $w -expand 1 -fill y
	frame $w.spkr -borderwidth 0
	$self instvar spkr_meter_ mike_meter_ agent_ arbiter_
	set agent_ $agent
	set arbiter_ [new AudioArbiter $agent]
	set spkr_meter_ [$self mk.pane $w.spkr output speaker listen]
	frame $w.mike -borderwidth 0
	set mike_meter_ [$self mk.pane $w.mike input mike talk]
	pack $w.spkr $w.mike -side left -expand 1 -fill y
	set f [$self get_option ctrlFont]
	checkbutton $top.panel.button -text "Keep Audio" -font $f \
		-command "$self invoke_keep_audio" \
		-variable [$self tkvarname audioHeld] -anchor c \
		-relief ridge -borderwidth 2 -highlightthickness 0
	global keepAudioButton
	set keepAudioButton $top.panel.button
	$self invoke_keep_audio
	pack $top.panel.button -fill x -side top -anchor c
}
AudioPanel instproc mute_invoke { w which } {
	$self instvar agent_ arbiter_ $which\_mute_
	if { "[[$self set $which\_mute_] get-val]" == "unmuted" } {
		$agent_ set_$which\_mute 0
		if ![$agent_ have_audio] {
			$arbiter_ demand
		}
	} else {
		$agent_ set_$which\_mute 1
	}
}
AudioPanel instproc invoke_keep_audio {} {
	$self instvar arbiter_
	$self tkvar audioHeld
	$arbiter_ hold $audioHeld
}
AudioPanel instproc setgain { which level } {
	$self instvar agent_
	$agent_ set_$which\_gain $level
}
AudioPanel instproc enable_meters yesno { 
	$self instvar spkr_meter_ mike_meter_ agent_
	if $yesno {
		$agent_ bind_transducer output $spkr_meter_
		$agent_ bind_transducer input $mike_meter_
	} else {
		$agent_ bind_transducer output ""
		$agent_ bind_transducer input ""
		$spkr_meter_ set_level 0.
		$mike_meter_ set_level 0.
	}
}
AudioPanel instproc lookup_bitmap { name } {
	switch -glob $name {
		mike { return mike }
		mic* { return mike }
		speaker { return speaker }
		jack { return headphone }
		lineout2 { return lineout2 }
		lineout3 { return lineout3 }
		lineout* { return lineout }
		line*in2 { return linein2 }
		cd*       { return linein2 }
		linein3 { return linein3 }
		line*in { return linein }
		mix*    { return linein3 }
		synth*  { return linein3 }
		default { return linein3 }
	}
}
AudioPanel instproc setPort { which button scale port } {
	$self instvar agent_
	$agent_ set_$which\_port $port
	$button configure -bitmap [$self lookup_bitmap $port]
	$scale set [$agent_ get_$which\_gain]
}
AudioPanel instproc changePort { which button scale } {
	$self instvar agent_
	set ports [$agent_ get_$which\_ports]
	set n [$agent_ get_$which\_portno]
	if { $n < 0 } {
		return
	}
	incr n
	if { $n >= [llength $ports] } {
		set n 0
	}
	$self setPort $which $button $scale [lindex $ports $n]
}
AudioPanel instproc mk.pane { w which bitmap label } {
	set f [$self get_option audioFont]
	frame $w.mute -borderwidth 1 -relief raised
	set cb [new CheckButton $w.mute.b -text $label -font $f -relief ridge \
		-anchor c \
		-command "$self mute_invoke $w.mute.b $which" \
		-borderwidth 2 \
		-onvalue unmuted \
		-offvalue muted \
		-highlightthickness 0]
	$cb set-val unmuted
	$self instvar $which\_mute_ 
	set $which\_mute_ $cb
	pack $w.mute.b -expand 1 -fill x
	frame $w.select -borderwidth 2 -relief raised
	button $w.select.b -bitmap $bitmap -relief flat -borderwidth 2 \
		-command "$self changePort $which $w.select.b $w.frame.scale" \
		-height 24 -highlightthickness 1
	pack $w.select.b -expand 1 -fill x
	$self instvar agent_
	if { [llength [$agent_ get_$which\_ports]] <= 1 } {
		$w.select.b configure -state disabled
	}
	frame $w.frame -borderwidth 2 -relief raised
	set meter [new Meter/Linear $w.frame.meter]
	scale $w.frame.scale -orient vertical \
			-showvalue 0 \
			-from 256 -to 0 \
			-command "$self setgain $which" \
			-relief groove -borderwidth 2 -length 200 \
			-highlightthickness 0
	global $which\Scale $which\PortButton
	set $which\Scale $w.frame.scale
	set $which\PortButton $w.select.b
	pack $w.frame.meter $w.frame.scale -side left -expand 1 -fill y
	pack $w.mute $w.select -fill x
	pack $w.frame -expand 1 -fill y
	return $meter
}
AudioPanel instproc ptt-press {} {
	$self instvar input_mute_
	if { "[$input_mute_ get-val]" == "muted" } {
		$input_mute_ invoke
	}
}
AudioPanel instproc ptt-release {} {
	$self instvar input_mute_
	if { "[$input_mute_ get-val]" == "unmuted" } {
		$input_mute_ invoke
	}
}
AudioPanel instproc set_recv_only v {
	$self instvar input_mute_
	if $v {
		$self ptt-release
		$input_mute_ configure -state disabled
	} else {
		$input_mute_ configure -state normal
	}
}
AudioPanel instproc action {} {
	$self instvar agent_ arbiter_ output_mute_
	if { ![$agent_ have_audio] && "[$output_mute_ get-val]" == "unmuted" } {
		$arbiter_ request
	}
}
Class UISrcList -superclass TopLevelWindow
UISrcList instproc init w {
	$self instvar nSRCLIST_
	set nSRCLIST_ 0
	$self next $w$nSRCLIST_
	$self instvar bottom_
	set bottom_ 2
	$self build $w$nSRCLIST_
	incr nSRCLIST_
}
UISrcList instproc build w {
	$self create-window $w "Vic Participants"
	wm geometry $w 300x320
	wm minsize $w 0 0
	$self instvar srclist_
	frame $w.b -borderwidth 2 -relief sunken
	scrollbar $w.b.scroll -relief groove -borderwidth 2 \
			-command "$w.b.list yview"
	canvas $w.b.list -relief groove -borderwidth 0 \
		-height 10 -width 10 -yscrollcommand "$w.b.scroll set" 
	set srclist_ $w.b.list
	button $w.ok -text " Dismiss " -borderwidth 0 -relief raised \
		-command "wm withdraw $w" -font [$self get_option medfont] 
	pack $w.b -fill both -expand 1
	pack $w.b.scroll -side left -fill y
	pack $w.b.list -side left -expand 1 -fill both
	pack $w.ok -fill x
}
UISrcList instproc register src {
	$self next
	$self instvar nametag_ srclist_ bottom_ srcstate_
	set srcstate_($src) 1
	set f [$self get_option medfont]
	set nametag_($src) [$srclist_ create text 5 $bottom_  \
			-font $f -text [$src addr] -anchor nw ]
	set bottom_ [lindex [$srclist_ bbox $nametag_($src)] 3]
	incr bottom_ 2
	$srclist_ config -scrollregion "0 0 2.5i $bottom_"
}
UISrcList instproc change_name src {
	$self instvar srclist_ nametag_
	if [info exists nametag_($src)] {
		$srclist_ itemconfigure $nametag_($src) -text [$src getid]
	}
}
UISrcList instproc adjustNames { thresh h } {
	$self instvar nametag_ srclist_ bottom_
	foreach s [array names nametag_] {
		set y [lindex [$srclist_ coords $nametag_($s)] 1]
		if { $y > $thresh } {
			$srclist_ move $nametag_($s) 0 -$h
		}
	}
	incr bottom_ -$h
	$srclist_ config -scrollregion "0 0 2.5i $bottom_"
}
UISrcList instproc unregister src {
	$self instvar nametag_ srclist_
	global name_line info_line
	destroy_rtp_stats $src
	if [info exists name_line($src)] {
		unset name_line($src)
		unset info_line($src)
	}
	set thresh [lindex [$srclist_ coords $nametag_($src)] 1]
	set bb [$srclist_ bbox $nametag_($src)]
	set height [expr [lindex $bb 3] - [lindex $bb 1]]
	incr height 2
	$srclist_ delete $nametag_($src)
	unset nametag_($src)
	$self adjustNames $thresh $height
}
UISrcList instproc trigger_idle src {
	$self instvar nametag_ srclist_ srcstate_
	if [info exists nametag_($src)] {
		if [$src lost] {
			$srclist_ itemconfigure $nametag_($src) -stipple gray50
			set srcstate_($src) 2
		} else {
			$srclist_ itemconfigure $nametag_($src) -stipple {}
			set srcstate_($src) 1
		}
	}
}
Class VicUI -superclass {UISrcList Observer}
VicUI instproc build.bar { w controlWindow helpWindow exitCmd } {
	global title
	frame $w.bar -relief ridge -borderwidth 2
	label $w.bar.title -text "VIC v[version]" -font [$self get_option smallfont] \
		-relief flat -justify left
	button $w.bar.quit -text Quit -relief raised \
		-font [$self get_option smallfont] -command $exitCmd \
		-highlightthickness 1
	button $w.bar.menu -text Menu -relief raised \
		-font [$self get_option smallfont] -highlightthickness 1 \
		-command "$controlWindow toggle"
	button $w.bar.help -text Help -relief raised \
		-font [$self get_option smallfont] -highlightthickness 1 \
		-command "$helpWindow toggle"
	pack $w.bar.title -side left -fill both -expand 1
	pack $w.bar.menu $w.bar.help $w.bar.quit -side left -padx 1 -pady 1
}
proc lookup_visual {} {
	set vlist [winfo visualsavailable .]
	if { [lsearch -exact $vlist "truecolor 24"] >= 0 || \
		 [lsearch -exact $vlist "truecolor 32"] >= 0 } {
		set visual "truecolor 24"
	} elseif { [lsearch -exact $vlist "truecolor 16"] >= 0 } {
		set visual "truecolor 16"
	} elseif { [lsearch -exact $vlist "pseudocolor 8"] >= 0 } {
		set visual "pseudocolor 8"
	} elseif { [lsearch -exact $vlist "staticgray 1"] >= 0 } {
		set visual "staticgray 1"
	} else {
		puts stderr "vic: no support for your display type {$vlist}"
		exit 1
	}
}
VicUI instproc init_visual w {
	$self instvar gamma_ dither_
	Application set colormap_ $w
	set dither [$self get_option dither]
	if { $dither == "best" } {
		set dither ED
	}    
	if { $dither == "dither" } {
		set dither Dither
	}
	if { $dither == "gray" } {
		set dither Gray
	}
	if { $dither == "quantize" } {
		set dither Quant
	}
	set gamma_ [$self get_option gamma]
	if { [lsearch -exact "Dither ED Gray Quant" $dither] < 0 } {
		puts stderr "vic: unknown dither: $dither"
		exit 1
	}
	set visual [$self get_option visual]
	if { $visual == "" } {
		set visual [lookup_visual]
	} elseif { $visual == "pseudocolor" } {
		set visual "pseudocolor 8"
	}
	set cmap ""
	if [$self yesno privateColormap] {
		set cmap "-colormap new"
	}
	if [catch "frame $w -visual {$visual} $cmap"] {
		$self fatal "bad visual: $visual"
	}
	if { [winfo depth $w] == 8 } {
		set dither_ $dither
	} else {
		set dither_ ""
	}
	Application set visual_ $visual
}
set vmap(truecolor) TrueColor
set vmap(pseudocolor) PseudoColor
VicUI instproc init_color {} {
	global vmap
	$self instvar dither_ gamma_ colorModel_
	if [info exists colorModel_] {
		delete $colorModel_
		unset colorModel_
	}
	set colormap [Application set colormap_]
	set v [winfo visual $colormap]
	set v $vmap($v)
	set d [winfo depth $colormap]
	if { $d == 8 } {
		set id $v/$d/$dither_
	} else {
		set id $v/$d
	}
	if { $id == "TrueColor/32" } {
		set id TrueColor/24
	}
	set cm [new Colormodel/$id]
	if { $cm == "" } {
		puts stderr "vic: unsupported visual type: $v"
		exit 1
	}
	$cm visual $colormap
	$cm gamma $gamma_
	if ![$cm alloc-colors] {
		delete $cm
		return 0
	}
	set colorModel_ $cm
	return 1
}
VicUI instproc revert_to_gray {} {
	$self instvar dither_
	if { $dither_ == "Gray" } {
		puts stderr "vic: out of colors"
		exit 1
	}
	new ErrorWindow "ran out of colors; reverting to gray"
	$self set_dither Gray
}
VicUI instproc set-dither d {
	$self instvar dither_
	set dither_ $d
	if ![$self init_color] {
		$self revert_to_gray
	}
	foreach s [$self active-sources] {
		$self trigger_format $s
	}
}	
VicUI instproc window-title { prefix name } {
	$self instvar name_ prefix_
	set name_ $name
	set prefix_ $prefix
	wm iconname . "$prefix_$name_"
	wm title . "$prefix_$name_"
	proc mark_icon mark "$self mark-icon \$mark"
}
VicUI instproc mark-icon mark {
	$self instvar name_ prefix_
	global current_icon_mark
	if {$mark != $current_icon_mark} {
		set current_icon_mark $mark
		append mark $prefix_$name_
		wm iconname . $mark
	}
}
VicUI instproc init { w app agent vpipe } {
	$self next $w
	if {$app != "mui"} {
		$self build_gui $w $app $agent $vpipe
	}
}
VicUI instproc build_gui { w app agent vpipe } {
	$self init_visual $w.top
	$self instvar videoAgent_ app_ userwindows_ grid_ label_ \
			controlMenu_ path_ vpipe_
	set videoAgent_ $agent 
	set vpipe_ $vpipe
	set app_ $app
	global V
	if ![$self init_color] {
		if { [winfo depth $w.top] != 8 } {
			puts stderr "vic: internal error: no colors"
			exit 2
		}
		puts stderr \
		    "vic: warning: ran out of colors; using private colormap"
		destroy $w.top
		frame $w.top -visual [Application set visual_] -colormap new
		if ![$self init_color] {
			puts stderr "vic: internal error: no colors"
			exit 2
		}
	}
	$self set_rate_vars [$agent set session_]
	frame $w.top.f
	set grid_ $w.top.f.grid
	frame $grid_
	set label_ $w.top.f.label
	label $label_ -text "Waiting for video..."
	bind . <Enter> { focus %W }
	bind . <q> "$app exit"
	bind . <Control-c> "$app exit"
	bind . <Control-d> "$app exit"
	foreach i { 1 2 3 4 } {
		bind . <Key-$i> "$self redecorate $i"
	}
	set controlMenu_ [new ControlMenu $app_ $self $agent $vpipe]
	$self build.bar $w.top $controlMenu_ \
		[new VicHelpWindow .help] "$app exit"
	bind . <t> "$controlMenu_ build_window ; $controlMenu_ invoke_transmit"
	pack $w.top.f -expand 1 -fill both
	pack $w.top.bar -fill x
	pack $w.top -expand 1 -fill both
	pack $label_ -anchor c -expand 1 -side left -fill both
	$self instvar curcol_ currow_ ncol_
	set curcol_ 0
	set currow_ 0
	set ncol_ [$app_ get_option tile]
	$self instvar id_
	set id_ [after 1000 "$self periodic_update"]
	if { ![$self yesno vain] && [$agent have_network] } {
		Switcher set ignore_([$agent local]) 1
	}
	set cb [$app set cb_]
	if { $cb != "" } {
		set head "foreach s \[$agent active_list] "
		CoordinationBus instproc cb_switcher msg [concat $head {{
			if { [$s addr] == $msg || [$s sdes cname] == $msg } {
				Switcher focus $s
				return
			}
		}}]
		$cb register focus cb_switcher
	}
}
Class VideoArbiter -superclass {GlobalBus Observable}
VicUI instproc set-geometry {} {
	set geom [$self get_option geometry]
	wm withdraw .
	wm geometry . $geom
	update idletasks
	set minwidth [winfo reqwidth .]
	set minheight [winfo reqheight .]
	if { $minwidth < 200 } {
		set minwidth 200
	}
	if { $minheight < 100 } {
		set minheight 100
	}
	wm minsize . $minwidth $minheight
	wm deiconify .
}
VicUI instproc active-sources {} {
	$self instvar active_
	return [array names active_]
}
VicUI instproc add_active { as src } {
	$self instvar active_ grid_ label_
	set active_($src) $as
	if { [array size active_] == 1 } {
		pack forget $label_
		pack $grid_ -expand 1 -fill x -anchor n 
	}
}
VicUI instproc rm_active src {
	$self instvar active_ grid_ label_
	unset active_($src)
	if { [array size active_] == 0 } {
		pack forget $grid_
		pack $label_ -anchor c -expand 1 -side left
	}
}
VicUI instproc periodic_update { } {
	$self instvar videoAgent_ vpipe_ id_
	if [$vpipe_ running] {
		update_rate [$videoAgent_ set session_]
	}
	update idletasks
	set id_ [after 1000 "$self periodic_update"]
}
VicUI instproc set_rate_vars src {
	global fpshat bpshat lhat shat
	if [info exists fpshat($src)] {
		unset fpshat($src)
		unset bpshat($src)
		unset lhat($src)
		unset shat($src)
	}
	set gain [$self get_option filterGain]
	set fpshat($src) 0
	rate_variable fpshat($src) $gain
	set bpshat($src) 0
	rate_variable bpshat($src) $gain
	set lhat($src) 0
	rate_variable lhat($src) $gain
	set shat($src) 0
	rate_variable shat($src) $gain
}
VicUI instproc select-thumbnail as {
	foreach uw [$as user-windows] {
		if { [$uw attached-source] == "$as" && ![$uw is-switched] } {
			$uw destroy
			return
		}
	}
	$self instvar controlMenu_ app_ path_
	new UserWindow $self $as $controlMenu_ [$app_ coord-bus]
}
VicUI instproc use_scuba {} {
	$self instvar app_
        if { [$app_ get_option useScuba] == "" } {
		return 0
	} else {
		return 1
	}
}
VicUI instproc new_hostspec {} {
	$self instvar controlMenu_
	if [info exists controlMenu_] {
		$controlMenu_ new_hostspec
	}
}
VicUI instproc trigger_sdes src {
	global src_info src_nickname src_name
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set src_nickname($src) $addr
			set info $addr/[$src format_name]
		} else {
			set src_nickname($src) $cname
			set info "$addr/[$src format_name]"
		}
	} elseif [cname_redundant $name $cname] {
		set src_nickname($src) $name
		set info $addr/[$src format_name]
	} else {
		set src_nickname($src) $name
		set info $cname/[$src format_name]
	}
	set msg [$src sdes note]
	if { $msg != "" } {
		set info $msg
	}
	set src_info($src) $info
	if { ![info exists src_name($src)] || "$src_name($src)" != "$name" } {
		set src_name($src) $name
		$self change_name $src
	}
}
proc window_highlight { w color } {
	if { $w != "" } {
		$w configure -background $color
		foreach child [winfo children $w] {
			window_highlight $child $color
		}
	}
}
proc set_background { w color } {
	$w configure -background $color
}
Class ActiveSource -superclass TkWindow
ActiveSource instproc update {} {
	$self instvar src_ parent_
	global ftext
	if ![info exists ftext($src_)] {
		return
	}
	update_rate $src_
	$parent_ trigger_sdes $src_
	after 1000 "$self update"
}
ActiveSource instproc destroy {} {
	$self instvar vw_ info_win_ rtp_win_ decoder_win_ scuba_win_
	$vw_ destroy
	if [info exists info_win_] {
		delete $info_win_
	}
	if [info exists rtp_win_] {
		delete $rtp_win_
	}
	if [info exists decoder_win_] {
		delete $decoder_win_
	}
	if [info exists scuba_win_] {
		delete $scuba_win_
	}
	$self next
}
ActiveSource instproc create-info-window {} {
	$self instvar src_ info_win_
	if [info exists info_win_] {
		$self delete-info-window
	} else {
		set info_win_ [new InfoWindow .info$src_ $src_ $self]
	}
}
ActiveSource instproc delete-info-window {} {
	$self instvar info_win_
	delete $info_win_
	unset info_win_
}
ActiveSource instproc stats {} {
	$self instvar src_
	return "Kilobits [expr [$src_ layer-stat nb_] >> (10-3)] \
		Frames [$src_ layer-stat nf_] \
		Packets [$src_ layer-stat np_] \
		Missing [$src_ missing] \
		Misordered [$src_ layer-stat nm_] \
		Runts [$src_ layer-stat nrunt_] \
		Dups [$src_ layer-stat ndup_] \
		Bad-S-Len [$src_ set badsesslen_] \
		Bad-S-Ver [$src_ set badsessver_] \
		Bad-S-Opt [$src_ set badsessopt_] \
		Bad-Sdes [$src_ set badsdes_] \
		Bad-Bye [$src_ set badbye_]"
}
ActiveSource instproc decoder-stats {} {
	$self instvar src_
	set d [$src_ handler]
	return [$d stats]
}
ActiveSource instproc create-rtp-window {} {
	$self instvar src_ rtp_win_
	if [info exists rtp_win_] {
		$self delete-rtp-window
	} else {
		set rtp_win_ [new RtpStatWindow .rtp$src_ $src_ \
					"RTP Statistics" \
					"$self stats" \
					"$self delete-rtp-window"]
	}
}
ActiveSource instproc delete-rtp-window {} {
	$self instvar rtp_win_
	delete $rtp_win_
	unset rtp_win_
}
ActiveSource instproc create-decoder-window {} {
	$self instvar src_ decoder_win_
	if [info exists decoder_win_] {
		$self delete-decoder-window
	} else {
		if { "[$src_ handler]" == "" } {
			new ErrorWindow "no decoder stats yet"
			return
		}
		set decoder_win_ [new RtpStatWindow .decoder$src_ $src_  \
				"Decoder Statistics" \
				"$self decoder-stats" \
				"$self delete-decoder-window"]
	}
}
ActiveSource instproc delete-decoder-window {} {
	$self instvar decoder_win_
	if [info exists decoder_win_] {
		delete $decoder_win_
		unset decoder_win_
	}
}
ActiveSource instproc build_info_menu {src m} {
	menu $m
	set f [$self get_option smallfont]
	$m add command -label "Site Info" \
		-command "$self create-info-window" -font $f
	$m add command -label "RTP Stats"\
		-command "$self create-rtp-window" -font $f
	$m add command -label "Decoder Stats" \
		-command "$self create-decoder-window" -font $f
	$self instvar parent_
	if [in_multicast [[$parent_ set videoAgent_] session-addr]] {
		$m add command -label "Mtrace from" \
			-command "create_mtrace_window $src from" -font $f
		$m add command -label "Mtrace to" \
			-command "create_mtrace_window $src to" -font $f
	}
	$parent_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$m add command -label "Scuba Info" -font $f \
			-command "$self create-scuba-window"
	}
}
ActiveSource instproc create-scuba-window {} {
	$self instvar scuba_win_ parent_ src_
	$parent_ instvar scuba_sess_
	if [info exists scuba_win_] {
		$self delete-scuba-window
	} else {
		set scuba_win_ [new ScubaInfoWindow .scubainfo$self \
				$src_ $self $scuba_sess_]
		[$scuba_sess_ source-manager] attach $scuba_win_
		$scuba_win_ timeout
	}
}
ActiveSource instproc delete-scuba-window {} {
	$self instvar scuba_win_ parent_
	$parent_ instvar scuba_sess_
	[$scuba_sess_ source-manager] detach $scuba_win_
	delete $scuba_win_
	unset scuba_win_
}
ActiveSource instproc init { parent w src color cmenu } {
	$self next $w
	if { $parent == "mui" } {
		return
	}
	frame $w -relief groove -borderwidth 0 \
		-visual [Application set visual_] \
		-colormap [Application set colormap_]
	$self instvar src_ parent_ vw_ userwindows_ videoboxes_ cmenu_
	set cmenu_ $cmenu
	set src_ $src
	set parent_ $parent
	set userwindows_ ""
	set videoboxes_ ""
	after 1000 "$self update"
	set f [$self get_option smallfont]
	set stamp $w.stamp
	frame $stamp -relief ridge -borderwidth 2
	bind $stamp <Enter> "%W configure -background gray90"
	bind $stamp <Leave> "%W configure -background \
		[$self get_option background]"
	set vw_ [new VideoWidget $stamp.video 80 60]
	$vw_ set is_slow_ 1
	$vw_ attach-decoder $src [$parent_ set colorModel_] [$cmenu use-hw]
	pack $stamp.video -side left -anchor c -padx 2
	pack $stamp -side left -fill y
	frame $w.r
	frame $w.r.cw -relief groove -borderwidth 2
	pack $w.r.cw -side left -expand 1 -fill both -anchor w -padx 0
	label $w.r.cw.name -textvariable src_nickname($src) -font $f \
		-pady 1 -borderwidth 0 -anchor w 
	label $w.r.cw.addr -textvariable src_info($src) -font $f \
		-pady 1 -borderwidth 0 -anchor w
	global ftext btext ltext
	set ftext($src) "0.0 f/s"
	set btext($src) "0.0 kb/s"
	set ltext($src) "(0%)"
	frame $w.r.cw.rateinfo
	label $w.r.cw.rateinfo.fps -textvariable ftext($src) -width 6 \
		-font $f -pady 0 -borderwidth 0
	label $w.r.cw.rateinfo.bps -textvariable btext($src) -width 8 \
		-font $f -pady 0 -borderwidth 0
	label $w.r.cw.rateinfo.loss -textvariable ltext($src) -width 6 \
		-font $f -pady 0 -borderwidth 0
	frame $w.r.ctrl -borderwidth 0
	global mutebutton
	set mutebutton($src) [$cmenu mute-new-sources]
	$src mute $mutebutton($src)
	checkbutton $w.r.ctrl.mute -text mute -borderwidth 2 \
		-highlightthickness 1 \
		-relief groove -font $f -width 4 \
		-command "$src mute \$mutebutton($src)" \
		-variable mutebutton($src)
	checkbutton $w.r.ctrl.color -text color -borderwidth 2 \
		-highlightthickness 1 \
		-relief groove -font $f -width 4 \
		-command "\[$src handler\] color \$colorbutton($src)" \
		-variable colorbutton($src)
	set m $w.r.ctrl.info.menu$src
	menubutton $w.r.ctrl.info -text info... -borderwidth 2 \
		-highlightthickness 1 \
		-relief groove -font $f -width 5 \
		-menu $m
	$self build_info_menu $src $m
	pack $w.r.ctrl.mute -side left -fill x -expand 1
	pack $w.r.ctrl.color -side left -fill x -expand 1
	pack $w.r.ctrl.info -side left -fill both -expand 1
	global colorbutton
	set colorbutton($src) 1
	pack $w.r.cw.rateinfo.fps $w.r.cw.rateinfo.bps $w.r.cw.rateinfo.loss \
		-side left -anchor w
	pack $w.r.cw.name $w.r.cw.addr $w.r.cw.rateinfo -anchor w -fill x
	pack $w.r.cw -fill x -side top
	pack $w.r.ctrl -fill x -side top
	pack $w.r -side left -expand 1 -fill x
	bind $stamp.video <1> "$parent select-thumbnail $self"
	bind $stamp.video <Enter> { focus %W }
	bind $stamp.video <d> "$src deactivate"
	return $stamp.video
}
ActiveSource instproc isCIF {} {
	$self instvar src_
	return [expr [string compare [$src_ format_name] h261] == 0]
}
ActiveSource instproc use-hw {} {
	return [$parent_ use-hw]
}
ActiveSource instproc attach-window uw {
	$self instvar src_ parent_ cmenu_
	[$uw video-widget] attach-decoder $src_ [$parent_ set colorModel_] [$cmenu_ use-hw]
	$self instvar userwindows_
	lappend userwindows_ $uw
	$uw set-name [$src_ getid]
	$parent_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_focus $src_
	}
}
ActiveSource instproc attach_videobox { vb } {
	$self instvar src_ parent_ cmenu_ vb_
	puts "$self attach_videobox $vb"
	set vb_ $vb
	[$vb get_video_widget] attach-decoder $src_ [$parent_ set colorModel_] [$cmenu_ use-hw]
	$self instvar videoboxes_
	lappend videoboxes_ $vb
	$parent_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_focus $src_
	}
}
ActiveSource instproc user-windows {} {
	return [$self set userwindows_]
}
ActiveSource instproc video_boxes {} {
	return [$self set videoboxes_]
}
ActiveSource instproc detach-window uw {
	$self instvar userwindows_ src_ parent_
	$parent_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_unfocus $src_
	}
	[$uw video-widget] detach-decoder $src_
	set k [lsearch -exact $userwindows_ $uw]
	if { $k < 0 } {
		puts "vic: detach_window: XXX"
		exit 1
	}
	set userwindows_ [lreplace $userwindows_ $k $k]
}
ActiveSource instproc detach_videobox vb {
	$self instvar videoboxes_ src_ parent_
	$parent_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_unfocus $src_
	}
	[$vb get_video_widget] detach-decoder $src_
	set k [lsearch -exact $videoboxes_ $vb]
	if { $k < 0 } {
		puts "vic: detach_window: XXX"
		exit 1
	}
	set videoboxes_ [lreplace $videoboxes_ $k $k]
}
ActiveSource instproc detach-windows {} {
	$self instvar userwindows_
	foreach uw $userwindows_ {
		$self detach-window $uw
	}
}
ActiveSource instproc detach_videoboxes {} {
	$self instvar videoboxes_
	foreach vb $videoboxes_ {
		$self detach_videobox $vb
	}
}
VicUI instproc bump { } {
	$self instvar curcol_ currow_ ncol_
	incr curcol_
	if { $curcol_ == $ncol_ } {
		set curcol_ 0
		incr currow_
	}
}
VicUI instproc redecorate n {
	$self instvar curcol_ currow_ ncol_
	set curcol_ 0
	set currow_ 0
	set ncol_ $n
	$self instvar grid_
	if ![info exists grid_] {
		return
	}
	set w $grid_
	foreach src [$self active-sources] {
		grid $w.$src -row $currow_ -column $curcol_ -sticky we
		grid columnconfigure $w $curcol_ -weight 1
		$self bump
	}
}
VicUI instproc trigger_media src {}
VicUI instproc activate src {
	after idle "$self really_activate $src"
}
VicUI instproc really_activate src {
	$self instvar grid_ curcol_ currow_ controlMenu_
	set as [new ActiveSource $self $grid_.$src $src 1 $controlMenu_]
	$self add_active $as $src
	grid $grid_.$src -row $currow_ -column $curcol_ -sticky we
	grid columnconfigure $grid_ $curcol_ -weight 1
	$self update_decoder $src
	$self bump
	if [$self yesno demo] {
		update
	}
}
VicUI instproc update_decoder src {
	$self set_rate_vars $src
	$self trigger_sdes $src
}
VicUI instproc trigger_format src {
	$self instvar active_ videoAgent_
	if ![info exists active_($src)] {
		return
	}
	set as $active_($src)
	set L [$as user-windows]
	$as detach-windows
	set extoutList [extout_detach_src $src]
	set d [$videoAgent_ create_decoder $src]
	$self update_decoder $src
	global colorbutton
	$d color $colorbutton($src)
	foreach uw $L {
		$as attach-window $uw
		[$uw video-widget] redraw
	}
	extout_attach_src $src $extoutList
}
VicUI instproc decoder_changed src {
	$self instvar active_
	if ![info exists active_($src)] {
		return
	}
	set as $active_($src)
	set L [$as user-windows]
	$as detach-windows
	set extoutList [extout_detach_src $src]
	foreach w $iw {
		$as attach-window $uw
		$w redraw
	}
	extout_attach_src $src $extoutList
	return
}
VicUI instproc change_name src {
	set name [$src sdes name]
	$self instvar active_
	if [info exists active_($src)] {
		set as $active_($src)
		foreach uw [$as user-windows] {
			if { [$uw attached-source] == "$as" } {
				$uw set-name $name
			}
		}
	}
	$self next $src
}
VicUI instproc set-gamma s {
	$self instvar colorModel_ gamma_
	global win_src
	set cm $colorModel_
	if ![$cm gamma $s] {
		return -1
	}
	set gamma_ $s
	$cm free-colors
	if ![$cm alloc-colors] {
		$self revert_to_gray
	}
	foreach src [session active] {
		set d [$src handler]
		if { $d != "" } {
			$d redraw
		}
	}
	return 0
}
VicUI instproc deactivate src {
	$self instvar active_
	if [info exists active_($src)] {
		set as $active_($src)
		set L [$as user-windows]
		foreach uw $L {
			delete $uw
		}
		$as detach-windows
		$as delete-decoder-window
	}
	$self instvar grid_
	set w $grid_.$src
	if [winfo exists $w] {
		grid forget $w
		destroy $w
		$self rm_active $src
	}
	$src handler ""
	global ftext btext ltext fpshat bpshat lhat shat
	unset ftext($src)
	unset btext($src)
	unset ltext($src)
	unset fpshat($src)
	unset bpshat($src)
	unset lhat($src)
	unset shat($src)
}
proc update_rate src {
	global ftext btext ltext fpshat bpshat lhat shat V
	set key $src
	if [string match Session/* [$src info class]] {
		set bpshat($key) [expr 8 * [$src set nb_]]
		set fpshat($key) [$src set nf_]
	} else {
		set p [$src layer-stat np_]
		set s [$src ns]
		set shat($key) $s
		set lhat($key) [expr $s-$p]
		if {$shat($key) <= 0.} {
			set loss 0
		} else {
			set loss [expr 100*$lhat($key)/$shat($key)]
		}
		if {$loss < .1} {
			set ltext($key) (0%)
		} elseif {$loss < 9.9} {
			set ltext($key) [format "(%.1f%%)" $loss]
		} else {
			set ltext($key) [format "(%.0f%%)" $loss]
		}
		set bpshat($key) [expr 8 * [$src layer-stat nb_]]
		set fpshat($key) [$src layer-stat nf_]
	}
	set fps $fpshat($key)
	set bps $bpshat($key)
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.0f kb/s" [expr $bps / 1000]]
	} else {
		set bps [format "%.1f Mb/s" [expr $bps / 1000000]]
	}
	set ftext($key) $fps
	set btext($key) $bps
}
Class VicHelpWindow -superclass HelpWindow
VicHelpWindow instproc build w {
	$self create-window $w "vic help" {
"Transmit video by clicking on the ``Transmit'' button \
in the ``Menu'' window.  You need video capture hardware to do this."
"Incoming video streams appear in the main vic window.  \
If you see the message ``Waiting for video...'', then no one is transmitting \
video to the conference address you're running on.  Otherwise, you'll \
see a thumbnail sized image and accompanying information for each source. \
Click on the thumbnail to open a larger viewing window.  You can tile the \
thumbnails in multiple columns using the ``Tile'' menu in the ``Menu'' window."
"Clicking on the ``mute'' button for a given source will \
turn off decoding.  It is usually a good idea to do \
this for your own, looped-back transmission."
"The transmission rate is controlled with the bit-rate \
and frame-rate sliders in the ``Transmission'' panel of the ``Menu'' window.  \
The more restrictive setting limits the transmission rate."
"The video windows need not be fixed to a given source. \
The ``Mode...'' menu attached to a viewing window allows you to specify \
voice-switched and/or timer-switched modes.   In timer-switched mode, the \
window automatically cycles through (unmuted) sources, while in \
oice-switched mode, the window switches to whomever is talking \
(using cues from vat).  You can have more than one voice-switched window, \
which results in a simple LRU allocation of the windows to most recent \
speakers.  See the man page for more details."
"If the user interface looks peculiar, you might \
have X resources that conflict with tk.  A common problem is \
defining ``*background'' and/or ``*foreground''."
"Bugs and suggestions to mash-developers@mash.cs.berkeley.edu.  Thanks."
	}
}
proc info_text src {
	set d [$src handler]
	set fmt [$src format_name]
	if { "$d" != "" } {
		    set fmt "$fmt [$d cmd info] ([$d width]x[$d height])"
	}
	return "$fmt"
}
VicUI instproc create-audio-ui agent {
	$self instvar audioUI_ path_
	set audioUI_ [new VicAudioUI $path_.top.f $self $agent]
}
VicUI instproc attach-audio agent {
	$self instvar audioUI_ path_
	set audioUI_ [new VicAudioUI $path_.top.f $self $agent]
}
Class VicAudioUI
VicAudioUI instproc init { w mainUI agent } {
	$self instvar mainUI_ panel_
	set mainUI_ $mainUI 
	set panel_ [new AudioPanel $w $agent]
	global meterDisable
	set meterDisable 0
	$panel_ install_meters
	$panel_ ptt-release
	$agent select_format PCM 2
}
VicAudioUI instproc destroy {} {
	$self instvar panel_
	delete $panel_
}
VicAudioUI instproc register src {
	puts "VicAudioUI::register [$src getid]"
}
VicAudioUI instproc activate src {
	puts "ACTIVATE: [$src getid]"
}
VicAudioUI instproc trigger_media src {
	puts "AUDIO-FROM: [$src getid]"
}
VicAudioUI instproc trigger_idle src {
	puts "IDLE: [$src getid] [$src lost]"
}
VicAudioUI instproc trigger_sdes src {
	puts "SDES: [$src getid]"
}
AnnounceListenManager public init { mtu spec } {
	$self next $mtu
	$self instvar snet_ rnet_
	set spec [split $spec /]
	set snet_ ""
	set rnet_ ""
	if { [llength $spec] == 1 } {
		set rnet_ [new Network]
		$rnet_ open $spec
	} else {
		set addr [lindex $spec 0]
		set ports [split [lindex $spec 1] :]
		set sport [lindex $ports 0]
		if { [llength $ports] == 2 } {
			set rport [lindex $ports 1]
		} else {
			set rport $sport
		}
		set ttl [lindex $spec 2]
		set snet_ [new Network]
		if [in_multicast $addr] {
			$snet_ open $addr $sport $rport $ttl
			set rnet_ $snet_
		} else {
			if { $rport != 0 } {
				set rnet_ [new Network]
				$rnet_ open $rport
			}
			$snet_ open $addr $sport 0 1
		}
	}
	if { $snet_ != "" } {
		$snet_ loopback 1
		$self send-network $snet_
	} 
	if { $rnet_ != "" } {
		$self recv-network $rnet_
	}
}
AnnounceListenManager public destroy {} {
	$self instvar snet_ rnet_
	if { $rnet_ == $snet_} {
		delete $snet_
	} else {
		if { $snet_ != "" } {
			delete $snet_
		} 
		if { $rnet_ != "" } {
			delete $rnet_
		}
	}
	$self next
}
AnnounceListenManager public start { active } {
	$self instvar timer_ active_
	set active_ $active
	$self send_announcement
}
AnnounceListenManager public stop {} {
	$self instvar timer_ active_
	set active_ 0
	$timer_ cancel
}
AnnounceListenManager private send_announcement {} {
	$self instvar timer_ active_
	if { $active_ == 1 } {
		set data [$self build_announcement]
		if { $data !=  "" } {
			$self announce $data
		}
	}
	$timer_ schedule_timer
}
Class AnnounceListenManager/AS -superclass AnnounceListenManager
Class ASTimer -superclass Timer/Adaptive/ConstBW
ASTimer instproc init { as bw } {
	$self next $bw
	$self set as_ $as
}
ASTimer instproc timeout {} {
	$self instvar as_
	$as_ send_announcement
}
AnnounceListenManager/AS instproc init { netspec bw atype } {
	random 0
	$self next 1024 $netspec
	$self instvar timer_ atype_
	set atype_ $atype
	$self instvar agentbytype_
	set agentbytype_(srv) ""
	set agentbytype_(client) ""
	set agentbytype_(hm) ""
	set timer_ [new ASTimer $self $bw]
	$timer_ set randomize_ "yes"
	$timer_ set thresh_ 3000
	set o [$self options]
	$o add_default startupWait 60
	$self instvar aliveid_
	set aliveid_ [after [expr [$self get_option startupWait]*1000] "$self check_alive 1"]
}
AnnounceListenManager/AS proc version {} {
	return 2.0
}
AnnounceListenManager/AS public build_announcement {} {
	$self instvar atype_
	set o "ASCP v[$class version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n [$self service_name]
	set o $o\n$n
	set n [$self service_location]
	set o $o\n$n
	set n [$self service_instance]
	set o $o\n$n
	set n [$self ssg_port]
	set o $o\n$n
	set n [$self agent_data]
	set o $o\n$n
	return $o
}
AnnounceListenManager/AS instproc announce_death {} {
	$self instvar id1_ id2_ atype_
	set o "ASCP v[AnnounceListenManager/AS version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n bye
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	$self announce $o
}
AnnounceListenManager/AS public agent_instance {} {
	return "[pid]@[lookup_host_name [localaddr]]"
}
AnnounceListenManager/AS public agent_data {} {
	return ""
}
AnnounceListenManager/AS public ssg_port {} {
	return "-"
}
AnnounceListenManager/AS instproc announce_bw { bw } {
	$self instvar timer_
	$timer_ set bw_ $bw
}
AnnounceListenManager/AS instproc service_location {} {
	return "-"
}
AnnounceListenManager/AS instproc destroy {} {
	$self instvar timer_ aliveid_
	delete $timer_
	after cancel $aliveid_
	$self next
}
AnnounceListenManager/AS instproc recv_announcement { addr data size } {
	$self instvar lastann_ timer_ sdp_ agentbytype_ agenttab_ atype_
	$timer_ sample-size $size
	set o [split $data \n]
	if { [lindex $o 0] != "ASCP v[$class version]" } {
		set msg "$self ($class): received non-ASCP v[$class version] announcement from $addr."
		if { $atype_ == "hm" } {
			$self instvar agent_
			$agent_ log $msg
		} else {
			puts stderr $msg
		}
 		return
	}
	set atype [lindex $o 1]
	set aspec [lindex $o 2]
	set srv_name [lindex $o 3]
	set srv_loc [lindex $o 4]
	set srv_inst [lindex $o 5]
	set ssg_port [lindex $o 6]
	set ad [join [lrange $o 7 end] \n]
	if { $srv_name == "DEATH" } {
		set msg "Received death packet from $aspec at $addr - exiting."
		if { $srv_loc == $atype_ } {
			if { $atype_ == "hm" } {
				$self instvar agent_
				$agent_ log $msg
			} else {
				puts stderr $msg
			}
			$self announce_death
			exit 0
		}
		$self recv_msg $atype $aspec $addr DEATH $srv_loc \
			$srv_inst $ssg_port "$ad"
		return
	}
	if { $srv_name == "bye" } {
		$self delete_agent $aspec
		return
	}
	if ![info exists agenttab_($aspec)] {
		$self instvar avgdelta_
		$self register $atype $aspec $addr $srv_name $srv_inst "$ad"
		set n [$timer_ set nsrcs_]
		$timer_ set nsrcs_ [expr $n+1]
		set t [$self get_option startupWait]
		set avgdelta_($aspec) [expr $t / 8]
		lappend agentbytype_($atype) $aspec
	} else {
		set now [gettimeofday]
		set delta [expr $now - $lastann_($aspec,abs)]
		$self instvar avgdelta_
		set avgdelta_($aspec) \
				[expr 0.875*$avgdelta_($aspec)+0.125*$delta]
	}
	set agenttab_($aspec) "$addr {$ad} $atype $srv_name $srv_inst"
	set lastann_($aspec,abs) [gettimeofday]
	set lastann_($aspec,ascii) [gettimeofday ascii]
	$self recv_msg $atype $aspec $addr $srv_name $srv_loc $srv_inst \
			$ssg_port "$ad"
}
AnnounceListenManager/AS instproc advance_timers { delta } {
	$self instvar lastann_ agenttab_ avgdelta_
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann_($aspec,abs) [expr $lastann_($aspec,abs)+$delta]
	}
}
AnnounceListenManager/AS instproc check_alive { timer } {
	$self instvar lastann_ agenttab_ avgdelta_
	set now [gettimeofday]
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann $lastann_($aspec,abs)
		set avgdelta $avgdelta_($aspec)
		set delta [expr $now - $lastann]
		if { $delta > 8 * $avgdelta } {
			$self delete_agent $aspec
		}
	}
	$self instvar aliveid_
	if { $timer } {
		set t [expr [$self get_option startupWait]*1000]
		set aliveid_ [after $t "$self check_alive 1"]
	}
}
AnnounceListenManager/AS instproc delete_agent { aspec } {
 	$self instvar timer_ agentbytype_ agenttab_ lastann_ avgdelta_
	if ![info exists agenttab_($aspec)] {
		return 
	}
	set a $agenttab_($aspec)
	set addr [lindex $a 0]
	set ad [lindex $a 1]
	set atype [lindex $a 2]
	set srv_name [lindex $a 3]
	set srv_inst [lindex $a 4]
	unset agenttab_($aspec)
	unset lastann_($aspec,abs)
	unset lastann_($aspec,ascii)
	unset avgdelta_($aspec)
	set t $agentbytype_($atype)
	set i [lsearch -exact $t $aspec]
	set agentbytype_($atype) [lreplace $t $i $i]
	set n [$timer_ set nsrcs_]
	$timer_ set nsrcs_ [expr $n-1]
	$self unregister $atype $aspec $addr $srv_name $srv_inst "$ad"
}
AnnounceListenManager/AS instproc agenttab aspec {
	$self instvar agenttab_
	if [info exists agenttab_($aspec)] {
		return $agenttab_($aspec)
	}
	return ""
}
AnnounceListenManager/AS instproc send_announcement {} {
	$self next
	$self check_alive 0
}
Class AnnounceListenManager/AS/Client -superclass AnnounceListenManager/AS
AnnounceListenManager/AS/Client instproc init { spec bw srv_loc } {
	$self next $spec $bw client
	$self instvar srv_inst_ srv_loc_
	set srv_loc_ $srv_loc 
}
AnnounceListenManager/AS/Client instproc service_location { } {
	$self instvar srv_loc_
	return $srv_loc_
}
Class SDPParser
Class SDPMedia
Class SDPTime
Class SDPMessage 
SDPParser instproc init { {ordered_syntax 1} } {
	$self next
	$self instvar nextsym_ ordered_syntax_ parse_error_
	set nextsym_(start) "v"
	set nextsym_(v) "o"
	set nextsym_(o) "s"
	set nextsym_(s) "i u e p c b t"
	set nextsym_(i) "u e p c b t"
	set nextsym_(u) "e p c b t"
	set nextsym_(e) "e p c b t"
	set nextsym_(p) "e p c b t"
	set nextsym_(c) "b t "
	set nextsym_(b) "t"
	set nextsym_(t) "t r z k a m"
	set nextsym_(r) "t z k a m"
	set nextsym_(z) "k a m"
	set nextsym_(k) "a m"
	set nextsym_(a) "a m"
	set nextsym_(m) "m i:m c:m b:m k:m a:m v"
	set nextsym_(i:m) "m c:m b:m k:m a:m v"
	set nextsym_(c:m) "m b:m k:m a:m v"
	set nextsym_(b:m) "m k:m a:m v"
	set nextsym_(k:m) "m a:m v"
	set nextsym_(a:m) "m a:m v"
	set ordered_syntax_ $ordered_syntax
	set parse_error_ ""
}
SDPParser instproc check_syntax { last cur media } {
	$self instvar nextsym_
	if ![info exists nextsym_($last)] {
		return ""
	}
	foreach s $nextsym_($last) {
		set t [split $s :]
		if { [lindex $t 0] == $cur } {
			return $s
		}
	}
	return ""
}
SDPParser instproc parse { announcement } {
	$self instvar parse_error_ ordered_syntax_
	set media ""
	set allmsgs ""
	set lasttag "start"
	set lines [split $announcement "\n"]
	set parse_error_ ""
	set lnum 0
	foreach line $lines {
		incr lnum
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v { 
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]	
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {	
			$msg set session_name_ $value 
		}
		i {	
			if { $media != "" } {
				$media set session_info_ $value 
			} else {
				$msg set session_info_ $value 
			}
		}
		p {
			set tmp "" 
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e { 
			set tmp "" 
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u { 
			$msg set uri_ $value
		} 
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				$media set attributes_($attname) $attval
			} else {
				$msg set attributes_($attname) $attval
			}
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_ 
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
Class MeGa
MeGa instproc init args {
	eval $self next $args
	$self set sdp_ [new SDPParser]
}
MeGa instproc destroy {} {
	$self instvar sdp_
	delete $sdp_
	$self next
}
MeGa proc ctrlchan { media spec } {
	set tmp [split $spec /]
	set addr [lindex $tmp 0]
	if ![in_multicast $addr] {
		return $spec
	}
	set port [lindex $tmp 1]
	switch $media {
	video {
		incr port 1
	}
	audio {
		incr port 2
	}
	mb {
		incr port 3
	}
	sdp {
		incr port 4
	}
	hm {
		incr port 5
	}
	}
	set ttl [lindex $tmp 2]
	return $addr/$port/$ttl
}
Class AnnounceListenManager/AS/Client/MeGa \
		-superclass { AnnounceListenManager/AS/Client MeGa }
Class AnnounceListenManager/AS/Client/MeGa/Audio \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Audio }
Class AnnounceListenManager/AS/Client/MeGa/Video \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Video }
AnnounceListenManager/AS/Client/MeGa instproc init { agent spec bw toolname media sname sspec rportspec ofmt srv_loc } {
	set spec [MeGa ctrlchan $media $spec]
	$self next $spec $bw $srv_loc 
	$self instvar agent_ toolname_ sname_ sspec_ media_ rportspec_ ofmt_
	set toolname_ $toolname
	set media_ $media
	set sname_ $sname
	set sspec_ $sspec
	set rportspec_ $rportspec
	set ofmt_ $ofmt
	set agent_ $agent
	$self instvar timer_ srv_inst_
	$timer_ set thresh_ 15000
	set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc recv_msg { atype aspec addr srv_name srv_loc srv_inst ssg_port msg } {
	if { $atype != "srv" } {
		return
	}
	$self instvar agent_ srv_inst_
	if { $srv_inst_ != $srv_inst } {
		return
	}
	$self instvar sdp_
	set msg [$sdp_ parse $msg]
	if { $msg == "" } {
		return
	}
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set curspec $addr/$sport:$rport/$ttl
	} else {
		set curspec ""
		set ttl -1
	}
	set media [$msg set allmedia_]
	$self instvar media_ rportspec_
	foreach mrec [$msg set allmedia_] {
		if [$mrec have_attr global] {
			continue
		}
		set tmp [split [$mrec set caddr_] /]
		set laddr [lindex $tmp 0]
		set lttl [lindex $tmp 1]
		set pspec [split [$mrec set port_] :]
		set sport [lindex $pspec 0]
		set rport [lindex $pspec 1]
		set myrport [lindex [split $rportspec_ :] 0]
		if { ([in_multicast $laddr] && $myrport == 0) || \
		     ($laddr == [localaddr] && $sport == $myrport) } {
	     		if { ![in_multicast $laddr] } {
				set laddr [$msg set createaddr_]
			}
	     		set newspec $laddr/$rport:$sport/$lttl
			if { $newspec != $curspec } {
				set fmt [$mrec set fmt_]
				set fmt [$self format_name $fmt]
				if { $fmt == "" } {
					set fmt null
				}
				$agent_ reset_spec \
						$laddr/$rport:$sport/$fmt/$lttl
puts "$agent_ reset $laddr/$rport:$sport/$fmt/$lttl"
				$self announce [$self build_announcement]
			}
			delete $msg
	     		return
		}
	}
	delete $msg
}
AnnounceListenManager/AS/Client/MeGa private format_name { fmt } {
	return ""
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Video private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc register { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa instproc unregister { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa public agent_data {} {
	$self instvar id1_ id2_ agent_ media_ agent_ sname_ sspec_ \
		toolname_ rportspec_ ofmt_
	set o "v=0"
	set n "o=client [pid] 0 IN IP4 [localaddr]"
	set o $o\n$n
	set n "s=$sname_"
	set o $o\n$n
	set n "c=IN IP4 $sspec_"
	set o $o\n$n
	if { $media_ == "video" } {
		set n "b=AS:[$agent_ set sessionbw_]"
		set o $o\n$n
		set n "t=0 0"
		set o $o\n$n
		if { [$self get_option localScubaScope] != "" } {
			set n "a=localscuba"
			set o $o\n$n
		}
	} else  {
		set n "t=0 0"
		set o $o\n$n
	}
	set n "a=tool:$toolname_"
	set o $o\n$n
	set fmt [$self format_num $ofmt_]
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	set n "m=$media_ $rport RTP/AVP $fmt" 
	set o $o\n$n
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set n "c=IN IP4 $addr/$sport:$rport/$ttl"
	} else {
		set n "c=IN IP4 none"
	}
	set o $o\n$n
	return $o
}
AnnounceListenManager/AS/Client/MeGa private format_num { fmt } {
	return -1
}
AnnounceListenManager/AS/Client/MeGa/Video private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc service_name {} {
	return MeGa
}
AnnounceListenManager/AS/Client/MeGa instproc service_instance {} {
	$self instvar sname_ rportspec_ media_
	set o $sname_:$media_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		set o $o:[localaddr]/$rport
	}
	return $o
}
AnnounceListenManager/AS/Client/MeGa instproc ssg_port {} {
	$self instvar rportspec_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		return [lindex $rportspec 1]
	} else {
		return "-"
	}
}
Session/Scuba set sessionbw_ 0
Session/Scuba instproc init {} {
	$self next
	$self set share_ 0.05
	$self set sessionbw_ 0
}
Session/Scuba instproc sessionbw { b } {
	$self instvar sessionbw_
	set sessionbw_ $b
	$self set_allocation
}
Session/Scuba instproc unregister { src } {
	$self clean_scoretab $src
}
Session/Scuba instproc register { src } {}
Session/Scuba instproc activate { src } {}
Session/Scuba instproc deactivate { src } {}
Session/Scuba instproc notify { src } {}
Session/Scuba instproc trigger_media { src } {}
Session/Scuba instproc trigger_format { src } {}
Session/Scuba instproc trigger_sdes { src } {}
Session/Scuba instproc trigger_idle { src } {}
Session/Scuba instproc recv_scuba_entry { sender srcid val } {
	$self instvar scoretab_
	set scoretab_($sender:$srcid) [expr $val/1e6]
}
Session/Scuba instproc clean_scoretab { src } {
	$self instvar scoretab_
	set idxs [array names scoretab_ $src:*]
	foreach i $idxs {
		unset scoretab_($i)
	}
}
Session/Scuba instproc delete_reporter { s } {
	$self clean_scoretab $s
	$self set_allocation
}
Class NetworkManager/Scuba
NetworkManager/Scuba instproc init { ab session agent } {
	$self next
	$self reset $ab
}
NetworkManager/Scuba instproc reset ab {
	set addr [$ab addr 0]
	set sport [$ab sport 0]
	incr sport -1
	set rport [$ab rport 0]
	incr rport -1
	set ttl [$ab ttl 0]
	$self instvar scubaNet_
	if ![info exists scubaNet_] {
		set scubaNet_ [new Network]
	} else {
		$scubaNet_ close
	}
	$scubaNet_ open $addr $sport $rport $ttl
}
NetworkManager/Scuba instproc destroy {} {
	$self instvar scubaNet_
	if [info exists scubaNet_] {
		delete $scubaNet_
	}
}
Class Session/Scuba/Vic -superclass { Session/Scuba Observer }
Session/Scuba/Vic instproc init { rtpsess sm ab vpipe } {
	$self next 
	$self set rtpsess_ $rtpsess
	$self source-manager $sm
	$self set vpipe_ $vpipe
	if { $ab != "" && [$ab nchan] > 0 } {
		$self reset $ab
	}
}
Session/Scuba/Vic instproc reset ab {
	$self instvar nm_ rtpsess_
	if [info exists nm_] {
		delete $nm_
	}
	set nm_ [new NetworkManager/Scuba $ab $rtpsess_ $self]
	$self scuba-net [$nm_ set scubaNet_]
	$self start-control
}		
Session/Scuba/Vic instproc set_allocation {} {
	$self instvar scoretab_ share_ rtpsess_ sessionbw_
	set sm [$self source-manager]
	if { [$sm info vars local_] == "" } {
		return
	}
	set localsrc [$sm set local_]
	set total 0
	set tot($localsrc) 0
	set al [$sm active_list]
	set zerosrcs 0
	foreach src $al {
		set srcid [$src srcid]
		set voters [array names scoretab_ *:$srcid]
		set subtotal 0
		foreach v $voters {
			set subtotal [expr $subtotal+$scoretab_($v)]
		}
		set tot($src) $subtotal
		if { $subtotal == 0 } {
			incr zerosrcs
		}
		set total [expr $total+$subtotal]
	}
	if { $total > 0 } {
		set avg [expr $tot($localsrc)/$total]
	} else {
		set avg 0
	}
	if { $avg > 0 } {
		set share_ [expr 0.95*$avg]
	} else {
		if { $zerosrcs == 0 } {
			set zerosrcs 1
		}
		set share_ [expr 0.05/$zerosrcs]
	}
	$self set_bps [expr $share_*$sessionbw_]
}
Session/Scuba/Vic instproc set_bps { bps } {
	set videoagent [$self source-manager]
	set b [expr int($bps)]
	$self instvar vpipe_
	$vpipe_ set_bps $b
	$videoagent local_bandwidth $b
	global bps_slider
	if [info exists bps_slider] {
		$bps_slider set $b
	}
}
Session/Scuba/Vic instproc build_report {} {
	$self instvar focus_set_
	if ![info exists focus_set_] {
		return 0
	}
	set sm [$self source-manager]
	if { [$sm info vars local_] == "" } {
		return 0
	}
	set localsrc [$sm set local_]
	set t 0
	set srcs [array names focus_set_]
	foreach s $srcs {
		if { $s != $localsrc && $focus_set_($s) > 0 } {
			incr t
		}
	}
	$self clean_scoretab $localsrc
	if { $t != 0 } {
		set score [expr int(1e6/$t)]
		foreach s $srcs {
			if { $focus_set_($s) > 0 && $s != $localsrc } {
				set srcid [$s srcid]
				$self add-scuba-entry $srcid $score
				$self recv_scuba_entry $localsrc \
						$srcid $score
			}
		}
	}
	$self set_allocation
	return $t
}
Session/Scuba/Vic instproc activate { src } {
	$self set focus_set_($src) 0
	$self next $src 
}
Session/Scuba/Vic instproc deactivate { src } {
	$self unset focus_set_($src)
	$self next $src 
}
Session/Scuba/Vic instproc scuba_focus { src } {
	$self instvar focus_set_
	incr focus_set_($src)
}
Session/Scuba/Vic instproc scuba_unfocus { src } {
	$self instvar focus_set_
	incr focus_set_($src) -1
}
Class VicApplication -superclass RTPApplication
VicApplication instproc init argv {
	$self next vic
	set o [$self options]
	$self init_args $o
	$self init_resources $o
	$self init_fonts $o
	$o load_preferences "rtp vic"
	set argv [$o parse_args $argv]
	set spec [$self check_hostspec $argv]
	$self check_rtp_sdes
	$self init_confbus
	set t [$self get_option maxbw]
	if { $t > 0 } {
		$o add_option maxbw [expr 1000*$t]
	}
	if { [$self get_option audioSession] != "" } {
		$o add_option geometry 330x350
	}
	$self instvar agent_ vpipe_
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
		$o add_option maxbw [$ab set maxbw_(0)]
	} else {
		set ab ""
	}
	set agent_ [new VideoAgent $ab]
	set vpipe_ [new VideoPipeline $agent_]
	set localbw [$self get_option localSessionBW]
	if { $localbw == "" } {
		set localbw [$self get_option maxSessionBW]
	}
	$agent_ sessionbw $localbw
	if { $ab != "" } {
		delete $ab
	}
	$self instvar ui_
	set ui_ [$self init_ui]
	$agent_ attach $ui_
	set prefix [$self get_option iconPrefix]
	if { $spec == "" } {
		set conf "Contacting MeGa..."
	} else {
		set conf [$self get_option conferenceName]
	}
	$ui_ window-title $prefix $conf
	set aspec [$self get_option audioSession]
	if { $aspec != "" } {
		$self instvar audioUI_ audioAgent_
		set aab [new AddressBlock $aspec]
		set audioAgent_ [new AudioAgent $self $aab]
		$audioAgent_ set-bandwidth 128000
		set audioUI_ [$ui_ create-audio-ui $audioAgent_]
		$audioAgent_ attach $audioUI_
	}
	$ui_ set-geometry
	$self user_hook
	if { [$self get_option useScuba] != "" } {
		$self init_scuba $spec 
	}
	if [$self yesno transmitOnStartup] {
		[$ui_ set controlMenu_] build_window
		[$ui_ set controlMenu_] invoke_transmit
        }
}
VicApplication instproc init_ui {} {
	$self instvar agent_ vpipe_
	set w .top$self
	frame $w
	set ui [new VicUI $w $self $agent_ $vpipe_]
	pack $w -expand 1 -fill both
	return $ui
}
VicApplication instproc exit {} {
	$self instvar agent_
	$agent_ shutdown
	exit 0
}
VicApplication private init_args o {
	$o register_option -a audioSession
	$o register_option -B maxbw
	$o register_option -C conferenceName
	$o register_option -c dither
	$o register_option -D device
	$o register_option -f defaultFormat
	$o register_option -F maxfps
	$o register_option -I confBusChannel
	$o register_option -K sessionKey
	$o register_option -M colorFile
	$o register_option -m mtu
	$o register_option -o outfile
	$o register_option -q jpegQfactor
	$o register_option -t defaultTTL
	$o register_option -T softJPEGthresh
	$o register_option -U stampInterval
	$o register_option -V visual
	$o register_option -N rtpName
	$o register_boolean_option -H useHardwareDecode
	$o register_boolean_option -P privateColormap
	$o register_option -rport megaRecvPort
	$o register_option -ofmt megaFormat
	$o register_option -usemega megaSession
	$o register_option -megactrl asCtrl
	$o register_option -sspec sessionSpec
	$o register_option -maxsbw maxSessionBW 
	$o register_option -sbw localSessionBW 
	$o register_option  -sloc serviceLocation
	$o register_boolean_option -scuba useScuba
	$o register_boolean_option -localscuba localScubaScope
}
VicApplication instproc reset { ab } {
	$self instvar scuba_sess_ ui_
	if { [$self get_option useScuba] != "" } {
		$scuba_sess_ reset $ab
	}
	$ui_ new_hostspec
	set conf [$self get_option conferenceName]
	$ui_ window-title [$self resource iconPrefix] $conf
}
VicApplication private init_fonts o {
	set foundry [$o get_option foundry]
	set helv10  [$self search_font $foundry helvetica medium 10 r]
	set helv10b [$self search_font $foundry helvetica bold 10 r]
	set helv10o [$self search_font $foundry helvetica bold 10 o]
	set helv12b [$self search_font $foundry helvetica bold 12 r]
	set times14 [$self search_font $foundry times medium 14 r]
	option add *Font $helv12b startupFile
	$o add_default medfont $helv12b
	$o add_default smallfont $helv10b
	$o add_default helpFont $times14
	$o add_default entryFont $helv10
	$o add_default audioFont $helv10
	$o add_default ctrlTitleFont $helv12b
	$o add_default ctrlFont $helv10b
	$o add_default noAudioFont $helv10o
	$o add_default siteFont $helv12b
}
VicApplication private init_resources o {
	option add *padX 2
	option add *padY 2
	option add *tearOff 0
	option add *Radiobutton.relief flat startupFile
	option add *Checkbutton.anchor w startupFile
	option add *Radiobutton.anchor w startupFile
	option add *Radiobutton.relief flat startupFile
	global tcl_platform
	if {$tcl_platform(platform) != "windows"} {
		option add *Scale.sliderForeground gray66 startupFile
		option add *Scale.activeForeground gray80 startupFile
		option add *Scale.background gray70 startupFile
		option add Vic.background gray85 startupFile
	}
	option add *VatVU.foreground black startupFile
	option add *VatVU.peak gray50 startupFile
	option add *VatVU.hot firebrick1 startupFile
	option add *VatVU.hotLevel 90 startupFile
	$o add_default geometry 250x225 
	$o add_default mtu 1024 
	$o add_default framerate 8 
	$o add_default defaultTTL 16 
	$o add_default maxbw -1 
	$o add_default bandwidth 128000 
	$o add_default iconPrefix vic: 
	$o add_default priority 10 
	$o add_default confBusChannel 0 
	$o add_default defaultFormat h.261 
	$o add_default sessionType rtpv2 
	$o add_default loopback 0
	$o add_default grabber none 
	$o add_default stampInterval 1000 
	$o add_default switchInterval 5 
	$o add_default dither Dither 
	$o add_default tile 1 
	$o add_default filterGain 0.25 
	$o add_default statsFilter 0.0625 
	$o add_default useHardwareDecode false 
	$o add_default infoHighlightColor LightYellow2 
	$o add_default useJPEGforH261 false 
	$o add_default stillGrabber false 
	$o add_default siteDropTime "300" 
	$o add_default medianCutColors 150 
	$o add_default gamma 0.7 
	$o add_default jvColors 32 
	$o add_default foundry adobe 
	$o add_default suppressUserName true 
	$o add_default softJPEGthresh -1 
	$o add_default softJPEGcthresh 6 
	$o add_default sunvideoDevice 0 
	$o add_default vain false 
	$o add_default sdesList "cname tool email note"
	$o add_default disabledColor gray50 
	$o add_default highlightColor gray95 
	$o add_default idleDropTime "20" 
	$o add_default defaultPriority "100" 
	$o add_default megaFormat h261
	$o add_default megaRecvPort 0
	$o add_default asCtrl 224.4.5.24/50000/31
	$o add_default asCtrlBW 20000
	$o add_default serviceLocation urn:vgw
	$o add_default maxSessionBW 128000
}
VicApplication instproc init_confbus {} {
	set channel [$self get_option confBusChannel]
	$self instvar cb_
	if { $channel != "" && $channel != 0 } {
		set cb_ [new CoordinationBus $channel]
	} else {
		set cb_ ""
	}
}
VicApplication instproc coord-bus {} {
	return [$self set cb_]
}
VicApplication private init_scuba { spec } {
	$self instvar agent_ scuba_sess_ al_
	set rtpsess [$agent_ set session_]
	$rtpsess rtcp-thumbnail 1
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
	} else {
		set ab ""
	}
	$self instvar vpipe_
	set scuba_sess_ [new Session/Scuba/Vic $rtpsess $agent_ $ab $vpipe_]
	if { $ab != "" } {
		delete $ab
	}
	$self instvar ui_
	$ui_ set scuba_sess_ $scuba_sess_
	$agent_ attach $scuba_sess_
	set localbw [$self get_option localSessionBW]
	if { $localbw == "" } {
		set localbw [$self get_option maxSessionBW]
	}
	$scuba_sess_ sessionbw $localbw
	if { [$self resource megaSession] != "" } {
		set sname [$self get_option megaSession]
		set sspec [$self get_option sessionSpec]
		set rportspec [$self get_option megaRecvPort]
		set ofmt [$self get_option megaFormat]
		set bw [expr 0.02*$localbw]
		set megaspec [$self get_option asCtrl]
		set loc [$self get_option serviceLocation]
		set al_ [new AnnounceListenManager/AS/Client/MeGa/Video \
				$agent_ $megaspec $bw vic video \
				$sname $sspec $rportspec $ofmt $loc]
		$al_ start 1
	}
}
new VicApplication $argv
