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

# head.tcl --
#
#       This header is added to the beginning of all mash-based tools.
#
# Copyright (c) 1993-2002 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# A. Redistributions of source code must retain the above copyright notice,
#    this list of conditions and the following disclaimer.
# B. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
# C. Neither the names of the copyright holders nor the names of its
#    contributors may be used to endorse or promote products derived from this
#    software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# @(#) $Header: /usr/mash/src/repository/mash/mash-1/head.tcl,v 1.9 2002/02/03 04:41:06 lim Exp $

Import enable
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	if [info exists name_] {
		set name $name_
	} else {
		global argv0
		if [info exists argv0] {
			set name [file tail $argv0]
		} else {
			set name mash
		}
	}
	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
			}
		}
	}
	$options_ add_default appname mash
	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_ arg_option_default_
	set arg_option_($flag) $option
	if { [lindex $args 0] == "-default" } {
		set arg_option_default_($flag) [lindex $args 1]
		set args [lrange $args 2 end]
	}
	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 public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($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_ arg_list_option_ \
			arg_option_default_
	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
		}
		set fatal_msg ""
		if [info exists arg_option_($arg)] {
			if { [llength $argv] > 0 && \
					[string index $val 0]!="-" } {
				$self add_option $arg_option_($arg) $val
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			if { [llength $argv] > 0 || \
					[string index $val 0]!="-" } {
				set o $arg_list_option_($arg)
				set l [$self get_option $o]
				lappend l $val
				$self add_option $o $l
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		$self usage
		$self fatal "unknown/invalid command option: $arg ($fatal_msg)"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]"
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .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
	}
}
Configuration public open_preferences { suffix {mode w} } {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open $mash/prefs-$suffix $mode 0644]
	return $f
}
Configuration public write_preference { file key value } {
	puts $file "$key: $value"
}
Configuration public close_preferences { file } {
	close $file
}
Class TkWindow -configuration {
	background gray85
}
Class TopLevelWindow -superclass TkWindow
TkWindow public init {path} {
	$self next
	$self instvar path_
	set path_ $path
}
TkWindow public widget_path {} {
	$self instvar path_
	return $path_
}
TkWindow instproc destroy {} {
	$self instvar path_
	if [winfo exists $path_] {
		destroy $path_
	}
	$self next
}
TkWindow instproc highlight { color } {
	$self instvar path_
	if { $path_ != "" } {
		$path_ configure -background $color
		foreach child [winfo children $path_] {
			window_highlight $child $color
		}
	}
}
TkWindow instproc set_background { color } {
	$self instvar path_
	$path_ configure -background $color
}
TopLevelWindow public 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
        wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
}
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 public init text {
	set w .dialog
	$self next $w
	catch "destroy $w"
	global V
	set applname [Application name]
	if { $applname == "" } {
		set applname "mash shell"
	}
	$self create-window $w "$applname error"
	label $w.label -text "$applname: $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 public 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 set-val v { $self set_val $v }
CheckButton instproc get-val {} { $self get_val }
CheckButton instproc unknown args {
	$self instvar path_
	eval $path_ $args
}
Class RadioButtonsObj
RadioButtonsObj public init { w labelsList args } {
    $self instvar var_ path_ numButtons_
    set path_ $w
    set var_ [TclObject getid]
    set c 0
    foreach i $labelsList {
	eval radiobutton $w.rb$c -variable $var_ $args
	$w.rb$c configure -text [list $i]
	$w.rb$c configure -value [list $i]
	pack $w.rb$c -in $w -anchor w
	incr c
    }
    set numButtons_ $c
}
RadioButtonsObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
RadioButtonsObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
RadioButtonsObj private unknown args {
    $self instvar path_ numButtons_
    for {set i 0} {$i < $numButtons_} {incr i} {
	eval $path_.rb$i $args
    }
}
Class ScaleObj
ScaleObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval scale $w -variable $var_ $args
}
ScaleObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
ScaleObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
ScaleObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
Class EntryObj
EntryObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval entry $w -textvariable $var_ $args
}
EntryObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
EntryObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
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_heuristic {} {
	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}
    if {[catch {expr $ntptime - $oddoffset}] !=0} {
	    return 0
    }
    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
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
proc invalid_addr a {
    set l [split $a .]
    if {[llength $l] != 4} { return 1 }
    foreach i $l {
	if {![is_number $i] || $i<0 || $i>255} { return 1 }
    }
    return 0
}
proc is_number n {
    if [catch {expr $n}] {
	return 0
    }
	return 1
}
proc parray {a {pattern *}} {
    upvar 1 $a array
    if ![array exists array] {
        error "\"$a\" isn't an array"
    }
    set maxl 0
    foreach name [lsort [array names array $pattern]] {
        if {[string length $name] > $maxl} {
            set maxl [string length $name]
        }
    }
    set maxl [expr {$maxl + [string length $a] + 2}]
    foreach name [lsort [array names array $pattern]] {
        set nameString [format %s(%s) $a $name]
        puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
    }
}
Class RTPApplication -superclass Application
RTPApplication public init name {
	$self next $name
}
RTPApplication public 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_heuristic]
	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
	}
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open [file join $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 megaSession } {
	if { $argv == "" } {
		if { $megaSession == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 1]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
Class AddressBlock -configuration {
	defaultTTL 1
	maxbw -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 fmt {} {
	$self instvar fmt_
	if [info exists fmt_] { return $fmt_ } else { return "" }
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	$self instvar ttl_
	if [info exists ttl_($k)] { return $ttl_($k) } else { return {} }
}
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 ($s)"
	}
	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==3 && [regexp {^[0-9]+$} $fmt] } {
			set ttl $fmt
			set fmt {}
		}
		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 set fmt_ $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 10000000
			} elseif { $ttl <= 64 } {
				set maxbw 4000000
			} elseif  { $ttl <= 128 } {
				set maxbw 1000000
			} elseif { $ttl <= 192 } {
				set maxbw 128000
			} else {
				set maxbw 56000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25
Class MMG
MMG instproc init { levels } {
	$self next
	$self instvar debug_ env_ maxlevel_
	set debug_ 0
	set env_ [lindex [split [$self info class] /] 1]
	set maxlevel_ $levels
	global rlm_debug_flag
	if [info exists rlm_debug_flag] {
		set debug_ $rlm_debug_flag
	}
	$self instvar TD TDVAR state_ subscription_
	global rlm_param
	set TD $rlm_param(init-td)
	set TDVAR $rlm_param(init-td-var)
	set state_ /S
	$self instvar layer_ layers_
	set i 1
	while { $i <= $maxlevel_ } {
		set layer_($i) [$self create-layer [expr $i - 1]]
		lappend layers_ $layer_($i)
		incr i
	}
	set subscription_ 0
	$self add-layer
	set state_ /S
	$self set_TJ_timer
}
MMG instproc set-state s {
	$self instvar state_
	set old $state_
	set state_ $s
	$self debug "FSM: $old -> $s"
}
MMG instproc drop-layer {} {
	$self dumpLevel
	$self instvar subscription_ layer_
	set n $subscription_
	if { $n > 0 } {
		$self debug "DRP-LAYER $n"
		$layer_($n) leave-group
		incr n -1
		set subscription_ $n
	}
	$self dumpLevel
}
MMG instproc add-layer {} {
	$self dumpLevel
	$self instvar maxlevel_ subscription_ layer_
	set n $subscription_
	if { $n < $maxlevel_ } {
		$self debug "ADD-LAYER"
		incr n
		set subscription_ $n
		$layer_($n) join-group
	}
	$self dumpLevel
}
MMG instproc current_layer_getting_packets {} {
	$self instvar subscription_ layer_ TD
	set n $subscription_
	if { $n == 0 } {
		return 0
	}
	set l $layer_($subscription_)
	$self debug "npkts [$l npkts]"
	if [$l getting-pkts] {
		return 1
	}
	set delta [expr [$self now] - [$l last-add]]
	if { $delta > $TD } {
		set TD [expr 1.2 * $delta]
	}
	return 0
}
MMG instproc mmg_loss {} {
	$self instvar layers_
	set loss 0
	foreach l $layers_ {
		incr loss [$l nlost]
	}
	return $loss
}
MMG instproc mmg_pkts {} {
	$self instvar layers_
	set npkts 0
	foreach l $layers_ {
		incr npkts [$l npkts]
	}
	return $npkts
}
MMG instproc check-equilibrium {} {
	global rlm_param
	$self instvar subscription_ maxlevel_ layer_
	set n [expr $subscription_ + 1]
	if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
		set eq 1
	} else {
		set eq 0
	}
	$self debug "EQ $eq"
}
MMG instproc backoff-one { n alpha } {
	$self debug "BACKOFF $n by $alpha"
	$self instvar layer_
	$layer_($n) backoff $alpha
}
MMG instproc backoff n {
	$self debug "BACKOFF $n"
	global rlm_param
	$self instvar maxlevel_ layer_
	set alpha $rlm_param(alpha)
	set L $layer_($n)
	$L backoff $alpha
	incr n
	while { $n <= $maxlevel_ } {
		$layer_($n) peg-backoff $L
		incr n
	}
	$self check-equilibrium
}
MMG instproc highest_level_pending {} {
	$self instvar maxlevel_
	set m ""
	set n 0
	incr n
	while { $n <= $maxlevel_ } {
		if [$self level_pending $n] {
			set m $n
		}
		incr n
	}
	return $m
}
MMG instproc rlm_update_D  D {
	global rlm_param
	$self instvar TD TDVAR
	set v [expr abs($D - $TD)]
	set TD [expr $TD * (1 - $rlm_param(g1)) \
				+ $rlm_param(g1) * $D]
	set TDVAR [expr $TDVAR * (1 - $rlm_param(g2)) \
		       + $rlm_param(g2) * $v]
}
MMG instproc exceed_loss_thresh {} {
	$self instvar h_npkts h_nlost
	set npkts [expr [$self mmg_pkts] - $h_npkts]
	if { $npkts >= 10 } {
		set nloss [expr [$self mmg_loss] - $h_nlost]
		set loss [expr double($nloss) / ($nloss + $npkts)]
		$self debug "H-THRESH $nloss $npkts $loss"
		if { $loss > 0.25 } {
			return 1
		}
	}
	return 0
}
MMG instproc enter_M {} {
	$self set-state /M
	$self set_TD_timer_wait
	$self instvar h_npkts h_nlost
	set h_npkts [$self mmg_pkts]
	set h_nlost [$self mmg_loss]
}
MMG instproc enter_D {} {
	$self set-state /D
	$self set_TD_timer_conservative
}
MMG instproc enter_H {} {
	$self set_TD_timer_conservative
	$self set-state /H
}
MMG instproc log-loss {} {
	$self debug "LOSS [$self mmg_loss]"
	$self instvar state_ subscription_ pending_ts_
	if { $state_ == "/M" } {
		if [$self exceed_loss_thresh] {
			$self cancel_timer TD
			$self drop-layer
			$self check-equilibrium
			$self enter_D
		}
		return
	}
	if { $state_ == "/S" } {
		$self cancel_timer TD
		set n [$self highest_level_pending]
		if { $n != "" } {
			$self backoff $n
			if { $n == $subscription_ } {
				set ts $pending_ts_($subscription_)
				$self rlm_update_D [expr [$self now] - $ts]
				$self drop-layer
				$self check-equilibrium
				$self enter_D
				return
			}
			if { $n == [expr $subscription_ + 1] } {
				$self cancel_timer TJ
				$self set_TJ_timer
			}
		}
		if [$self our_level_recently_added] {
			$self enter_M
			return
		}
		$self enter_H
		return
	}
	if { $state_ == "/H" || $state_ == "/D" } {
		return
	}
	puts stderr "rlm state machine botched"
	exit -1
}
MMG instproc relax_TJ {} {
	$self instvar subscription_ layer_
	if { $subscription_ > 0 } {
		$layer_($subscription_) relax
		$self check-equilibrium
	}
}
MMG instproc trigger_TD {} {
	$self instvar state_
	if { $state_ == "/H" } {
		$self enter_M
		return
	}
	if { $state_ == "/D" || $state_ == "/M" } {
		$self set-state /S
		$self set_TD_timer_conservative
		return
	}
	if { $state_ == "/S" } {
		$self relax_TJ
		$self set_TD_timer_conservative
		return
	}
	puts stderr "trigger_TD: rlm state machine botched $state)"
	exit -1
}
MMG instproc set_TJ_timer {} {
	global rlm_param
	$self instvar subscription_ layer_
	set n [expr $subscription_ + 1]
	if ![info exists layer_($n)] {
		return
	}
	set I [$layer_($n) timer]
	set d [expr $I / 2.0 + [trunc_exponential $I]]
	$self debug "TJ $d"
	$self set_timer TJ $d
}
MMG instproc set_TD_timer_conservative {} {
	$self instvar TD TDVAR
	set delay [expr $TD + 1.5 * $TDVAR]
	$self set_timer TD $delay
}
MMG instproc set_TD_timer_wait {} {
	$self instvar TD TDVAR
	$self instvar subscription_
	set k [expr $subscription_ / 2. + 1.5]
	$self set_timer TD [expr $TD + $k * $TDVAR]
}
MMG instproc is-recent { ts } {
	$self instvar TD TDVAR
	set ts [expr $ts + ($TD + 2 * $TDVAR)]
	if { $ts > [$self now] } {
		return 1
	}
	return 0
}
MMG instproc level_pending n {
	$self instvar pending_ts_
	if { [info exists pending_ts_($n)] && \
		 [$self is-recent $pending_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc level_recently_joined n {
	$self instvar join_ts_
	if { [info exists join_ts_($n)] && \
		 [$self is-recent $join_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc pending_inferior_jexps {} {
	set n 0
	$self instvar subscription_
	while { $n <= $subscription_ } {
		if [$self level_recently_joined $n] {
			return 1
		}
		incr n
	}
	$self debug "NO-PEND-INF"
	return 0
}
MMG instproc trigger_TJ {} {
	$self debug "trigger-TJ"
	$self instvar state_ ctrl_ subscription_
	if { ($state_ == "/S" && ![$self pending_inferior_jexps] && \
		  [$self current_layer_getting_packets])  } {
		$self add-layer
		$self check-equilibrium
		set msg "add $subscription_"
		$ctrl_ send $msg
		$self local-join
	}
	$self set_TJ_timer
}
MMG instproc our_level_recently_added {} {
	$self instvar subscription_ layer_
	return [$self is-recent [$layer_($subscription_) last-add]]
}
MMG instproc recv-ctrl msg {
	$self instvar join_ts_ pending_ts_ subscription_
	$self debug "X-JOIN $msg"
	set what [lindex $msg 0]
	if { $what != "add" } {
		return
	}
	set level [lindex $msg 1]
	set join_ts_($level) [$self now]
	if { $level > $subscription_ } {
		set pending_ts_($level) [$self now]
	}
}
MMG instproc local-join {} {
	$self instvar subscription_ pending_ts_ join_ts_
	set join_ts_($subscription_) [$self now]
	set pending_ts_($subscription_) [$self now]
}
MMG instproc debug { msg } {
	$self instvar debug_ subscription_ state_
	if {$debug_} {
		puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
	}
}
MMG instproc dumpLevel {} {
}
Class Layer
Layer instproc init { mmg } {
	$self next
	$self instvar mmg_ TJ npkts_
	global rlm_param
	set mmg_ $mmg
	set TJ $rlm_param(init-tj)
	set npkts_ 0
}
Layer instproc relax {} {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $rlm_param(beta)]
	if { $TJ <= $rlm_param(init-tj) } {
		set TJ $rlm_param(init-tj)
	}
}
Layer instproc backoff alpha {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $alpha]
	if { $TJ >= $rlm_param(max) } {
		set TJ $rlm_param(max)
	}
}
Layer instproc peg-backoff L {
	$self instvar TJ
	set t [$L set TJ]
	if { $t >= $TJ } {
		set TJ $t
	}
}
Layer instproc timer {} {
	$self instvar TJ
	return $TJ
}
Layer instproc last-add {} {
	$self instvar add_time_
	return $add_time_
}
Layer instproc join-group {} {
	$self instvar npkts_ add_time_ mmg_
	set npkts_ [$self npkts]
	set add_time_ [$mmg_ now]
}
Layer instproc leave-group {} {
}
Layer instproc getting-pkts {} {
	$self instvar npkts_
	return [expr [$self npkts] != $npkts_]
}
set rlm_debug_flag 1
Class Layer/mash -superclass Layer
Layer/mash instproc init {mmg net n} {
	$self next $mmg
	$self instvar net_ l_ n_
	set net_ $net
	set n_ $n
	set l_ [$net_ set net_($n)]
}
Layer/mash instproc join-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc leave-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc nlost {} {
	$self instvar l_
	return [$l_ nlost]
}
Layer/mash instproc npkts {} {
	$self instvar l_ n_
	return [$l_ npkts $n_]
}
Class MMG/mash -superclass MMG
MMG/mash instproc init {net caddr} {
	$self instvar net_
	set net_ $net
	$self next [$net set nchan_]
	proc ctrl$self {args} { puts "ctrl: $args" }
	$self set ctrl_ ctrl$self
}
MMG/mash instproc create-layer {layerNo} {
	$self instvar net_
	return [new Layer/mash $self $net_ $layerNo]
}
MMG/mash instproc now {} {
	return [gettimeofday]
}
MMG/mash instproc set_timer {which delay} {
	$self instvar timers_
	if [info exists timers_($which)] {
		puts "timer botched ($which)"
		exit 1
	}
	set delay [expr int($delay * 1000)]
	set timers_($which) [after $delay "$self trigger_timer $which"]
}
MMG/mash instproc trigger_timer {which} {
	$self instvar timers_
	unset timers_($which)
	$self trigger_$which
}
MMG/mash instproc cancel_timer {which} {
	$self instvar ns_ timers_
	if [info exists timers_($which)] {
		after cancel $timers_($which)
		unset timers_($which)
	}
}
MMG/mash instproc debug { msg } {
	$self instvar debug_
	if {!$debug_} { return }
	$self instvar subscription_ state_
	set time [format %.05f [$self now]]
	puts stderr "$time layer $subscription_ $state_ $msg"
}
proc uniform01 {} {
    return [expr double(([random] % 10000000) + 1) / 1e7]
}
proc uniform { a b } {
	return [expr ($b - $a) * [uniform01] + $a]
}
proc exponential mean {
	return [expr - $mean * log([uniform01])]
}
proc trunc_exponential lambda {
	while 1 {
		set u [exponential $lambda]
		if { $u < [expr 4 * $lambda] } {
			return $u
		}
	}
}
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 {
	if {$n == 1 || [winfo exists .l]} { return }
	$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]
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
	global nLayers
	set nLayers $n
}
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 port_ $rport
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	set result [$dn_ open $addr_ $sport_ $rport_ $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	set cn_ [new Network]
	set result [$cn_ open $addr_ [expr $sport_ + 1] [expr $rport_ + 1] $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	if [info exists dn_] {
		delete $dn_
	}
	if [info exists cn_] {
		delete $cn_
	}
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
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 notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
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_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	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_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
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 net_
	foreach chan [array names net_] {
		delete $net_($chan)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
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
}
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
SourceLayer/RTP set ntp_ts_sec_ 0
SourceLayer/RTP set ntp_ts_fsec_ 0
SourceLayer/RTP set mts_ 0
SourceLayer/RTP set ref_ntp_sec_ 0
SourceLayer/RTP set ref_ntp_fsec_ 0
SourceLayer/RTP set ref_mts_ 0
Source/RTP public init { sm srcid ssrc addr } {
	$self next $srcid $ssrc $addr
	$self set sm_ $sm
	$self instvar layers_
	set k 0
	set report 0
	if { [$sm info vars network_] != "" } {
		set net [$sm set network_]
		set n [$net set nchan_]
		set report [$net usingRLM]
	} else {
		set n [SourceLayer/RTP set nchan_]
	}
	while { $k < $n } {
		set l [new SourceLayer/RTP]
		lappend layers_ $l
		$self layer $k $l
		incr k
	}
	$self set reportLoss_ $report
}
Source/RTP public destroy {} {
	$self instvar sm_
	foreach layer [$self set layers_] {
		$layer destroy
	}
	if {[$self data-handler] != ""} {
		$self deactivate
	}
	$self unregister
	$sm_ delete $self;
	$self next
}
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 \
		trigger_sr \
		notify" {
	Source/RTP public $method {args} \
		"\$self instvar sm_ ; eval \$sm_ $method \$self \$args"
	MediaAgent public $method src "\$self notify_observers $method \$src"
}
MediaAgent public init {} {
	$self next
	$self set sources_ ""
}
MediaAgent public destroy {} {
	$self instvar sources_
	foreach src $sources_ {
		$src destroy;
	}
	$self next
}
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 -configuration {
	mtu 1024
	loopback 0
	siteDropTime "300"
}
RTPAgent public init {ab {callback {}} } {
	$self next
	$self instvar session_ mtu_ callback_
	if { $callback!={} } { set callback_ $callback }
	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_
	$session_ exit;
	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 {([catch {$ab info class}]) || ([$ab info class] != "AddressBlock")} {
		$self reset_spec $ab
		return
	}
	if [info exists network_] {
		set old_network $network_
	}
	set old_sources $sources_
	$session_ exit
	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 mk_local_source
	$session_ max-bandwidth [expr [$ab set maxbw_(0)]/1000.]
	$self instvar callback_
	if [info exists callback_] {
	    eval $callback_ [list $ab]
	} else {
	    catch {
			set a [Application instance]
			if [catch {$a reset $ab rtp $self}] {
				$a reset $ab
			}
		}
	}
	foreach src $old_sources {
		$src destroy;
	}
	if [info exists old_network] {
		delete $old_network
	}
}
RTPAgent private notify {src layer} {
	$self instvar network_
	if ![$network_ usingRLM] { return }
	$network_ notify-loss $src $layer
}
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 loc [$self get_option rtpLoc]
	$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 set default_ptoa_(0) pcm
RTP/Audio set default_ptoa_(1) celp
RTP/Audio set default_ptoa_(2) g721
RTP/Audio set default_ptoa_(3) gsm
RTP/Audio set default_ptoa_(5) dvi
RTP/Audio set default_ptoa_(6) dvi
RTP/Audio set default_ptoa_(7) lpc
RTP/Audio set default_ptoa_(8) pcma
RTP/Audio set default_ptoa_(9) g722
RTP/Audio set default_ptoa_(10) lin16
RTP/Audio set default_ptoa_(11) lin16
RTP/Audio set default_ptoa_(14) mpa
RTP/Audio set default_ptoa_(15) g728
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(25) cellb
RTP/Video set default_ptoa_(26) jpeg
RTP/Video set default_ptoa_(27) cuseeme
RTP/Video set default_ptoa_(28) nv
RTP/Video set default_ptoa_(29) picw
RTP/Video set default_ptoa_(30) cpv
RTP/Video set default_ptoa_(31) h261
RTP/Video set default_ptoa_(32) mpeg
RTP/Video set default_ptoa_(33) mpegs
RTP/Video set default_ptoa_(42) h263+
RTP/Video set default_ptoa_(34) h263
RTP/Audio set default_ptoa_(126) mp3
RTP/Video set default_ptoa_(127) h261v1
RTP/Video set default_ptoa_(50) sc
RTP/Audio public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
	foreach p [array names default_ptoa_] {
		$self add_mapping $p $default_ptoa_($p)
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
}
RTP/Video public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
        set rtp_ptoa_(-1) ""
	foreach p [array names default_ptoa_] {
		set rtp_ptoa_($p) $default_ptoa_($p)
		set rtp_atop_($default_ptoa_($p)) $p
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
	$self instvar classmap_
	set classmap_(pvh) PVH
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
        set classmap_(h263+) H263+
        set classmap_(h263) H263
	set classmap_(sc) SC
}
RTP/Video public classmap type {
	$self instvar classmap_
	if [info exists classmap_($type)] {
		return $classmap_($type)
	}
	return "Null"
}
RTP public add_mapping {pt fmt} {
	$self instvar rtp_ptoa_ rtp_atop_
	set rtp_ptoa_($pt) $fmt
	set rtp_atop_($fmt) $pt
}
RTP public rtp_type pt {
	$self instvar rtp_ptoa_
	if [info exists rtp_ptoa_($pt)] {
		return $rtp_ptoa_($pt)
	} elseif { $pt < 0 }  {
		return ""
	} else {
		return fmt-$pt
	}
}
RTP public rtp_fmt_number fmt {
	$self instvar rtp_atop_
	if [info exists rtp_atop_($fmt)] {
		return $rtp_atop_($fmt)
	} else {
		return -1
	}
}
RTP public rtp_format src {
	$self instvar rtp_ptoa_
	return [$self rtp_type [$src format]]
}
RTP instproc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
RTP public rtp_representation src {
	set fmt [$self rtp_format $src]
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set srcname $addr
			set srcinfo $addr/$fmt
		} else {
			set srcname $cname
			set srcinfo $addr/$fmt
		}
	} elseif [$self cname_redundant $name $cname] {
		set srcname $name
		set srcinfo $addr/$fmt
	} else {
		set srcname $name
		set srcinfo $cname/$fmt
	}
	return "{$srcname} {$srcinfo}"
}
Class Timer
Class Timer/Periodic -superclass Timer
Class Timer/Adaptive -superclass Timer
Class Timer/Adaptive/ConstBW -superclass Timer/Adaptive
Timer public init {} {
	$self next
	$self randomize 0
	$self set randwt_ 1.0
}
Timer public destroy {} {
	$self cancel
	$self next
}
Timer public randomize { {yesno 1} {randwt {}} } {
	if { $randwt!={} } {
		$self set randwt_ $randwt
	}
	if {$yesno=="yes"} {set yesno 1} elseif {$yesno=="no"} {set yesno 0}
	$self set randomize_ $yesno
}
Timer private sched { t } {
	$self msched $t
}
Timer public msched { t } {
	$self instvar id_ randomize_ randwt_
	if [info exists id_] {
		puts stderr "warning: $self ([$self info class]):\
				overlapping timers"
	}
	if $randomize_ {
		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 do_timeout"]
}
Timer private do_timeout {} {
	$self instvar id_
	if ![info exists id_] {
		puts stderr "warning: $self ($class) no timer id_"
	} else {
		unset id_
	}
	$self timeout
}
Timer public is_sched { } {
	$self instvar id_
	return [info exists id_]
}
Timer public cancel {} {
	$self instvar id_
	if [info exists id_] {
		after cancel $id_
		unset id_
	}
}
Timer/Periodic public init { {period 5000} } {
	$self next
	$self set period_ $period
}
Timer/Periodic public start { {period {}} } {
	$self instvar period_
	if { $period!={} } { set period_ $period }
	if [$self is_sched] { $self cancel }
	$self msched $period_
}
Timer/Periodic instproc do_timeout {} {
	$self instvar period_
	$self next
	if { [info commands $self]=="" } return
	$self msched $period_
}
Timer/Adaptive public init { {interval 5000} } {
	$self next
	$self set interval_ $interval
}
Timer/Adaptive public start {} {
	$self instvar interval_
	if [$self is_sched] { $self cancel }
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive public do_timeout {} {
	$self next
	if { [info commands $self]=="" } return
	$self instvar interval_
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive private adapt {interval} {
	return $interval
}
Timer/Adaptive/ConstBW public init { bw {thresh {}} {size_gain {}} } {
	$self instvar size_gain_ avgsize_ nsrcs_ bw_ thresh_ interval_
	if { $size_gain!={} } {
		set size_gain_ $size_gain
	} else {
		set size_gain_ 0.125
	}
	set avgsize_ 28
	set nsrcs_ 0
	set bw_ $bw
	if { $thresh=={} } {
		set thresh_ 500
	} else {
		set thresh_ $thresh
	}
	$self next $thresh_
}
Timer/Adaptive/ConstBW public threshold { {thresh {}} } {
    $self instvar thresh_
    if {$thresh=={}} {
	return $thresh_
    } else {
	set thresh_ $thresh
    }
}
Timer/Adaptive/ConstBW public bandwidth { {bw {}} } {
    $self instvar bw_
    if {$bw=={}} {
	return $bw_
    } else {
	set bw_ $bw
    }
}
Timer/Adaptive/ConstBW public sample_size { size } {
	$self instvar avgsize_ size_gain_
	set avgsize_ [expr $avgsize_ + $size_gain_ * ($size + 28 - $avgsize_)]
}
Timer/Adaptive/ConstBW public update_nsrcs { nsrcs } {
	$self set nsrcs_ $nsrcs
}
Timer/Adaptive/ConstBW public nsrcs { nsrcs } {
	return [$self set nsrcs_]
}
Timer/Adaptive/ConstBW public incr_nsrcs { {incr 1} } {
        $self instvar nsrcs_
        incr nsrcs_ $incr
}
Timer/Adaptive/ConstBW private adapt {interval} {
	$self instvar avgsize_ bw_ nsrcs_ thresh_
	set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
	if { $t < $thresh_ } {
		return $thresh_
	} else {
		return $t
	}
}
AnnounceListenManager public init { spec {mtu 1500} } {
	$self next $mtu
	$self instvar data_ snet_ rnet_
	set data_ ""
	set snet_ ""
	set rnet_ ""
	if [regexp {^[0-9]*$} $spec] {
		set rnet_ [new Network]
		$rnet_ open $spec
	} else {
		set ab [new AddressBlock/Simple $spec]
		set addr  [$ab addr]
		set sport [$ab sport]
		set rport [$ab rport]
		set ttl   [$ab ttl]
		delete $ab
		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_ timers_
	if { $rnet_==$snet_ } {
		delete $snet_
	} else {
		if { $snet_ != "" } {
			delete $snet_
		}
		if { $rnet_ != "" } {
			delete $rnet_
		}
	}
	if [info exists timers_] {
		foreach t [array names timers_] {
			delete $timers_($t)
		}
	}
	$self next
}
AnnounceListenManager public timer {args} {
	$self instvar timers_
	if {[llength $args]==1} {
		set d __default_timer__
		set t [lindex $args 0]
		if {$t!={}} { $t proc timeout { } "$self send_announcement" }
	} else {
		set d [lindex $args 0]
		set t [lindex $args 1]
		if {$t!={}} { $t proc timeout { } \
				[list $self send_announcement $d] }
	}
	if [info exists timers_($d)] {
		set sched [$timers_($d) is_sched]
		delete $timers_($d)
	} else {
		set sched 0
	}
	if {$t!={}} {
		set timers_($d) $t
		if $sched {
			$t start
		}
	} else {
		catch {unset timers_($d)}
	}
	return $t
}
AnnounceListenManager public get_timer {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		set d __default_timer__
	} else {
		set d [lindex $args 0]
	}
	if [info exists timers_($d)] { return $timers_($d) } else { return "" }
}
AnnounceListenManager public start {args} {
	if { [llength $args]==0 } {
		set t [$self get_timer]
	} else {
		set d [lindex $args 0]
		set t [$self get_timer $d]
	}
	if { $t=={} } {
		set t [new Timer/Periodic]
		$t randomize 1
		if [info exists d] { $self timer $d $t } else { $self timer $t}
	}
	if [info exists d] {$self send_announcement $d} \
			else {$self send_announcement}
	$t start
}
AnnounceListenManager public stop {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		foreach d [array names timers_] {
			$timers_($d) cancel
		}
	} else {
		set d [lindex $args 0]
		$timers_($d) cancel
	}
}
AnnounceListenManager public recv_announcement { addr port data len } {
	puts "ALM::recv_announcement $addr/$port \[$len\]: $data"
}
AnnounceListenManager public send_announcement {args} {
	$self instvar data_
	if {[llength $args]==0} {
		if { $data_!={} } { $self announce $data_ }
	} else {
		$self announce [lindex $args 0]
	}
}
AnnounceListenManager public set_announcement { data } {
	$self set data_ $data
}
AnnounceListenManager public get_announcement { } {
	return [$self set data_]
}
AnnounceListenManager public ttl {num} {
	$self instvar snet_
	$snet_ ttl $num
}
Class AnnounceListenManager/AS -superclass AnnounceListenManager
AnnounceListenManager/AS instproc init { netspec bw atype } {
	random 0
	$self next $netspec 1024
	$self instvar atype_
	set atype_ $atype
	$self instvar agentbytype_
	set agentbytype_(srv) ""
	set agentbytype_(client) ""
	set agentbytype_(hm) ""
	set t [new Timer/Adaptive/ConstBW $bw 3000]
	$t randomize
        $self timer $t
	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 send_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
	$self announce $o
	$self check_alive 0
}
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 service_location {} {
	return "-"
}
AnnounceListenManager/AS instproc destroy {} {
	$self instvar aliveid_
	after cancel $aliveid_
	$self next
}
AnnounceListenManager/AS instproc recv_announcement { addr port data size } {
	$self instvar lastann_ sdp_ agentbytype_ agenttab_ atype_
        set t [$self get_timer]
	$t 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"
	        $t incr_nsrcs
		set timeout [$self get_option startupWait]
		set avgdelta_($aspec) [expr $timeout / 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 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]
	[$self get_timer] incr_nsrcs -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 ""
}
Class AnnounceListenManager/AS/Client -superclass AnnounceListenManager/AS
AnnounceListenManager/AS/Client public init { spec bw srv_loc } {
	$self next $spec $bw client
	$self instvar srv_inst_ srv_loc_
	set srv_loc_ $srv_loc
}
AnnounceListenManager/AS/Client public service_location { } {
	$self instvar srv_loc_
	return $srv_loc_
}
AnnounceListenManager/AS/Client private recv_msg { atype aspec addr srv_name \
	        srv_loc srv_inst ssg_port msg } {
}
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
		set line [string trimright $line]
		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 {
			if {![info exists msg]} {
				set media ""
				set msg [new SDPMessage]
				lappend allmsgs $msg
				$msg set version_ 0
				set tmp [$msg set msgtext_]
				lappend tmp "v=0"
				$msg set msgtext_ $tmp
			}
			$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 != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $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 != "" && [regexp {[icbka]} $tag] } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append 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
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { {single_line 0} } {
    set html {}
    if $single_line { set t time1 } else { set t time }
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
			    [DynamicHTMLifier set html_(${t}_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } elseif { $varname == "spec_" } {
	    set caddr [split [$self get caddr_] /]
	    set port [$self get port_]
	    set spec [lindex $caddr 0]/$port
	    set ttl [lindex $caddr 1]
	    if { $ttl != {} } { append spec /$ttl }
	    return $spec
    } else {
	return ""
    }
}
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
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type {numonly 0} } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } elseif $numonly {
	return [clock format $sec -format {%m/%d/%y}]
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
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 2
	}
	audio {
		incr port 4
	}
	mb {
		incr port 6
	}
	sdp {
		incr port 8
	}
	hm {
		incr port 10
	}
	}
	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 srv_inst_
	[$self get_timer] threshold 15000
	set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc reset_spec {sspec} {
    $self instvar sspec_ srv_inst_ index_
    set sspec_ $sspec
    set rand [random]
    set index_ $rand
    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
				$self send_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_]"
		puts "!!SESSIONBW $n"
		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_ index_
	set o $sname_:$media_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		set o $o:[localaddr]/$rport
	    if {[info exists index_]} {
		set o $o:$index_
	    }
	}
	return $o
}
AnnounceListenManager/AS/Client/MeGa instproc agent_instance {} {
    $self instvar index_
    if {[info exists index_]} {
	return "[pid]@[lookup_host_name [localaddr]]:$index_"
    } else {
	return "[pid]@[lookup_host_name [localaddr]]"
    }
}
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 "-"
	}
}
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 } -configuration {
	megaAudioFormat gsm
	megaRecvAudioPort 0
	audioSessionBW 20
	megaAudioCtrl 224.4.5.24/50000/31
	audioServiceLocation urn:agw
}
AudioAgent public init { app spec {callback {}} } {
        if { $spec != "" } {
		set ab [new AddressBlock $spec]
		set fmt [$ab fmt]
		if { $fmt != {} } { $self add_option audioFormat $fmt }
	} else {
		set ab ""
	}
	$self next $ab $callback
	if { $ab != "" } {
		delete $ab
	}
	$self set-bandwidth 1280000
	$self site-drop-time [$self get_option siteDropTime]
	$self instvar decoders_ audioDevice_ sampRate use16bit useStereo deviceName
	set decoders_ ""
	$self instvar classmap_
	set classmap_(pcm) PCM
	set classmap_(lpc) LPC
	set classmap_(gsm) GSM
	set classmap_(dvi) ADPCM
	set classmap_(mp3) MP3
	set classmap_(lin16) PCM
	$self instvar session_
	if ![info exists sampRate] {
	    set sampRate 8000
	}
	if ![info exists use16bit] {
	    set use16bit 0
	}
	if ![info exists useStereo] {
	    set useStereo 0
	}
	if ![info exists deviceName] {
	    set audioDevice_ [new AudioStream $session_ $sampRate $use16bit $useStereo]
	} else {
	    set audioDevice_ [new AudioStream $session_ $sampRate $use16bit $useStereo $deviceName]
	}
}
AudioAgent public start_mega { } {
	$self instvar al_
	if [info exists al_] { delete $al_ }
	if { [$self get_option megaAudioSession] != "" } {
		set sname [$self get_option megaAudioSession]
		set sspec [$self get_option audioSessionSpec]
		set rportspec [$self get_option megaRecvAudioPort]
	        set ofmt [$self get_option megaAudioFormat]
		set sbw [$self get_option audioSessionBW]
		set bw [expr 0.02*$sbw*1000]
		set megaspec [$self get_option megaAudioCtrl]
	        set loc [$self get_option audioServiceLocation]
		set ab [new AddressBlock $sspec]
		set sspec [$ab addr]/[$ab sport]:[$ab rport]/[$ab ttl]
		delete $ab
		set al_ [new AnnounceListenManager/AS/Client/MeGa/Audio \
				$self $megaspec $bw [Application name] audio \
				$sname $sspec $rportspec $ofmt $loc]
		$al_ start
	}
}
AudioAgent public destroy {} {
    $self instvar al_ audioDevice_
    if [info exists audioDevice_] { delete $audioDevice_ }
    if [info exists al_] { delete $al_ }
    $self next
}
AudioAgent public reset_mega {} {
	$self instvar al_
	if ![info exists al_] {
		$self start_mega
	} else {
		$al_ reset_spec [$self get_option audioSessionSpec]
	}
}
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 instproc trigger_media src {
	$self instvar local_chan_
	if [info exists local_chan_] {
		set cname [$src sdes cname]
		if { "$cname" != "" } {
			$local_chan_ send FOCUS_SPEAKER $cname
		}
	}
	$self next $src
}
AudioAgent instproc attach_local_channel lc {
        $self set local_chan_ $lc
}
AudioAgent instproc attach_global_channel gc {
        $self set glob_chan_ $gc
}
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 classmap_ audioDevice_
    if ![info exists classmap_([$src format_name])] {
	set decoder [new Module/AudioDecoder/Null]
    } else {
	set decoder [new Module/AudioDecoder/$classmap_([$src format_name])]
    }
    if { $decoder == "" } {
	set decoder [new Module/AudioDecoder/Null]
    }
    set controller [$audioDevice_ get_controller]
    if { $controller == 0 } {
	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 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_] {
	    set set_pool_srcid_ 1
	}
}
AudioAgent instproc reset_source_offsets {} {
	$self instvar decoders_
	foreach d $decoders_ {
		$d reset-offset
	}
}
AudioAgent public bind_transducer { which o } {
    $self instvar audioDevice_
    $audioDevice_ bind_transducer $which $o
}
AudioAgent public have_audio {} {
	$self instvar audioDevice_
	if [info exists audioDevice_] {
		return [$audioDevice_ have_audio]
	}
	return 0
}
AudioAgent public set_input_mute val {
    $self instvar audioDevice_
    $audioDevice_ set_input_mute $val
}
AudioAgent public set_output_mute val {
    $self instvar audioDevice_
    $audioDevice_ set_output_mute $val
}
AudioAgent public get_input_ports {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_input_ports]
}
AudioAgent public get_output_ports {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_output_ports]
}
AudioAgent public is_halfduplex {} {
    $self instvar audioDevice_
    return [$audioDevice_ is_halfduplex]
}
AudioAgent public get_input_portno { } {
    $self instvar audioDevice_
    return [$audioDevice_ get_input_portno]
}
AudioAgent public get_output_portno { } {
    $self instvar audioDevice_
    return [$audioDevice_ get_output_portno]
}
AudioAgent public set_speakerphone { port mode } {
    $self instvar audioDevice_
    $audioDevice_ set_speakerphone $port $mode
}
AudioAgent public audio_test type {
    $self instvar audioDevice_
    $audioDevice_ audio_test $type
}
AudioAgent public port_name_to_num { which name } {
    $self instvar audioDevice_
    return [$audioDevice_ port_name_to_num $which $name]
}
AudioAgent public set_input_port port {
    $self instvar audioDevice_
    $audioDevice_ set_input_port $port
}
AudioAgent public set_output_port port {
    $self instvar audioDevice_
    $audioDevice_ set_output_port $port
}
AudioAgent public set_input_gain gain {
    $self instvar audioDevice_
    return [$audioDevice_ set_input_gain $gain]
}
AudioAgent public set_output_gain gain {
    $self instvar audioDevice_
    return [$audioDevice_ set_output_gain $gain]
}
AudioAgent public get_input_gain {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_input_gain]
}
AudioAgent public get_output_gain {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_output_gain]
}
AudioAgent public is_active {} {
    $self instvar audioDevice_
    return [$audioDevice_ is_active]
}
AudioAgent public clear_active {} {
    $self instvar audioDevice_
    $audioDevice_ clear_active
}
AudioAgent public select_format { fmt BlksPerPkt } {
    $self instvar audioDevice_
    $audioDevice_ select_format $fmt $BlksPerPkt
}
AudioAgent public set_silence_thresh thresh {
    $self instvar audioDevice_
    $audioDevice_ set_silence_thresh $thresh
}
AudioAgent public release {} {
    $self instvar audioDevice_
    $audioDevice_ release
}
AudioAgent public obtain {} {
    $self instvar audioDevice_
    $audioDevice_ obtain
}
AudioAgent instproc unix_time {} {
    $self instvar audioDevice_
    set controller [$audioDevice_ get_controller]
    if { $controller == 0 } {
	return 0
    }
    return [$controller unix_time]
}
AudioAgent instproc ntp_time {} {
    $self instvar audioDevice_
    set controller [$audioDevice_ get_controller]
    if { $controller == 0 } {
	return 0
    }
    return [$controller ntp_time]
}
Class AudioStream -configuration {
    inputGain 32
    outputGain 180
    maxPlayout 6
    mikeAGCLevel 0
    speakerAGCLevel 0
    echoSuppressTime 400
}
AudioStream public init { session sampRate use16bitPCM useStereo {deviceName {}} } {
    $self instvar bufferPool_ session_ silenceThresh_ audioTest_ sampleRate_ use16bitPCM_ useStereo_
    set silenceThresh_ 20
    set audioTest_ none
    set session_ $session
    set sampleRate_ $sampRate
    set use16bitPCM_ $use16bitPCM
    set useStereo_ $useStereo
    $self compute_controller_defaults
    if ![info exists bufferPool_] {
	set bufferPool_ [new BufferPool/RTP]
    }
    set devList [$self device_list]
    if { $devList == "" } {
	$self fatal "no suitable audio device found."
    }
    if { $deviceName != "" } {
	set d $deviceName
    } else {
	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
    }
}
AudioStream public get_controller { } {
    $self instvar controller_
    if [info exists controller_] {
	return $controller_
    }
    return 0
}
AudioStream public destroy {} {
    $self instvar bufferPool_
    if [info exists bufferPool_] {
	delete $bufferPool_
    }
    $self close_device
}
AudioStream private compute_controller_defaults {} {
    $self instvar sampleRate_ use16bitPCM_ useStereo_
	set AUDIO_SPS [expr $sampleRate_ * [expr 1 + $useStereo_]]
	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]
}
AudioStream public select_format { fmt blksPerPkt } {
	$self instvar encoder_ bufferPool_ session_ \
			controller_ blksPerPkt_
	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
}
AudioStream public device_list {} {
    if ![TclObject is-class Audio] {
	return ""
    }
    set temp [Audio info subclass]
    set ix [lsearch -exact $temp Audio/RealAudioVirtualDevice]
    if {$ix >= 0} {
	return [lreplace $temp $ix $ix]
    } else {
	return $temp
    }
}
AudioStream public bind_transducer { which o } {
    $self instvar meter_ controller_
    set meter_($which) $o
    if [info exists controller_] {
	$controller_ $which-meter $o
    }
}
AudioStream private open_device dev {
	$self instvar audio_ meter_ controller_ silenceThresh_ sampleRate_ use16bitPCM_ useStereo_
	if [info exists audio_] {
		delete $audio_
		unset audio_
	}
	if [info exists controller_] {
		delete $controller_
		unset controller_
	}
	set audio_ [new $dev]
	if { $dev == "Audio/OSS" } {
	    $audio_ set_sample_rate $sampleRate_
	    if { $use16bitPCM_ == 1 } {
		$audio_ useRaw16PCM
	    }
	    if { $useStereo_ == 1 } {
		puts "setting card to do stereo sound"
		$audio_ useStereo
	    }
	}
	$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) ""
}
AudioStream 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 0
		}
		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]
}
AudioStream public obtain { {should_install_controller 1} } {
	$self instvar audio_ controller_
	$audio_ obtain
	if [info exists controller_] {
		set cl [$controller_ info class]
		if [string match *FullDuplex* $cl] {
			set duplex 1
		} else {
			set duplex 0
		}
		if { [$audio_ set duplex_] != $duplex } {
			delete $controller_
			unset controller_
		}
	}
	if { ![info exists controller_] && $should_install_controller } {
		$self install_controller
	}
}
AudioStream public release {} {
	[$self set audio_] release
}
AudioStream public set_silence_thresh thresh {
	$self instvar silenceThresh_ controller_
	set silenceThresh_ $thresh
	if [info exists controller_] {
		$controller_ silence-thresh $silenceThresh_
	}
}
AudioStream public have_audio {} {
	$self instvar audio_
	if [info exists audio_] {
		return [$audio_ have]
	}
	return 0
}
AudioStream public set_input_mute val {
	$self instvar audio_
	$audio_ set_input_mute $val
}
AudioStream public set_output_mute val {
	$self instvar audio_
	$audio_ set_output_mute $val
}
AudioStream public get_input_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_input_ports]]
}
AudioStream public get_output_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_output_ports]]
}
AudioStream public is_halfduplex {} {
	$self instvar audio_
	return [expr ![$audio_ set duplex_]]
}
AudioStream public get_input_portno { } {
	$self instvar audio_
	return [$audio_ get_input_port]
}
AudioStream public get_output_portno { } {
	$self instvar audio_
	return [$audio_ get_output_port]
}
AudioStream 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
	}
}
AudioStream 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
		}
	}
}
AudioStream private port_name_to_num { which name } {
	set L [$self get_$which\_ports]
	return [lsearch -exact $L $name]
}
AudioStream 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)
}
AudioStream 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)
}
AudioStream public set_input_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(input)) $gain
	return [$audio_ set_input_gain $gain]
}
AudioStream public set_output_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(output)) $gain
	return [$audio_ set_output_gain $gain]
}
AudioStream public get_input_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(input))
}
AudioStream public get_output_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(output))
}
AudioStream private close_device {} {
    $self instvar audio_ controller_
	if [info exists audio_] {
		delete $audio_
		unset audio_
		delete $controller_
		unset controller_
	}
}
AudioStream public is_active {} {
	$self instvar controller_ audioTest_
	if [info exists controller_] {
		if { $audioTest_ != "none" } {
			return 1
		}
		return [$controller_ active]
	}
	return 0
}
AudioStream public clear_active {} {
	$self instvar controller_
	if [info exists controller_] {
		$controller_ active 0
	}
}
AudioStream public set_sample_rate { sr } {
    $self instvar sampleRate_
    set sampleRate_ $sr
}
AudioStream public use_16_bit_raw_PCM {} {
    $self instvar use16bitPCM_
    set use16bitPCM_ 1
}
Class AudioAgent16 -superclass AudioAgent
AudioAgent16 public init { app spec sampleRate use16 isStereo devName {callback {}} } {
    $self instvar sampRate use16bit useStereo
    set sampRate $sampleRate
    set use16bit $use16
    set useStereo $isStereo
    set deviceName $devName
    $self next $app $spec $callback
}
Class CuesSender
CuesSender proc set_cb { cb } {
	CuesSender set glob_chan_ $cb
}
CuesSender instproc init { path cname } {
	$self instvar cname_ cues_
        set cname_ $cname
        set cues_ "hand ear yes no"
        $self instvar top_
        set top_ $path
        foreach c $cues_ {
	        $self set ${c}_b_ [$self create_cue $c]
	        pack $top_.${c} -side left
	}
}
CuesSender instproc create_cue { cue } {
        $self instvar top_
        set cb [new CheckButton $top_.${cue} \
		 -bitmap sm_${cue} -command "$self send $cue" \
		 -onvalue ${cue}_on -offvalue ${cue}_off \
 	         -width 20 -height 20 -anchor w ]
	$cb set-val ${cue}_off
	return $cb
}
CuesSender instproc destroy { } {
	$self next
}
CuesSender instproc send { cue } {
        CuesSender instvar glob_chan_
        $self instvar cname_ ${cue}_b_ ${cue}_after_ ${cue}_ids_
        if { ![info exists glob_chan_] || "$cname_" == "" } {
	        return
	}
	if { "[[$self set ${cue}_b_] get-val]" == "${cue}_on" } {
  	        set ${cue}_after_ 1
	        for { set i 0; set t 0 } \
		    { $i < 1 } \
		    { incr i; incr t 500 } {
		        set ${cue}_ids_($i) \
				[after $t "$glob_chan_ send AWARE_$cue $cname_" ]
                }
        } else {
	        if [info exists ${cue}_after_] {
		        unset ${cue}_after_
		        foreach i [array names ${cue}_ids_] {
			        after cancel [set ${cue}_ids_($i)]
			}
	        }
	        for { set i 0; set t 0 } \
		    { $i < 1 } \
		    { incr i; incr t 500 } {
			after $t "$glob_chan_ send UNAWARE_$cue $cname_"
	        }
        }
}
Sitebox instproc init { path agent } {
	$self add_default siteFont [$self get_option helv12b]
	global tcl_platform
	if {$tcl_platform(platform) != "windows"} {
		$self add_default background gray85
	}
	$self add_default disabledColor gray50
	$self add_default highlightColor gray95
	$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_
		        set rootx [expr [winfo rootx $path_] + $x]
		        set rooty [expr [winfo rooty $path_] + $y]
			$s build-info-menu $path_.m $rootx $rooty $self
		}
	}
}
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 &
			}
		}
	}
}
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 "[$src getid] \[[$src addr]/[$src srcid]"
		if [$src is_mixer] {
			set fmt "$fmt via [$src ssrc]"
		}
		set fmt "$fmt\]"
		puts $lost$fmt
	}
}
CoordinationBus set protocolId_ ""
CoordinationBus proc.invoke { } {
	$self set protocolId_ cbus/1.0
	if { [info commands mtrace]=="" } {
		proc ::mtrace { args } { }
	}
}
CoordinationBus public init { args } {
	eval [list $self] next
	$self set seqno_ 0
	$self instvar ttl_ srcid_ mediatype_ moduletype_ appname_ appinstance_\
			channel_ mode_
	foreach {key value} $args {
		if { [string index $key 0] != "-" } {
			error "invalid argument '$key'"
		}
		$self set [string range $key 1 end]_ $value
	}
	if { ![info exists ttl_]        } { set ttl_ 0 }
	if { ![info exists mediatype_]  } { set mediatype_ "*" }
	if { ![info exists moduletype_] } { set moduletype_ "*" }
	if { ![info exists appname_]    } { set appname_ "*" }
	if { ![info exists appinstance_]} { set appinstance_ [localaddr]:[pid]}
	if { ![info exists channel_]    } { set channel_ 0 }
	if { ![info exists mode_]       } { set mode_ "readwrite" }
	if { ![info exists srcid_] } {
		set srcid_ "$mediatype_/$moduletype_/$appname_/$appinstance_"
	} else {
		set tmp [split $srcid_ /]
		if { [llength $tmp] != 4 } {
			error "invalid srcid '$srcid_'"
		}
	}
	$self open $channel_ $ttl_ $mode_
}
CoordinationBus public destroy { } {
	$self close
	$self next
}
CoordinationBus public register { event method } {
	$self instvar dispatch_
	if { [llength $method] > 1 } {
		set dispatch_($event,object) [lindex $method 0]
		set dispatch_($event,method) [lindex $method 1]
	} else {
		set dispatch_($event,object) $self
		set dispatch_($event,method) [lindex $method 0]
	}
	set dispatch_($event,argcnt) [$self get_argcnt \
			$dispatch_($event,object) $dispatch_($event,method)]
	if { $dispatch_($event,argcnt) < 0 } {
		set object $dispatch_($event,object)
		unset dispatch_($event,object)
		unset dispatch_($event,method)
		unset dispatch_($event,argcnt)
		error "trying to register undefined method '$method' on object\
				$object"
	}
}
CoordinationBus public unregister { event } {
	$self instvar dispatch_
	if [info exists dispatch_($event,object)] {
		unset dispatch_($event,object)
		unset dispatch_($event,method)
		unset dispatch_($event,argcnt)
	}
}
CoordinationBus public send { args } {
	if { [string compare [lindex $args 0] "-dstid"] == 0 } {
		set dst [lindex $args 1]
		set tmp [split $dst /]
		if { [llength $tmp] != 4 } {
			error "Invalid destination: must be of the form\
					<media-type>/<module-type>/<app-name>/<app-instance>"
		}
		set args [lrange $args 2 end]
	} else {
		set dst "*/*/*/*"
	}
	$self instvar seqno_ srcid_
	if { [llength $args]==0 } {
		error "Must specify event type: \$cb send\
				[-dstid <destination>] $event_type [args...]"
	}
	set headers [list [CoordinationBus set protocolId_] $seqno_ \
			"U" $srcid_ $dst ""]
	$self transmit [concat $headers $args]
}
CoordinationBus private match_wildcards { d s } {
	if { [string compare $d $s]==0 || $d=="*" || $s=="*" } {
		return 1
	} else {
		return 0
	}
}
CoordinationBus private filter { destid } {
	$self instvar srcid_
	set s [split $srcid_ /]
	set d [split $destid /]
	if { [$self match_wildcards [lindex $d 0] [lindex $s 0]] && \
			[$self match_wildcards [lindex $d 1] [lindex $s 1]] &&\
			[$self match_wildcards [lindex $d 2] [lindex $s 2]] &&\
			[$self match_wildcards [lindex $d 3] [lindex $s 3]] } {
		return 1
	} else {
		return 0
	}
}
CoordinationBus private dispatch { packet } {
	set packet [split $packet]
	if { [llength $packet] < 7 } {
		mtrace trcCB "CB: Invalid packet: only [llength $packet]\
				elements"
		return
	}
	set protocolId [lindex $packet 0]
	set seqNo [lindex $packet 1]
	set messageType [lindex $packet 2]
	set srcId [lindex $packet 3]
	set destId [lindex $packet 4]
	set ackList [lindex $packet 5]
	set event [lindex $packet 6]
	set args [lrange $packet 7 end]
	if { $protocolId != [CoordinationBus set protocolId_] } {
		mtrace trcCB "CB: Invalid protocol id '$protocolId': must be\
				[CoordinationBus set protocolId_]"
		return
	}
	$self instvar srcid_
	if { [string compare $srcId $srcid_]==0 } {
		return
	}
	if { ![$self filter $destId] } {
		mtrace trcCB|trcVerbose "CB: filtering out packet meant for\
				'$destId'"
		return
	}
	$self instvar dispatch_
	if { ![info exists dispatch_($event,object)] } {
		mtrace trcCB|trcVerbose "CB: unknown event '$event'"
		return
	}
	if { [expr [llength $args] + 1] != $dispatch_($event,argcnt) } {
		mtrace trcCB "CB: argument mismatch: expected\
				$dispatch_($event,argcnt) arguments,\
				got [llength $args]"
		return
	}
	set info [list cb $self srcid $srcId dstid $destId event $event]
	eval [list $dispatch_($event,object)] \
			[list $dispatch_($event,method)] [list $info] $args
}
CoordinationBus private get_argcnt { object method } {
	if { [$object info procs $method] != "" } {
		return [llength [$object info args $method]]
	}
	set cls [$object info class]
	if { [$cls info instprocs $method] != "" } {
		return [llength [$cls info instargs $method]]
	}
	foreach c [$cls info heritage] {
		if { [$c info instprocs $method] != "" } {
			return [llength [$c info instargs $method]]
		}
	}
	return -1
}
Class AudioArbiter -superclass {CoordinationBus Observable} -configuration {
	idleDropTime 20
	defaultPriority 100
}
AudioArbiter public 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 public release {} {
	$self instvar agent_
	$agent_ release
	$self indicator_update
}
AudioArbiter public 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 private give_it_up pid {
	$self release
	$self send audio-release $pid
}
AudioArbiter public someone_demands pid {
	$self instvar agent_
	if { [$agent_ have_audio] } {
		$self give_it_up $pid
	}
}
AudioArbiter public 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 public grab {} {
	$self instvar agent_
	$agent_ obtain
	$self indicator_update
}
AudioArbiter public request {} {
	$self instvar agent_ priority_
	$agent_ obtain
	if [$agent_ have_audio] {
		$self indicator_update
	} else {
		$self send audio-request [pid] $priority_
	}
}
AudioArbiter public demand {} {
	$self instvar agent_
	$agent_ obtain
	if [$agent_ have_audio] {
		$self indicator_update
	} else {
		$self send audio-demand [pid]
	}
}
AudioArbiter public hold v {
	$self instvar hold_ agent_
	set hold_ $v
	if { $hold_ && ![$agent_ have_audio] } {
		$self demand
	}
}
AudioArbiter private 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 } {
	$self add_default audioFont [$self get_option helv10]
	$self add_default ctrlFont [$self get_option helv10b]
	global tcl_platform
	if {$tcl_platform(platform) != "windows"} {
		option add *VatVU.background gray85 startupFile
	}
	option add *VatVU.foreground black startupFile
	option add *VatVU.peak gray50 startupFile
	option add *VatVU.hot firebrick1 startupFile
	option add *VatVU.hotLevel 90 startupFile
	if { [winfo depth .] == 1 } {
		option add *VatVU.background white startupFile
		option add *VatVU.hot gray50 startupFile
	}
	frame $top.panel
	pack $top.panel -side right -fill y
	set w $top.panel.audio
	frame $w
	pack $w -expand 1 -fill y
	option add *AudioPanelPane*borderWidth 2 widgetDefault
	frame $w.spkr -borderwidth 0 -class AudioPanelPane
	$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 -class AudioPanelPane
	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 bottom -anchor c -before $w
}
AudioPanel instproc mute_invoke { 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 }
		headphone { 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 -relief raised -borderwidth 1
	set cb [new CheckButton $w.mute.b -text $label -font $f -relief ridge \
		-anchor c \
		-command "$self mute_invoke $which" \
		-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 -relief raised
	button $w.select.b -bitmap $bitmap -relief flat \
		-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 -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 -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 both
	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 is_recv_only {} {
	$self instvar input_mute_
	if { [$input_mute_ cget -state] == "disabled" } { return 1 } \
			else { return 0 }
}
AudioPanel instproc action {} {
	$self instvar agent_ arbiter_ output_mute_
	if { ![$agent_ have_audio] && "[$output_mute_ get-val]" == "unmuted" } {
		$arbiter_ request
	}
}
AudioPanel instproc cancel_timer {} {
	$self instvar arbiter_
	delete $arbiter_
}
bind Entry <Enter> {
	catch {
		global entryTab
		if $entryTab(%W:focus) {
			focus %W
		}
	}
}
bind Entry <Return> {
    set validateMode [%W cget -validate]
    %W validate
    %W configure -validate $validateMode
}
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] \
                -validate focusout -validatecommand "$self validate %W %P"
	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_
	$win_ validate
	return $entryTab($win_:value)
}
Entry instproc set-value {v} {
	global entryTab
	$self instvar win_
	$win_ delete 0 end
	$win_ insert 0 $v
	set entryTab($win_:value) $v
}
Entry instproc clear { } {
	global entryTab
	$self instvar win_
	set entryTab($win_:value) 0
	$win_ insert 0 ""
}
Entry instproc validate {entryName newValue} {
    global entryTab
    $self instvar win_
    set validateResult 1
    set oldValue $entryTab($entryName:value)
    if {[catch {set reject [$entryTab($entryName:object) update $newValue]}]} {
        set reject 0
    }
    if {$reject} {
        $win_ delete 0 end
        $win_ insert 0 $oldValue
        bell
        set validateResult 0
    } else {
        set entryTab($entryName:value) $newValue
        set validateResult 1
    }
    return $validateResult
}
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 "FIXME"
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]
	}
	if {$target_ == {}} {
		return 0
	} else {
		return [eval $target_ \"$s"]
	}
}
Class QuitWindow -superclass TopLevelWindow
Class InfoWindow -superclass {QuitWindow Timer} -configuration {
	infoHighlightColor LightYellow2
	sdesList "cname tool email note"
}
Class ScubaInfoWindow -superclass {QuitWindow Timer Observer}
Class StatWindow -superclass {QuitWindow Timer} -configuration {
	statsFilter 0.0625
}
Class RtpStatWindow -superclass StatWindow
Class GlobalStatWindow -superclass StatWindow
Class MtraceWindow -superclass TopLevelWindow
QuitWindow public 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_] {
		$self unset_rvs
		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 src {
	destroy $src
	global stat_method win_src
	if [info exists stat_method($src)] {
		unset stat_method($src)
	}
	if [info exists win_src($src)] {
		unset win_src($src)
	}
}
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 private timeout {} {
	$self stat-update
	$self sched 1000
}
StatWindow public 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
        wm protocol $w WM_DELETE_WINDOW "$self quit"
}
StatWindow instproc destroy {} {
	$self instvar plot_win_
	foreach w [array names plot_win_] {
		$self delete-plot-window $w
	}
	$self next
}
RtpStatWindow public 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-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 public 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 private 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 public 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
        wm protocol $w WM_DELETE_WINDOW "$self quit"
}
proc info_text src {
	set d [$src handler]
	set fmt [$src format_name]
	if {[[$src set sm_] info class] == "VideoAgent"} {
		if { "$d" != "" } {
			set fmt "$fmt [$d cmd info] ([$d width]x[$d height])"
		}
	} elseif {[[$src set sm_] info class] == "AudioAgent"} {
		if { "$d" != "" } {
			set n [expr [$d block-size] / 160]
			if { $n > 1 } {
				set fmt $fmt/$n
			}
		}
		if { $fmt == "" } {
			set fmt none
		}
	}
	return "format: $fmt"
}
InfoWindow public 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" -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
        wm protocol $w WM_DELETE_WINDOW "$self quit"
	$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 private timeout {} {
	$self info_update
	$self sched 3000
}
ScubaInfoWindow private timeout {} {
	$self info_update
	$self sched 1000
}
ScubaInfoWindow public 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
        wm protocol $w WM_DELETE_WINDOW "$self quit"
	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_
	}
}
MtraceWindow public init {w src dir} {
        $self instvar w_ src_ dir_
	set w_ $w
	set src_ $src
	set dir_ $dir
	if ![winfo exists $w] {
                $self create-window $w [$src getid]
		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
                wm protocol $w WM_DELETE_WINDOW "destroy $w"
		update idletasks
		if ![winfo exists $w] { return }
	}
}
MtraceWindow instproc do_mtrace {} {
        $self instvar w_ src_ dir_
	global V
	set rtpagent $V(sm)
	set net [$rtpagent network]
	if {$dir_=="to"} {
		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 "$self read_mtrace $fd"
}
MtraceWindow instproc read_mtrace {fd} {
        $self instvar 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] {
		foreach statwin [StatWindow info instances] {
		    if [$src == [$statwin set src_]] {
			$statwin unset_rvs
		    }
		}
		stat_destroy $src
	}
}
Class AudioControlMenu -superclass TopLevelWindow -configuration {
	defaultPriority 100
	mikeMute true
	lectureMode false
	meterEnable true
	mikeAGC false
	speakerAGC false
	mikeAGCLevel 0
	speakerAGCLevel 0
	autoRaise true
	externalEchoCancel false
	silenceThresh 20
	keepSites false
	sortSites true
	muteNewSites false
	speakerMode NetMutesMike
	jackMode FullDuplex
	lineoutMode NetMutesMike
	lineout2Mode NetMutesMike
	audioFormat PCM2
}
AudioControlMenu instproc init { agent ui panel } {
	$self add_default ctrlTitleFont [$self get_option helv12b]
	$self add_default ctrlFont [$self get_option helv10b]
	$self add_default noAudioFont [$self get_option helv10o]
	$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 "[$self get_option appname]: 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 } {
	$self set duplex_panel_ $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 -anchor w
		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 -anchor w -fill x
}
AudioControlMenu instproc update_duplex { } {
	$self instvar duplex_panel_ agent_
	if ![$agent_ is_halfduplex] {
		if [info exists duplex_panel_] {
			catch {pack $duplex_panel_ \
					-before [winfo parent \
					$duplex_panel_].buttons \
					-anchor c -pady 4 -fill x -padx 5}
		}
		foreach port [$agent_ get_output_ports] {
			set omode [$self get_option $port\Mode]
			$agent_ set_speakerphone $port $omode
		}
	} else {
		if [info exists duplex_panel_] {
			catch {pack forget $duplex_panel_}
		}
		foreach port [$agent_ get_output_ports] {
			$agent_ set_speakerphone $port mikemutesnet
		}
	}
}
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 [$agent_ 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 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 -fill x -padx 5
	pack $w.label $w.frame -expand 1 -fill x
	$self instvar agent_
	if [$agent_ is_halfduplex] {
		$self update_duplex
	}
}
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" \
					"RTP Statistics" \
					"$self get-global-stats" \
					"$self delete-global-window"]
	}
}
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
	$w.b.stats configure -state disabled
	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 "Audio Settings"
	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
        wm protocol $w WM_DELETE_WINDOW "$self toggle"
}
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
}
proc dummy args ""
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 {} {
	$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 build-info-menu {m x y parent} {
        catch {destroy $m}
        menu $m
        set f [$self get_option smallfont]
        $m add command -label "Site Info" \
                -command "$self toggle-info" -font $f
        $m add command -label "RTP Stats"\
                -command "$self create-rtp-window" -font $f
        $m add command -label "Decoder Stats" \
                -command "$self create-decoder-window" -font $f
        if [in_multicast [[$parent set agent_] session-addr]] {
                $m add command -label "Mtrace from" \
                        -command "$self create-mtrace-window from" -font $f
                $m add command -label "Mtrace to" \
                        -command "$self create-mtrace-window to" -font $f
        }
        $parent instvar scuba_sess_
        if [info exists scuba_sess_] {
                $m add command -label "Scuba Info" -font $f \
                        -command "$self create-scuba-window"
        }
    tk_popup $m $x $y
}
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 create-mtrace-window {dir} {
        $self instvar mtrace_win_ src_
        set w .mtrace$src_
        if ![winfo exists $w] {
                set mtrace_win_ [new MtraceWindow $w $src_ $self]
        }
        $mtrace_win_ do_mtrace
}
SiteEntry instproc source {} {
	return [$self set src_]
}
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_
	}
}
proc mark_icon args {}
Class VatUI -superclass Observer -configuration {
	sessionType rtp
	speakerMute false
	inputPort {mike microphone mic}
	outputPort {speaker wave}
	mikeAGC false
	speakerAGC false
	buttonforeground gray40
}
Class VatHelpWindow -superclass HelpWindow
VatUI instproc audio_psetup {} {
	$self instvar agent_
	$agent_ instvar controller_
	set s [$agent_ get_input_gain]
	puts "Vat.[lindex $s 0]Gain:	[lindex $s 1]"
	set s [$agent_ get_output_gain]
	puts "Vat.[lindex $s 0]Gain:	[lindex $s 1]"
	if ![info exists controller_] return
	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 } {
	set title "[$self get_option appname] v[version]"
	label $w.title -text $title -font [$self get_option ctrlFont] \
		-relief flat -justify left -width 30
	button $w.quit -text Quit -relief raised \
		-font [$self get_option ctrlFont] -command $exitCmd \
		-highlightthickness 1
	button $w.menu -text Settings -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 build.cues { w } {
	$self instvar agent_ cs_ globalChannel_
	CuesSender set_cb $globalChannel_
	set cname [[$agent_ set local_] sdes cname]
	set cs_ [new CuesSender $w $cname]
}
VatUI instproc arbiter_have v {
	$self instvar titleBar_
	if $v {
		$titleBar_ configure -font [$self get_option ctrlFont]
		$self instvar controlMenu_
		$controlMenu_ update_duplex
	} else {
		$titleBar_ configure -font [$self get_option noAudioFont]
	}
}
VatUI instproc arbiter_snatch {} {
	$self instvar controlMenu_
	if [$controlMenu_ query autoRaise] {
		raise .
	}
}
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 globalChannel agent exitCmd spec } {
	$self next
	$self add_default ctrlFont [$self get_option helv10b]
	$self instvar controlMenu_ agent_ globalChannel_
	set agent_ $agent
	set globalChannel_ $globalChannel
	global mash
	if { ![info exists mash(environ)] || $mash(environ)!="mplug" } {
	    wm withdraw .
	}
	update idletasks
	global minwidth minheight
	set minwidth [winfo reqwidth .]
	set minheight [winfo reqheight .]
	wm minsize . $minwidth $minheight
	bind $w <Enter> { focus %W }
	bind $w q "$exitCmd"
	bind $w <Control-c> "$exitCmd"
	bind $w <Control-d> "$exitCmd"
        wm protocol . WM_DELETE_WINDOW "$exitCmd"
	bind $w p "$self audio_psetup"
	bind $w P "$self 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] "$exitCmd"
	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
	if { [$self yesno useCues] } {
		frame $w.cues -relief ridge -borderwidth 2
		label $w.cues.l -font [$self get_option ctrlFont] \
			-text "Cues:"
		pack $w.cues.l -side left -padx 10
		$self build.cues $w.cues
		pack $w.cues -fill x
	}
	pack $w.bar -fill x
	set v [$self get_option geometry]
	if { $v != "" } {
		if { [ catch "wm geometry . $v" ] } {
			puts "[$self get_option appname]: bad geometry $v"
			exit
		}
	}
	$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 [$self get_option buttonforeground]
	}
	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 [$self get_option buttonforeground]
	}
	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
	update idletasks
	global mash
	if { ![info exists mash(environ)] || $mash(environ)!="mplug" } {
	    wm deiconify .
	}
	if { $spec == "" } {
		set conf "Contacting MeGa..."
	} else {
		set conf [$self get_option conferenceName]
	}
	$self window-title [$self get_option iconPrefix] $conf
	$agent_ attach $self
}
VatUI instproc reset {} {
	$self new_hostspec
	set conf [$self get_option conferenceName]
	$self window-title [$self get_option iconPrefix] $conf
}
VatUI instproc new_hostspec {} {
	$self instvar controlMenu_
	$controlMenu_ new_hostspec
}
VatUI instproc destroy {} {
	$self instvar rank_ sitebox_ audioPanel_ agent_
	set a [$audioPanel_ set arbiter_]
	$a detach_observer $self
	$agent_ detach $self
	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 "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 openmash-users@openmash.org.  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]
	if {$decoder == "" || [regexp Null [$decoder info class]]} then {
		new ErrorWindow "Sorry, cannot decode this type of audio."
	}
	$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 clean_timers { } {
	$self instvar audioPanel_
	$audioPanel_ cancel_timer
	$self cancel_talk_monitor
}
VatUI instproc cancel_talk_monitor { } {
        $self instvar id_
        if [info exists id_] {
                after cancel $id_
                unset id_
        }
}
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
}
VatUI instproc window-title { prefix name } {
	$self instvar name_ prefix_
	set name_ $name
	set prefix_ $prefix
	wm iconname . "$prefix_ $name_"
	wm title . "$prefix_ $name_"
}
Class FontInitializer
FontInitializer public init {options} {
	$options add_default foundry adobe
	set foundry [$options get_option foundry]
        set b b
	set o o
        foreach i {8 10 12 14 18 24 36 48} {
                $options add_default helv$i    [$self search_font $foundry helvetica medium $i r]
                $options add_default helv$i$b  [$self search_font $foundry helvetica bold $i r]
		$options add_default helv$i$o  [$self search_font $foundry helvetica bold $i o]
                $options add_default times$i   [$self search_font $foundry times     medium $i r]
                $options add_default times$i$b [$self search_font $foundry times     bold $i r]
                $options add_default times$i$o [$self search_font $foundry times     bold $i o]
		$options add_default courier$i [$self search_font $foundry courier medium $i r]
        }
        $options add_default tinyfont [$self get_option helv8]
	$options add_default smallfont [$self get_option helv10b]
	$options add_default medfont [$self get_option helv12b]
	$options add_default helpFont [$self get_option times14]
	$options add_default entryFont [$self get_option helv10]
        $options add_default logofont [$self get_option times12o]
}
FontInitializer public 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
		}
	}
	puts stderr "can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "can't find fixed font"
		exit 1
	}
	return fixed
}
Class WidgetResourceInitializer
WidgetResourceInitializer public init {} {
	option add *padX 2
	option add *padY 2
	option add *tearOff 0
	option add *Radiobutton.relief flat startupFile
	option add *Checkbutton.anchor w startupFile
	option add *Radiobutton.anchor w startupFile
	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
	}
	if { [winfo depth .] == 1 } {
		option add *selectBackground black startupFile
		option add *selectForeground white startupFile
		option add *activeForeground black startupFile
	}
}
Class VatApplication -superclass RTPApplication
VatApplication instproc init { widgetPath argv } {
	$self next vat
	set o [$self options]
	$self init_args $o
	new FontInitializer $o
	option add *Font [$o get_option helv14b] startupFile
	option add *Radiobutton.font [$o get_option helv12b] 100
	$self init_resources $o
	$o load_preferences "rtp vat"
	set argv [$o parse_args $argv]
	if {[$o get_option userhookFile] != ""} {
		if {[file isfile [$o get_option userhookFile]] && \
			[file readable [$o get_option userhookFile]]} {
			source [$o get_option userhookFile]
		} else {
			puts stderr "Unable to source \"[$o get_option userhookFile]\". Not a file or not readable."
		}
	}
	set spec [$self check_hostspec $argv [$self get_option megaAudioSession]]
	$self check_rtp_sdes
	$self instvar ui_ agent_
	set agent_ [new AudioAgent $self $spec]
	$self init_confbus
	set ui_ [$self init_ui $widgetPath $spec]
	$self user_hook
	update idletasks
}
VatApplication instproc init_ui { widgetPath spec } {
	$self instvar agent_ glob_chan_
	frame $widgetPath
	set ui [new VatUI $widgetPath $glob_chan_ $agent_ "$self exit" $spec]
	pack $widgetPath -expand 1 -fill both
	return $ui
}
VatApplication instproc reset { ab } {
	$self instvar ui_
	$ui_ reset
}
VatApplication instproc exit {} {
    $self instvar ui_ agent_ local_chan_ glob_chan_
    delete $ui_
    $agent_ release
    $agent_ shutdown
    delete $agent_
    delete $local_chan_
    delete $glob_chan_
    exit
}
VatApplication instproc init_args o {
	$o register_option -B maxbw
	$o register_option -C conferenceName
	$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 userhookFile
	$o register_option -V visual
	$o register_boolean_option -r compat
	$o register_option -confid confid
	$o register_option -loopback loopback
	$o register_list_option -map rtpMap
	$o register_option -rport megaRecvAudioPort
	$o register_option -ofmt megaAudioFormat
	$o register_option -usemega megaAudioSession
	$o register_option -megactrl megaAudioCtrl
	$o register_option -sspec audioSessionSpec
	$o register_option -maxsbw maxAudioSessionBW
	$o register_option -sbw audioSessionBW
	$o register_option -sloc audioServiceLocation
	$o register_boolean_option -useCues useCues
        $o register_option -lb bitRate
        $o register_option -ls sampleRate
}
VatApplication instproc init_resources o {
	new WidgetResourceInitializer
	$o add_default iconPrefix vat:
	$o add_default defaultTTL 16
	$o add_default afDevice -1
	$o add_default afBlocks 2
	$o add_default afSoftOuputGain 0
	$o add_default afSoftInputGain 0
	$o add_default audioFileName /dev/audio
	$o add_default audioFormat PCM2
	$o add_default confBusChannel 0
        $o add_default sampleRate 44100
        $o add_default bitRate 128
}
VatApplication instproc init_confbus {} {
        $self instvar agent_ local_chan_ glob_chan_
        set local_chan_ [new CoordinationBus -channel 2]
        $agent_ attach_local_channel $local_chan_
        set ttl [$self get_option defaultTTL]
        set glob_chan_ [new CoordinationBus -channel 3 -ttl $ttl]
        $agent_ attach_global_channel $glob_chan_
}
new VatApplication .[pid] $argv
