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

#
# 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)
#
Import enable
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 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}"
}
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
}
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
}
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 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 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"
}
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
	}
}
proc mark_icon args {} 
Class VatUI -superclass Observer
Class AudioControlMenu -superclass TopLevelWindow
Class VatHelpWindow -superclass HelpWindow
set title "MASH Demo: LBL vat v[version]"
AudioControlMenu instproc init { agent ui panel } {
	$self next .menu
	$self instvar ui_ agent_ panel_
	set agent_ $agent
	set ui_ $ui
	set panel_ $panel
	$self setup_tkvars
	$self tkvar audioFormat silenceThresh
	if { $audioFormat != "" } {
		if { [$agent select_format [string range $audioFormat 0 2] \
				[string range $audioFormat 3 4]] < 0 } {
			puts stderr "vat: unknown audio format: $audioFormat"
			exit 1
		}
	}
	if { $silenceThresh != "" } {
		$agent set_silence_thresh $silenceThresh
	}
	$self enable_meters
	$self tkvar recvOnly
	$ui set_recv_only $recvOnly
	if { $recvOnly || [$self yesno mikeMute] } {
		$panel_ ptt-release
	}
}
AudioControlMenu instproc test_tone type {
	$self instvar agent_ panel_
	$panel_ action
	$agent_ audio_test $type
}
AudioControlMenu instproc mk.tests { w } {
	label $w.label -text "Audio Tests" -font [$self get_option ctrlTitleFont]
	frame $w.frame -borderwidth 2 -relief sunken
	frame $w.frame.p1
	frame $w.frame.p2
	set f [$self get_option ctrlFont]
	set p $w.frame.p1
	$self instvar agent_
	radiobutton $p.none -text none -relief flat \
		-command "$self test_tone none" \
		-anchor w -variable [$self tkvarname audioTest] \
		-font $f -value none
	$p.none select
	pack $p.none -fill x
	$self instvar agent_
	if ![$agent_ is_halfduplex] {
		radiobutton $p.loop -text "loopback" -relief flat \
			-command "$self test_tone loopback" -value loopback \
			-anchor w -variable [$self tkvarname audioTest] \
			-font $f
		pack $p.loop -fill x
	}
	set p $w.frame.p2
	radiobutton $p.t6 -text "-6dBm tone" -relief flat -value t6 \
		-command "$self test_tone low" -anchor w \
		-variable [$self tkvarname audioTest] -font $f
	radiobutton $p.t0 -text "0dBm tone" -relief flat -value t0 \
		-command "$self test_tone med" -anchor w \
		-variable [$self tkvarname audioTest] -font $f
	radiobutton $p.tmax -text "max tone" -relief flat -value tmax \
		-command "$self test_tone max" -anchor w \
		-variable [$self tkvarname audioTest] -font $f
	pack $p.t6 $p.t0 $p.tmax -expand 1 -fill x
	pack $w.frame.p1 -side left -anchor center
	pack $w.frame.p2 -side left -expand 1 -fill both
	pack $w.label -fill x
	pack $w.frame -fill both -expand 1
	$self tkvar audioTest
	set audioTest none
}
AudioControlMenu instproc enable_meters {} {
	$self instvar panel_
	$self tkvar meterEnable
	$panel_ enable_meters $meterEnable
}
AudioControlMenu instproc set-pri p {
	$self instvar ui_ panel_
	[$panel_ set arbiter_] set-pri $p
}
AudioControlMenu instproc pri_accept { w pri } {
	$self tkvar audioPri
	if { $audioPri == 0 } {
		$self set-pri $pri
	}
	return 0
}
AudioControlMenu instproc mk.pri { w } {
	label $w.label -text "Priority" -font [$self get_option ctrlTitleFont]
	frame $w.frame -borderwidth 2 -relief sunken
	set f [$self get_option ctrlFont]
	set p $w.frame.inset
	frame $p -borderwidth 0
	pack $p -anchor c
	radiobutton $p.high -text "high (200)" -relief flat -value 200 \
		-variable [$self tkvarname audioPri] \
		-command "$self set-pri 200" -font $f
	radiobutton $p.med -text "med (100)" -relief flat -value 100 \
		-variable [$self tkvarname audioPri] \
		-command "$self set-pri 100" -font $f
	radiobutton $p.low -text "low (10)" -relief flat -value 10 \
		-variable [$self tkvarname audioPri] \
		-command "$self set-pri 10" -font $f
	frame $p.f
	radiobutton $p.f.rb -text "" -relief flat -value 0 \
		-command "$self set-pri \[$p.f.entry get\]" \
		-variable [$self tkvarname audioPri] -font $f
	new TextEntry "$self pri_accept" $p.f.entry ""
	$p.f.entry configure -width 4
	pack $p.f.rb $p.f.entry -side left
	pack $p.f.entry -side left -expand 1 -fill x
	set pri [$self get_option defaultPriority]
	if { $pri == 10 } {
		$p.low select
	} elseif { $pri == 100 } {
		$p.med select
	} elseif { $pri == 200 } {
		$p.high select
	} else {
		$p.f.rb select
	}
	$p.f.entry insert 0 $pri
	set entryTab($p.f.entry:value) $pri
	pack $p.high $p.med $p.low $p.f -expand 1 -fill x
	pack $w.label $w.frame -expand 1 -fill x
}
AudioControlMenu instproc mk.oradio { w } {
	set f [$self get_option ctrlFont]
	$self instvar agent_
	set labels [$agent_ get_output_ports]
	set i 0
	set n [llength $labels]
	while { $i < $n } {
		set p $w.p$i
		frame $p
		set port [lindex $labels $i]
		set label $port
		global omode$i
		if { $label == "speaker" } { set label "spkr" }
		label $p.label -text $label -font $f
		radiobutton $p.mmn -text "" -relief flat -value MikeMutesNet \
			-command "$agent_ set_speakerphone $port mikemutesnet" \
			-variable omode$i -font $f
		radiobutton $p.nmm -text "" -relief flat -value NetMutesMike \
			-command "$agent_ set_speakerphone $port netmutesmike" \
			-variable omode$i -font $f
		radiobutton $p.fd -text "" -relief flat -value FullDuplex \
			-command "$agent_ set_speakerphone $port fullduplex" \
			-variable omode$i -font $f
		pack $p.label $p.mmn $p.nmm $p.fd
		if { [$self yesno externalEchoCancel] } {
			radiobutton $p.ec -text "" -relief flat \
			-value EchoCancel \
			-command "$agent_ set_speakerphone $port echocancel" \
			-variable omode$i -font $f
			pack $p.ec
		}
		pack $p -side left
		set omode$i [$self get_option $port\Mode]
		eval "$agent_ set_speakerphone $port \$omode$i"
		incr i
	}
	frame $w.label
	label $w.label.blank -text "" -font $f
	label $w.label.mmn -text "Mike mutes net" -font $f
	label $w.label.nmm -text "Net mutes mike" -font $f
	label $w.label.fd -text "Full duplex" -font $f
	pack $w.label.blank $w.label.mmn $w.label.nmm $w.label.fd -anchor w
	if { [$self yesno externalEchoCancel] } {
		label $w.label.ec -text "Ext. Echo Cancel" -font $f
		pack $w.label.ec -anchor w
	}
	pack $w.label -side left
}
AudioControlMenu instproc setup_tkvars {} {
	foreach r { autoRaise keepSites sortSites muteNewSites mikeAGC \
		speakerAGC meterEnable lectureMode recvOnly } {
		$self tkvar $r
		set $r [$self yesno $r]
	}
	foreach r { audioFormat iconPrefix silenceThresh } {
		$self tkvar $r
		set $r [$self get_option $r]
	}
	set audioFormat [string toupper $audioFormat]
}
AudioControlMenu instproc query which {
	$self tkvar $which
	return [set $which]
}
AudioControlMenu instproc set_silence_thresh {} {
	$self instvar agent_
	$self tkvar silenceSuppressor silenceThresh
	if $silenceSuppressor {
		$agent_ set_silence_thresh $silenceThresh
	} else {
		$agent_ set_silence_thresh 0
	}
}
AudioControlMenu instproc mk.obuttons { w } {
	set f [$self get_option ctrlFont]
	frame $w.p0 -borderwidth 0
	frame $w.p1 -borderwidth 0
	pack $w.p0 $w.p1 -side left -fill x -anchor n
	set p $w.p0
	checkbutton $p.ar -text "Autoraise" -relief flat -font $f \
		-variable [$self tkvarname autoRaise]
	checkbutton $p.dm -text "Disable Meters" -relief flat -font $f \
		-command "$self enable_meters" \
		-variable [$self tkvarname meterEnable] \
		-onvalue 0 -offvalue 1
	checkbutton $p.nss -text "Suppress Silence" -relief flat -font $f \
		-command "$self set_silence_thresh" \
		-variable [$self tkvarname silenceSuppressor]
	$self tkvar silenceSuppressor
	$self instvar silenceSuppressorButton_
	set silenceSuppressor 1
	set silenceSuppressorButton_ $p.nss
	pack $p.ar $p.dm $p.nss -expand 1 -fill x
	set p $w.p1
	$self tkvar keepSites sortSites
	checkbutton $p.mns -text "Mute New Sites" -relief flat -font $f \
		-variable [$self tkvarname muteNewSites]
	$self instvar agent_
	checkbutton $p.kas -text "Keep All Sites" -relief flat -font $f \
	    -command "$agent_ keep-sites \[set [$self tkvarname keepSites]]" \
		-variable [$self tkvarname keepSites]
	$agent_ keep-sites $keepSites
	$agent_ site-drop-time [$self get_option siteDropTime]
	$self instvar ui_
	checkbutton $p.kss -text "Keep Sites Sorted" -relief flat -font $f \
	    -command "$ui_ keep-sorted \[set [$self tkvarname sortSites]]" \
		-variable [$self tkvarname sortSites]
	$ui_ keep-sorted $sortSites
	pack $p.mns $p.kas $p.kss -expand 1 -fill x
}
proc setAGC { w which level } {
	$w.label configure -text "$level dB"
	controller agc-$which $level
}
proc enableAGC { w which } {
	global doAGC
	if $doAGC($which) {
		controller agc-$which [$w.scale get]
		controller agc-$which-enable 1
		$w.scale configure -state normal
	} else {
		controller agc-$which-enable 0
		$w.scale configure -state disabled
	}
}
proc oneagc { w which label } {
	set f [$self get_option ctrlFont]
	checkbutton $w.button -text $label -relief flat -font $f \
		-command "enableAGC $w $which" -variable doAGC($which)
	scale $w.scale -orient horizontal \
			-showvalue 0 \
			-from -10 -to 10 \
			-command "setAGC $w $which" \
			-relief groove -borderwidth 2 -width 10 \
			-state disabled 
	label  $w.label -text "0 dB" -width 5 -font $f
	pack $w.button $w.scale $w.label -side left
	pack $w.scale -expand 1 -fill x -pady 3
	global AGCbutton
	set AGCbutton($which) $w.button
}
AudioControlMenu instproc mk.agc { w } {
	label $w.label -text "Automatic Gain Control" -font [$self get_option ctrlTitleFont]
	frame $w.frame -borderwidth 2 -relief sunken
	frame $w.frame.spkr -borderwidth 0
	frame $w.frame.mike -borderwidth 0
	oneagc $w.frame.spkr output Spkr
	$w.frame.spkr.scale set [$self get_option speakerAGCLevel]
	oneagc $w.frame.mike input Mike
	$w.frame.mike.scale set [$self get_option mikeAGCLevel]
	pack $w.frame.spkr $w.frame.mike -fill x
	pack $w.label $w.frame -expand 1 -fill x
	pack $w.frame -padx 6
}
AudioControlMenu instproc set_ssthresh { w level } {
	$self tkvar silenceThresh silenceSuppressor
	$self instvar silenceSuppressorButton_
	$w.label configure -text $level
	set silenceThresh $level
	$self set_silence_thresh
	if !$silenceSuppressor {
		$silenceSuppressorButton_ invoke
	}
}
AudioControlMenu instproc mk.ssthresh w {
	set f [$self get_option ctrlFont]
	$self tkvar silenceThresh
	label $w.button -text "Silence Thresh: " -relief flat -font $f
	scale $w.scale -orient horizontal \
			-showvalue 0 \
			-from 10 -to 60 \
			-command "$self set_ssthresh $w" \
			-relief groove -borderwidth 2 -width 10
	$w.scale set $silenceThresh
	label  $w.label -text $silenceThresh -width 3 -font $f
	pack $w.button $w.scale $w.label -side left
	pack $w.scale -expand 1 -fill x -pady 3
}
AudioControlMenu instproc mk.omode { w } {
	label $w.label -text "Output Mode" -font [$self get_option ctrlTitleFont]
	frame $w.frame -borderwidth 2 -relief sunken
	frame $w.frame.radios -borderwidth 0
	frame $w.frame.buttons -borderwidth 0
	$self instvar agent_
	if [$agent_ is_halfduplex] {
		foreach i [$agent_ get_output_ports] {
			$agent_ set_speakerphone $i mikemutesnet
		}
	} else {
		$self mk.oradio $w.frame.radios
	}
	$self mk.obuttons $w.frame.buttons
	frame $w.frame.ssthresh
	pack $w.frame.radios $w.frame.buttons \
		-anchor c -pady 4
	pack $w.label $w.frame -expand 1 -fill x
}
AudioControlMenu instproc mk.me w {
	set f [$self get_option ctrlFont]
	frame $w.mode -borderwidth 2 -relief sunken
	frame $w.mode.inset -borderwidth 0
	set p $w.mode.inset
	label $p.title -text "Tx Mode" -font $f
	pack $p.title -side top -anchor n -expand 1 -fill both
	$self instvar ui_
	checkbutton $p.lec -text "Lecture" \
		-command "$ui_ set_lecture_mode \
			\[set [$self tkvarname lectureMode]]" \
		-variable [$self tkvarname lectureMode] -font $f
	checkbutton $p.ro -text "RecvOnly" \
		-command "$ui_ set_recv_only \
			\[set [$self tkvarname recvOnly]]" \
		-variable [$self tkvarname recvOnly] -font $f
	pack $p.lec $p.ro -fill x 
	pack $p -anchor n
	pack $p -side left -expand 1 -fill x
	frame $w.fmt -borderwidth 2 -relief sunken
	label $w.fmt.title -text "Output Format" -font $f
	pack $w.fmt.title -side top
	frame $w.fmt.p1
	set p $w.fmt.p1
	$self instvar agent_
	radiobutton $p.pcm -text PCM -font $f -value PCM \
		-command "$agent_ select_format PCM 1" \
		-variable [$self tkvarname audioFormat]
	radiobutton $p.pcm2 -text PCM2 -font $f -value PCM2 \
		-command "$agent_ select_format PCM 2" \
		-variable [$self tkvarname audioFormat]
	radiobutton $p.pcm4 -text PCM4 -font $f -value PCM4 \
		-command "$agent_ select_format PCM 4" \
		-variable [$self tkvarname audioFormat]
	pack $p.pcm $p.pcm2 $p.pcm4 -expand 1 -fill x
	frame $w.fmt.p2
	set p $w.fmt.p2
	radiobutton $p.dvi -text DVI -font $f -value DVI \
		-command "$agent_ select_format ADPCM 1" \
		-variable [$self tkvarname audioFormat] 
	radiobutton $p.dvi2 -text DVI2 -font $f -value DVI2 \
		-command "$agent_ select_format ADPCM 2" \
		-variable [$self tkvarname audioFormat]
	radiobutton $p.dvi4 -text DVI4 -font $f -value DVI4 \
		-command "$agent_ select_format ADPCM 4" \
		-variable [$self tkvarname audioFormat]
	pack $p.dvi $p.dvi2 $p.dvi4 -expand 1 -fill x
	frame $w.fmt.p3
	set p $w.fmt.p3
	radiobutton $p.gsm -text GSM -font $f -value GSM \
		-command "$agent_ select_format GSM 4" \
		-variable [$self tkvarname audioFormat]
	radiobutton $p.lpc4 -text LPC4 -font $f -value LPC4 \
		-command "$agent_ select_format LPC 4" \
		-variable [$self tkvarname audioFormat]
	pack $p.gsm $p.lpc4 -expand 1 -fill x
	pack $w.fmt.p1 $w.fmt.p2 $w.fmt.p3 -side left
	pack $w.mode -side left -expand 1 -fill both
	pack $w.fmt -side left
	set ttl [$self get_option defaultTTL]
	$self tkvar audioFormat
	if {$ttl > 160} {
		$w.fmt.p1.pcm configure -state disabled
		if {$audioFormat  == "PCM"} {
			set audioFormat PCM2
		}
		if {$ttl > 192} {
			$w.fmt.p1.pcm2 configure -state disabled
			$w.fmt.p1.pcm4 configure -state disabled
			if {[regexp -nocase pcm $audioFormat]} {
				set audioFormat DVI2
			}
			if {$ttl > 200} {
				$w.fmt.p2.dvi configure -state disabled
				$w.fmt.p2.dvi2 configure -state disabled
				$w.fmt.p2.dvi4 configure -state disabled
				if {[regexp -nocase dvi $audioFormat]} {
					set audioFormat GSM
				}
			}
		}
	}
}
AudioControlMenu instproc new_hostspec {} {
	$self instvar agent_ addrlabel_
	if ![info exists addrlabel_] {
		return
	}
	set addr [$agent_ session-addr]
	set port [$agent_ session-port]
	set ttl [$agent_ session-ttl]
	$addrlabel_ configure -text \
		"Dest: $addr  Port: $port  TTL: $ttl"
}
AudioControlMenu instproc mk.info { w } {
	$self instvar agent_ addrlabel_
	set addr [$agent_ session-addr]
	set port [$agent_ session-port]
	set ttl [$agent_ session-ttl]
	label $w.label -font [$self get_option ctrlFont] -text \
		"Dest: $addr  Port: $port  TTL: $ttl"
	set addrlabel_ $w.label
	pack $w.label -expand 1 -fill x
}
AudioControlMenu instproc create-global-window {} {
	$self instvar src_ global_win_
	if [info exists global_win_] {
		$self delete-global-window
	} else {
		set global_win_ [new GlobalStatWindow .gstat \
					"RTP Statistics" \
					"$self get-global-stats" \
					"$self delete-global-window"]
	}
puts delete-in-destructor
}
AudioControlMenu instproc delete-global-window {} {
	$self instvar global_win_
	delete $global_win_
	unset global_win_
}
AudioControlMenu instproc get-global-stats {} {
	return "Foo 1"
}
AudioControlMenu instproc mk.entries { w } {
	frame $w.name
	label $w.name.label -text "Name: " -font [$self get_option ctrlFont] -anchor e -width 6
	new TextEntry "$self update_name" $w.name.entry \
	    [$self get_option rtpName]
	pack $w.name.label -side left
	pack $w.name.entry -side left -expand 1 -fill x -pady 2
	frame $w.msg
	label $w.msg.label -text "Note: " -font [$self get_option ctrlFont] -anchor e -width 6
	new TextEntry "$self update_note" $w.msg.entry ""
	pack $w.msg.label -side left
	pack $w.msg.entry -side left -expand 1 -fill x -pady 2
	$self instvar agent_
	new KeyEditor $w $agent_
	pack $w.name $w.msg $w.key -expand 1 -fill x
	frame $w.b
        button $w.b.stats -text "Global Stats" -borderwidth 2 \
                -anchor c -font [$self get_option ctrlFont] \
		-command "$self create-global-window"
	pack $w.b.stats -side left -padx 4 -pady 2 -anchor c
	pack $w.b -pady 2 -anchor c
}
AudioControlMenu instproc update_name name {
	if { $name != ""} {
		$self instvar agent_
		$agent_ set_local_sdes name $name
		return 0
	}
	return -1
}
AudioControlMenu instproc update_note note {
	$self instvar agent_
	$agent_ set_local_sdes note $note
	return 0
}
AudioControlMenu instproc mk.net { w } {
	label $w.label -text "Network" -font [$self get_option ctrlTitleFont]
	frame $w.frame -borderwidth 0
	frame $w.frame.me -borderwidth 0
	frame $w.frame.ie -borderwidth 2 -relief sunken
	frame $w.frame.ie.info -borderwidth 0
	frame $w.frame.ie.entries -borderwidth 0
	$self mk.me $w.frame.me
	$self mk.info $w.frame.ie.info
	$self mk.entries $w.frame.ie.entries
	pack $w.label $w.frame -expand 1 -fill x
	pack $w.frame -padx 6
	pack $w.frame.ie.info $w.frame.ie.entries -expand 1 -fill x
	pack $w.frame.me $w.frame.ie -expand 1 -fill x
}
AudioControlMenu instproc build w {
	$self create-window $w "vat menu"
	bind $w <Enter> "focus $w"
	frame $w.tp
	frame $w.tp.tests
	frame $w.tp.pri
	frame $w.omode
	frame $w.net
	$self mk.tests $w.tp.tests
	$self mk.pri $w.tp.pri
	$self mk.omode $w.omode
	$self mk.net $w.net
	button $w.ok -text " Dismiss " -borderwidth 2 -relief raised \
		-command "$self toggle" -font [$self get_option ctrlTitleFont]
	frame $w.pad -borderwidth 0 -height 6
	pack $w.tp.tests -side left -expand 1 -fill both -padx 2
	pack $w.tp.pri -side left -expand 1 -fill x -padx 2
	pack $w.tp $w.omode $w.net -expand 1 -fill x
	pack $w.ok -pady 6 -anchor c
	pack $w.tp -padx 4
	pack $w.omode -padx 6
}
Class SiteName -superclass SiteEntry
SiteName instproc init { src sitebox startMuted } {
	$self next $sitebox
	$self instvar src_
	set src_ $src
	$sitebox install $self
	$self text [$src getid]
	$self tag $self
	if $startMuted {
		$self toggle-mute
	}
}
SiteName instproc destroy {} {
	$self instvar info_win_ rtp_win_ decoder_win_
	if [info exists info_win_] {
		delete info_win_
	}
	if [info exists rtp_win_] {
		delete rtp_win_
	}
	if [info exists decoder_win_] {
		delete decoder_win_
	}
	$self next
}
SiteName instproc destroy_decoder_stats {} {
	$self instvar decoder_win_
	if [info exists decoder_win_] {
		delete $decoder_win_
		unset decoder_win_
	}
}
SiteEntry 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_]"
}
SiteEntry instproc decoder-stats {} {
	$self instvar src_
	set d [$src_ handler]
	return [$d stats]
}
SiteEntry instproc delete-info-window {} {
	$self instvar info_win_
	delete $info_win_
	unset info_win_
}
SiteEntry 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"]
	}
}
SiteEntry instproc delete-rtp-window {} {
	$self instvar rtp_win_
	delete $rtp_win_
	unset rtp_win_
}
SiteEntry instproc create-decoder-window src {
	$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"]
	}
}
SiteEntry instproc delete-decoder-window {} {
	$self instvar decoder_win_
	delete $decoder_win_
	unset decoder_win_
}
SiteEntry instproc toggle-mute {} {
	$self instvar src_
	set v [expr ![$src_ mute]]
	$src_ mute $v
	$self mute $v
}
SiteEntry instproc toggle-info {} {
	$self instvar src_ info_win_
	if [info exists info_win_] {
		$self delete-info-window
	} else {
		set info_win_ [new InfoWindow .info$src_ $src_ $self]
	}
}
SiteEntry instproc source {} {
	return [$self set src_]
}
proc audio_psetup {} {
	set s [audio input gain]
	puts "Vat.[lindex $s 0]Gain:	[lindex $s 1]"
	set s [audio output gain]
	puts "Vat.[lindex $s 0]Gain:	[lindex $s 1]"
	set s [controller agc-input]
	if [lindex $s 0] {
		puts "Vat.mikeAGCLevel:	[lindex $s 1]"
	}
	set s [controller agc-output]
	if [lindex $s 0] {
		puts "Vat.speakerAGCLevel:	[lindex $s 1]"
	}
}
VatUI instproc set_lecture_mode v {
	$self instvar src_name_
	foreach s [array names src_name_] {
		set h [$s handler]
		if { $h != "" } {
			$h lecture-mode $v
		}
	}
}
VatUI instproc build.bar { w controlWindow helpWindow exitCmd } {
	global title
	label $w.title -text $title -font [$self get_option ctrlFont] \
		-relief flat -justify left -width [string length $title]
	button $w.quit -text Quit -relief raised \
		-font [$self get_option ctrlFont] -command $exitCmd \
		-highlightthickness 1
	button $w.menu -text Menu -relief raised \
		-font [$self get_option ctrlFont] -highlightthickness 1 \
		-command "$controlWindow toggle"
	button $w.help -text Help -relief raised \
		-font [$self get_option ctrlFont] -highlightthickness 1 \
		-command "$helpWindow toggle"
	pack $w.title -side left -fill both -expand 1
	pack $w.menu $w.help $w.quit -side left -pady 1 -padx 1
	$self instvar titleBar_
	set titleBar_ $w.title
}
VatUI instproc arbiter_have v {
	$self instvar titleBar_
	if $v {
		$titleBar_ configure -font [$self get_option ctrlFont]
	} else {
		$titleBar_ configure -font [$self get_option noAudioFont]
	}
}
VatUI instproc arbiter_snatch {} {
	$self instvar controlMenu_
	if [$controlMenu_ query autoRaise] {
		raise .
	}
}
Sitebox instproc init { path agent } {
	$self next $path
	$self instvar path_ agent_
	set path_ $path
	set agent_ $agent
	$self bind <1> "$self leftclick %x %y 0"
	$self bind <Shift-1> "$self leftclick %x %y 1"
	$self bind <2> "$self midclick %x %y 0"
	$self bind d "$self delete_source %x %y"
}
Sitebox instproc bind { template action } {
	$self instvar path_
	bind $path_ $template $action
}
Sitebox instproc leftclick {x y m} {
	set s [$self which $x $y]
	if {"$s" != ""} {
		if [$self over-button $x $y] {
			$s toggle-mute
		} else {
			$self instvar path_
			$s toggle-info
		}
	}
}
Sitebox instproc delete_source { x y } {
	$self instvar agent_
	set srcName [$self which $x $y]
	if { "$srcName" != "" } {
		set src [$srcName source]
		if { $src != [$agent_ local] } {
			$agent_ delete $src
		}
	}
}
Sitebox instproc midclick {x y m} {
	set srcName [$self which $x $y]
	if {"$srcName" != ""} {
		set src [$srcName source]
		if [$src is_mixer] {
			set s [$src getid]
			open_dialog \
			  "can't do side conversation with $s thru mixer"
		} else {
			set fmt [$src format_name]
			if { $fmt == "" } {
				set fmt pcm2
			}
			$self instvar agent_
			set csig [$src addr]/[$agent_ session-port]
			if { [$self get_option sessionType] == "vat" } {
				set confid [$self get_option confid]
				exec vat -r -C [$src getid] -confid $confid \
						$csig/$fmt &
			} else {
				puts "vat -C [$src getid] $csig/$fmt &"
				exec vat -C \"[$src getid]\" $csig/$fmt &
			}
		}
	}
}
Class Rank
Rank instproc init {} {
	$self instvar rank_
	set rank_(0) dummy
	set rank_(1) dummy
	set rank_(2) dummy
}
Rank instproc clear src {
	$self instvar rank_
	if { $rank_(2) == "$src" } {
		set rank_(2) dummy
	}
	if { $rank_(1) == "$src" } {
		set rank_(1) $rank_(2)
		set rank_(2) dummy
	}
	if { $rank_(0) == "$src" } {
		set rank_(0) $rank_(1)
		set rank_(1) $rank_(2)
		set rank_(2) dummy
	}
}
Rank instproc touch src {
	$self instvar rank_
	set r [$src rank]
	if { $r == 1 } {
		set rank_(1) $rank_(0)
		set rank_(0) $src
		$rank_(1) rank 1
	} elseif { $r != 0 } {
		$rank_(2) rank 3
		set rank_(2) $rank_(1)
		set rank_(1) $rank_(0)
		set rank_(0) $src
		$rank_(2) rank 2
		$rank_(1) rank 1
	}
	$rank_(0) rank 0
}
VatUI instproc set_recv_only v {
	$self instvar audioPanel_
	$audioPanel_ set_recv_only $v
	if !$v {
		bind all <ButtonPress-3> "$audioPanel_ ptt-press"
		bind all <ButtonRelease-3> "$audioPanel_ ptt-release"
	} else {
		bind all <ButtonPress-3> ""
		bind all <ButtonRelease-3> ""
	}
}
VatUI instproc init { w app agent } {
	$self next
	$self instvar controlMenu_ app_ agent_
	set app_ $app
	set agent_ $agent
	bind $w <Enter> { focus %W }
	bind $w q "$app exit"
	bind $w <Control-c> "$app exit"
	bind $w <Control-d> "$app exit"
	bind $w p audio_psetup
	bind $w P audio_psetup
	frame $w.m
	frame $w.m.left
	frame $w.m.right
	frame $w.m.left.sites -relief raised -borderwidth 2
	$self instvar sitebox_
	set sitebox_ [new Sitebox $w.m.left.sites.sb $agent]
	pack $w.m.left.sites -expand 1 -fill both
	pack $w.m.left.sites.sb -expand 1 -fill both
	set a $w.m.right
	frame $a.ab
	$self instvar audioPanel_
	set audioPanel_ [new AudioPanel $a.ab $agent]
	set controlMenu_ [new AudioControlMenu $agent $self $audioPanel_]
	frame $w.bar -relief ridge -borderwidth 2
	$self build.bar $w.bar $controlMenu_ [new VatHelpWindow .vathelp] \
			"$app_ exit"
	bind $w c "$sitebox_ purge"
	bind $w C "$sitebox_ purge"
	bind $w l "$sitebox_ list"
	bind $w L "$sitebox_ list"
	bind $w o "$sitebox_ sort"
	bind $w O "$sitebox_ sort"
	pack $a.ab -expand 1 -fill both
	pack $w.m.left -side left -expand 1 -fill both
	pack $w.m.right -side left -fill y
	pack $w.m -expand 1 -fill both
	pack $w.bar -fill x
	set v [$self get_option geometry]
	if { $v != "" } { 
		if { [ catch "wm geometry . $v" ] } {
			puts "vat: bad geometry $v"
			adios
		}
	}
	bind $w <Map> { mark_icon "" }
	$self instvar rank_
	set rank_ [new Rank]
	global keepAudioButton
	if [$self yesno keepAudio] {
		$keepAudioButton invoke
	}
	if [$self yesno speakerMute] {
		$outputMutebutton invoke
	}
	global inputAGCbutton outputAGCbutton
	if [$self yesno mikeAGC] {
	}
	if [$self yesno speakerAGC] {
	}
	global inputPortButton outputPortButton inputScale outputScale
	set ports [$agent get_input_ports]
	if { [llength $ports] <= 1 } {
		$inputPortButton configure -state disabled \
			-disabledforeground [option get . foreground Button]
	}
	set plist [$self get_option inputPort]	
	set pname ""
	foreach elt $plist {
		if {[lsearch [string tolower $ports] $elt] >= 0} {
			set pname $elt
		}
	}
	if { $pname == "" } {
		set pname [lindex $ports 0]
	}
	$audioPanel_ setPort input $inputPortButton $inputScale $pname
	set ports [$agent get_output_ports]
	if { [llength $ports] <= 1 } {
		$outputPortButton configure -state disabled \
			-disabledforeground [option get . foreground Button]
	}
	set plist [$self get_option outputPort]
	set pname ""
	foreach elt $plist {
		if {[lsearch [string tolower $ports] $elt] >= 0} {
			set pname $elt
		}
	}	
	if { $pname == "" } {
		set pname [lindex $ports 0]
	}
	$audioPanel_ setPort output $outputPortButton $outputScale $pname
	set a [$audioPanel_ set arbiter_]
	$a attach_observer $self
	$a indicator_update
}
VatUI instproc new_hostspec {} {
	$self instvar controlMenu_
	$controlMenu_ new_hostspec
}
VatUI instproc destroy {} {
	$self instvar rank_ sitebox_
	delete $rank_
	delete $sitebox_
	$self next
}
proc xctrlFont { } {
	return [option get . ctrlFont Vat]
}
proc xctitlefont { } {
	return [option get . ctrlTitleFont Vat]
}
VatHelpWindow instproc build w {
	$self create-window $w "vat help" {
"Before transmitting audio, adjust the mike \
level so that the output meter peaks around 80% of full scale.  Below this\
you are hard to hear and above this your signal is distorted."
"To talk, temporarily unmute the mike by depressing\
the right mouse button anywhere in the vat window.  The mike is\
live only while the button is depressed.  For hands-free operation,\
you can leave the mike active by selecting the ``talk'' button\
above the mike icon. \
If the ``talk'' button is grayed-out, the ``recvOnly'' option is\
probably selected on the ``Menu'' panel."
"Mute individual sites by clicking on checkbox next to name."
"If your computer supports multiple audio input or output ports,
you can select which you want by clicking on mike or speaker icon."
"Prevent other vats from taking the audio device\
by clicking on the ``Keep Audio'' button.  Different vats will\
cooperate so that only one instance ever has ``Keep Audio'' selected. \
The vat label (at the bottom of the window) is italicized when\
this vat does not have control of the audio."
"Get info about a site by\
clicking (and holding) left mouse button over the site name. \
A popup menu lets you select a site description window, RTP and\
decoder statistics windows (various reception statistics for data\
coming from the site), and the `mtrace' (multicast traceroute)\
diagnostic run from the site to you or from you to the site."
"In a statistics window (the window you get by selecting either RTP\
or Decoder stats in the site popup menu), clicking the left button\
on a stat name will bring up a stripchart plotting that stat. \
The stat value is plotted every second. \
The horizontal axis has a tickmark (a vertical white\
line plotted *under* the data) every 30 seconds. \
A legend at the bottom of the window gives the vertical axis scale."
"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 vat@ee.lbl.gov.  Thanks."
	}
}
VatUI instproc create_src_name src {
	$self instvar src_name_ sitebox_ controlMenu_
	set startMuted [$controlMenu_ query muteNewSites]
	set src_name_($src) [new SiteName $src $sitebox_ $startMuted]
	$self trigger_sdes $src
}
VatUI instproc register src {
	$self instvar agent_
	if { [$self yesno displayMixers] || "$src" == [$agent_ local] } {
		$self create_src_name $src
	}
}
VatUI instproc keep-sorted sense {
	[$self set sitebox_] keep-sorted $sense
}
VatUI instproc unregister src {
	$self instvar sitebox_ src_name_ rank_
	destroy_rtp_stats $src
	if [info exists src_name_($src)] {
		$rank_ clear $src_name_($src)
		$sitebox_ remove $src_name_($src)
		unset src_name_($src)
	}
}
VatUI instproc deactivate src {
	$self instvar src_name_
	$src_name_($src) destroy_decoder_stats
	$src handler ""
}
VatUI instproc activate src {
	set decoder [$src handler]
	$self instvar controlMenu_
	$decoder lecture-mode [$controlMenu_ query lectureMode]
}
proc dummy args ""
VatUI public trigger_media src {
	$self instvar rank_ src_name_ id_
	if ![info exists src_name_($src)] {
		$self create_src_name $src
	}
	$src_name_($src) highlight 1
	$rank_ touch $src_name_($src)
	if { ![$src mute] && ![winfo ismapped .] } {
		mark_icon [$self get_option iconMark]
	}
	set id_ [after 500 "$self monitor_talk_spurt $src"]
	$self instvar audioPanel_
	$audioPanel_ action
}
VatUI private monitor_talk_spurt src {
	$self instvar agent_ audioPanel_ src_name_ id_
	if [info exists src_name_($src)] {
		set delta [expr [$agent_ ntp_time] - [$src last-data]]
		if { $delta > 20000 } {
			$src_name_($src) highlight 0
			$src enable_trigger
		} else {
			$audioPanel_ action
			set id_ [after 500 "$self monitor_talk_spurt $src"]
		}
	}
}
VatUI instproc trigger_sdes src {
	$self instvar src_name_
	global src_info src_nickname
	if ![info exists src_name_($src)] {
		$self create_src_name $src
		return
	}
	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 src_info($src) $cname/[$src format_name]
	set msg [$src sdes text]
	if { $msg != "" } {
		set info $msg
	}
	set src_info($src) $info
	if { [$src_name_($src) text] != $src_nickname($src) } {
		$src_name_($src) text $src_nickname($src)
	}
}
VatUI instproc trigger_idle src {
	$self instvar src_name_
	if [info exists src_name_($src)] {
		$src_name_($src) disable [$src lost]
	}
}
VatUI instproc trigger_format src {
	$self instvar agent_
	$agent_ deactivate $src
	$agent_ activate $src
}
proc info_text src {
	set d [$src handler]
	set fmt [$src format_name]
	if { "$d" != "" } {
		set n [expr [$d block-size] / 160]
		if { $n > 1 } {
			set fmt $fmt/$n
		}
	}
	if { $fmt == "" } {
		set fmt none
	}
	return "format: $fmt"
}
Sitebox instproc purge {} {
	$self instvar agent_
	$agent_ gen-init
	while { 1 } {
		set src [$agent_ gen-next]
		if { $src == "" } {
			return
		}
		if [$src lost] {
			$agent_ delete $src
		}
	}
}
Sitebox instproc list {} {
	$self instvar agent_
	$agent_ gen-init
	while { 1 } {
		set src [$agent_ gen-next]
		if { $src == "" } {
			return
		}
		if [$src lost] {
			set lost "*"		    
		} else {
			set lost ""
		}
		set fmt "[getid $src] \[[$src addr]/[$src srcid]"
		if [$src is_mixer] {
			set fmt "$fmt via [$src ssrc]"
		}
		set fmt "$fmt\]"
		puts $lost$fmt
	}
}
VatUI instproc window-title { prefix name } {
	$self instvar name_ prefix_
	set name_ $name
	set prefix_ $prefix
	wm iconname . "$prefix_$name_"
	wm title . "$prefix_$name_"
}
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 "-"
	}
}
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 VatApplication -superclass RTPApplication
VatApplication instproc init argv {
	$self next vat
	set o [$self options]
	$self init_args $o
	$self init_resources $o
	$self init_fonts $o
	$o load_preferences "rtp vat"
	set argv [$o parse_args $argv]
	set spec [$self check_hostspec $argv]
	$self check_rtp_sdes
	$self instvar ui_ agent_
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
	} else { 
		set ab ""
	}
	set agent_ [new AudioAgent $self $ab]
	if { $ab != "" } {
		delete $ab
	}
	if { $spec != "" } {
		$agent_ set-bandwidth 128000
	}
	$self init_confbus
	wm withdraw .
	update idletasks
	global minwidth minheight iconPrefix
	set minwidth [winfo reqwidth .]
	set minheight [winfo reqheight .]
	wm minsize . $minwidth $minheight
	set w .top$self
	frame $w
	set ui_ [new VatUI $w $self $agent_]
	pack $w -expand 1 -fill both
	update idletasks
	wm deiconify .
	$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 [$self resource iconPrefix] $conf
	if { [$self get_option 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 sbw [$self get_option sessionBW]
		set bw [expr 0.02*$sbw*1000]
		set megaspec [$self get_option asCtrl]
		set loc [$self get_option serviceLocation] 
		set al_ [new AnnounceListenManager/AS/Client/MeGa/Audio \
				$agent_ $megaspec $bw vat audio \
				$sname $sspec $rportspec $ofmt $loc]
		$al_ start 1
	}
	$self user_hook
}
VatApplication instproc reset { ab } {
	$self instvar ui_
	$ui_ new_hostspec
	set conf [$self get_option conferenceName]
	$ui_ window-title [$self resource iconPrefix] $conf
}
VatApplication instproc exit {} {
	$self instvar agent_ ui_
	delete $ui_
	$agent_ shutdown
	exit 0
}
VatApplication instproc init_args o {
	$o register_option -B maxbw
	$o register_option -C conferenceName
	$o register_option -c dither
	$o register_option -D device
	$o register_option -f audioFormat
	$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 -t defaultTTL
	$o register_option -T softJPEGthresh
	$o register_option -U stampInterval
	$o register_option -V visual
	$o register_boolean_option -r compat
	$o register_option -confid confid
	$o register_option -loopback loopback
	$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 sessionBW 
	$o register_option  -sloc serviceLocation
}
VatApplication instproc 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 helv14b [$self search_font $foundry helvetica bold 14 r]
	set times14 [$self search_font $foundry times medium 14 r]
	option add *Font $helv14b startupFile
	option add *Radiobutton.font $helv12b 100
	$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
}
VatApplication instproc init_resources o {
	option add *padX 2
	option add *padY 2
	option add *tearOff 0
	option add *Radiobutton.relief flat startupFile
	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 Vat.background gray85 startupFile
		option add *VatVU.background gray85 startupFile
		$o add_default background gray85
		$o add_default foreground black
	}
	option add *VatVU.foreground black startupFile
	option add *VatVU.peak gray50 startupFile
	option add *VatVU.hot firebrick1 startupFile
	option add *VatVU.hotLevel 90 startupFile
	if { [winfo depth .] == 1 } {
		option add *selectBackground black startupFile
		option add *selectForeground white startupFile
		option add *activeForeground black startupFile
		option add *VatVU.background white startupFile
		option add *VatVU.hot gray50 startupFile
	}
	$o add_default iconPrefix vat:
	$o add_default titleReleased gray95
	$o add_default titleHave "#aaaaaa"
	$o add_default titlePinned black
	$o add_default disabledColor gray50
	$o add_default highlightColor gray95
	$o add_default infoHighlightColor LightYellow2
	$o add_default inputGain 32
	$o add_default mikeGain 32
	$o add_default lineinGain 180
	$o add_default linein2Gain 180
	$o add_default linein3Gain 180
	$o add_default outputGain 180
	$o add_default speakerGain 180
	$o add_default jackGain 180
	$o add_default lineoutGain 180
	$o add_default lineout2Gain 180
	$o add_default speakerMute false
	$o add_default mikeMute true
	$o add_default speakerMode NetMutesMike
	$o add_default jackMode FullDuplex
	$o add_default lineoutMode NetMutesMike
	$o add_default lineout2Mode NetMutesMike
	$o add_default maxPlayout 6
	$o add_default lectureMode false
	$o add_default useNames false
	$o add_default defaultTTL 16
	$o add_default filterLength 256
	$o add_default filterMaxTaps 35
	$o add_default meterEnable true
	$o add_default meterStyle discrete
	$o add_default inputPort {mike microphone mic}
	$o add_default outputPort {speaker wave}
	$o add_default audioFormat PCM2
	$o add_default mikeAGC false
	$o add_default mikeAGCLevel 0
	$o add_default speakerAGC false
	$o add_default speakerAGCLevel 0
	$o add_default defaultPriority 100
	$o add_default idleDropTime 20
	$o add_default autoRaise true
	$o add_default externalEchoCancel false
	$o add_default silenceThresh 20
	$o add_default talkThresh 0
	$o add_default echoThresh 70
	$o add_default echoSuppressTime 400
	$o add_default keepSites false
	$o add_default muteNewSites false
	$o add_default sortSites true
	$o add_default compactSites true
	$o add_default compressionSlope 0.0625
	$o add_default key ""
	$o add_default afDevice -1
	$o add_default afBlocks 2
	$o add_default afSoftOuputGain 0
	$o add_default afSoftInputGain 0
	$o add_default siteDropTime 300
	$o add_default audioFileName /dev/audio
	$o add_default statTimeConst 0.1
	$o add_default statsFilter 0.0625
	$o add_default mtu 1024
	$o add_default maxbw -1
	$o add_default bandwidth 128
	$o add_default confBusChannel 0
	$o add_default sessionType rtp
	$o add_default loopback 0
	$o add_default foundry adobe
	$o add_default suppressUserName true
	$o add_default sdesList "cname tool email note"
	$o add_default megaFormat gsm
	$o add_default megaRecvPort 0
	$o add_default maxSessionBW 64
	$o add_default sessionBW 20
	$o add_default asCtrl 224.4.5.24/50000/31
	$o add_default asCtrlBW 20000
	$o add_default serviceLocation urn:agw
}
VatApplication instproc init_confbus {} {
	set channel [$self get_option confBusChannel]
	$self instvar cb_ agent_
	if { $channel != 0 } {
		set cb_ [new CoordinationBus $channel]
		$agent_ attach_coordbus $cb_
	} else {
		set cb_ ""
	}
}
VatApplication instproc coord-bus {} {
	return [$self set cb_]
}
new VatApplication $argv
