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

#
# Copyright (c) 1993-1996 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the University of
#	California, Berkeley and the Network Research Group at
#	Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /usr/src/mash/repository/mash/mash-1/head.tcl,v 1.3 1997/08/15 07:23:36 mccanne Exp $ (LBL)
#
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$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_
	set arg_option_($flag) $option
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration 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_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_option_($arg)] {
			$self add_option $arg_option_($arg) $val
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			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
		}
		$self usage
		$self fatal "unknown command option: $arg"
	}
	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 {
	set mash [glob ~]/.mash
	if [file isdirectory $mash] {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
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}
    return [format %u [expr $ntptime - $oddoffset]]
}
proc duration_readable {secs {option terse}} {
	set ret ""
	set r [expr round($secs)]
	set h [expr $r / 3600]
	set r [expr $r % 3600]
	set m [expr $r / 60]
	set s [expr $r % 60]
	if {$option == "verbose"} then {
		if {$h} {
			set ret "$ret $h\h"
		} 
		if {$m} {
			set ret "$ret $m\m"
		} 
		if {$s} {
			set ret "$ret and $s\s"
		} 
	} else {
		set ret "$h:$m:$s"
	}
		return $ret
}
Class 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
	}
	set mash [glob ~]/.mash
	if ![file exists $mash] {
		file mkdir $mash
	}
	set f [open $mash/prefs a+ 0644]
	puts $f "rtpName: $name"
	puts $f "rtpEmail: $email"
	close $f
	pack forget $w
	destroy $w
}
RTPApplication public check_rtp_sdes {} {
	set name [$self get_option rtpName]
	if { $name == "" } {
		set name [$self get_option sessionName]
		option add *rtpName $name startupFile
	}
	set email [$self get_option rtpEmail]
	if { $name == "" || $email == "" } {
		$self run_resource_dialog $name $email
	}
}
RTPApplication private check_hostspec { argv 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 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}} {
	return [$self set ttl_($k)]
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" && $fmt != "1" } {
		$self add_option videoFormat $fmt
		$self add_option audioFormat $fmt
	}	
	if [info exists confid] {
		$self add_option confid $confid
	}	
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 3072000
			} elseif { $ttl <= 64 } {
				set maxbw 1024000
			} elseif  { $ttl <= 128 } {
				set maxbw 128000
			} elseif { $ttl <= 192 } {
				set maxbw 53000
			} else {
				set maxbw 32000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
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
}
Session/Scuba set sessionbw_ 0
Session/Scuba instproc init {} {
	$self next
	$self set share_ 0.05
	$self set sessionbw_ 0
}
Session/Scuba instproc sessionbw { b } {
	$self instvar sessionbw_
	set sessionbw_ $b
	$self set_allocation
}
Session/Scuba instproc unregister { src } {
	$self clean_scoretab $src
}
Session/Scuba instproc register { src } {}
Session/Scuba instproc activate { src } {}
Session/Scuba instproc deactivate { src } {}
Session/Scuba instproc notify { src } {}
Session/Scuba instproc trigger_media { src } {}
Session/Scuba instproc trigger_format { src } {}
Session/Scuba instproc trigger_sdes { src } {}
Session/Scuba instproc trigger_idle { src } {}
Session/Scuba instproc recv_scuba_entry { sender srcid val } {
	$self instvar scoretab_
	set scoretab_($sender:$srcid) [expr $val/1e6]
}
Session/Scuba instproc clean_scoretab { src } {
	$self instvar scoretab_
	set idxs [array names scoretab_ $src:*]
	foreach i $idxs {
		unset scoretab_($i)
	}
}
Session/Scuba instproc delete_reporter { s } {
	$self clean_scoretab $s
	$self set_allocation
}
Class 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
		}
	}
}
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 sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	$dn_ open $addr_ $sport_ $rport_ $ttl_
	set cn_ [new Network]
	$cn_ open $addr_ [expr $sport_ + 1] [expr $rport + 1] $ttl_
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	delete $dn_
	delete $cn_
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-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
	}
}
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 dc_ cc_ net_
	if [info exists dc_] {
		delete $dc_
	}
	if [info exists cc_] {
		delete $cc_
	}
	foreach dn [array names net_] {
		delete $net_($dn)
	}
	$self next
}
NetworkManager instproc 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 NetworkManager/Scuba
NetworkManager/Scuba instproc init { ab session agent } {
	$self next
	$self reset $ab
}
NetworkManager/Scuba instproc reset ab {
	set addr [$ab addr 0]
	set sport [$ab sport 0]
	incr sport -1
	set rport [$ab rport 0]
	incr rport -1
	set ttl [$ab ttl 0]
	$self instvar scubaNet_
	if ![info exists scubaNet_] {
		set scubaNet_ [new Network]
	} else {
		$scubaNet_ close
	}
	$scubaNet_ open $addr $sport $rport $ttl
}
NetworkManager/Scuba instproc destroy {} {
	$self instvar scubaNet_
	if [info exists scubaNet_] {
		delete $scubaNet_
	}
}
Class Session/Scuba/Vic -superclass { Session/Scuba Observer }
Session/Scuba/Vic instproc init { rtpsess sm ab vpipe } {
	$self next 
	$self set rtpsess_ $rtpsess
	$self source-manager $sm
	$self set vpipe_ $vpipe
	if { $ab != "" && [$ab nchan] > 0 } {
		$self reset $ab
	}
}
Session/Scuba/Vic instproc reset ab {
	$self instvar nm_ rtpsess_
	if [info exists nm_] {
		delete $nm_
	}
	set nm_ [new NetworkManager/Scuba $ab $rtpsess_ $self]
	$self scuba-net [$nm_ set scubaNet_]
	$self start-control
}		
Session/Scuba/Vic instproc set_allocation {} {
	$self instvar scoretab_ share_ rtpsess_ sessionbw_
	set sm [$self source-manager]
	if { [$sm info vars local_] == "" } {
		return
	}
	set localsrc [$sm set local_]
	set total 0
	set tot($localsrc) 0
	set al [$sm active_list]
	set zerosrcs 0
	foreach src $al {
		set srcid [$src srcid]
		set voters [array names scoretab_ *:$srcid]
		set subtotal 0
		foreach v $voters {
			set subtotal [expr $subtotal+$scoretab_($v)]
		}
		set tot($src) $subtotal
		if { $subtotal == 0 } {
			incr zerosrcs
		}
		set total [expr $total+$subtotal]
	}
	if { $total > 0 } {
		set avg [expr $tot($localsrc)/$total]
	} else {
		set avg 0
	}
	if { $avg > 0 } {
		set share_ [expr 0.95*$avg]
	} else {
		if { $zerosrcs == 0 } {
			set zerosrcs 1
		}
		set share_ [expr 0.05/$zerosrcs]
	}
	$self set_bps [expr $share_*$sessionbw_]
}
Session/Scuba/Vic instproc set_bps { bps } {
	set videoagent [$self source-manager]
	set b [expr int($bps)]
	$self instvar vpipe_
	$vpipe_ set_bps $b
	$videoagent local_bandwidth $b
	global bps_slider
	if [info exists bps_slider] {
		$bps_slider set $b
	}
}
Session/Scuba/Vic instproc build_report {} {
	$self instvar focus_set_
	if ![info exists focus_set_] {
		return 0
	}
	set sm [$self source-manager]
	if { [$sm info vars local_] == "" } {
		return 0
	}
	set localsrc [$sm set local_]
	set t 0
	set srcs [array names focus_set_]
	foreach s $srcs {
		if { $s != $localsrc && $focus_set_($s) > 0 } {
			incr t
		}
	}
	$self clean_scoretab $localsrc
	if { $t != 0 } {
		set score [expr int(1e6/$t)]
		foreach s $srcs {
			if { $focus_set_($s) > 0 && $s != $localsrc } {
				set srcid [$s srcid]
				$self add-scuba-entry $srcid $score
				$self recv_scuba_entry $localsrc \
						$srcid $score
			}
		}
	}
	$self set_allocation
	return $t
}
Session/Scuba/Vic instproc activate { src } {
	$self set focus_set_($src) 0
	$self next $src 
}
Session/Scuba/Vic instproc deactivate { src } {
	$self unset focus_set_($src)
	$self next $src 
}
Session/Scuba/Vic instproc scuba_focus { src } {
	$self instvar focus_set_
	incr focus_set_($src)
}
Session/Scuba/Vic instproc scuba_unfocus { src } {
	$self instvar focus_set_
	incr focus_set_($src) -1
}
Source/RTP set reportLoss_ 0
Session/RTP set nb_ 0
Session/RTP set nf_ 0
Session/RTP set np_ 0
Session/RTP set loopback_ 1
Source/RTP set badsesslen_ 0
Source/RTP set badsessver_ 0
Source/RTP set badsessopt_ 0
Source/RTP set badsdes_ 0
Source/RTP set badbye_ 0
SourceLayer/RTP set nchan_ 1
Session/RTP set badversion_ 0
Session/RTP set badoptions_ 0
Session/RTP set badfmt_ 0
Session/RTP set badext_ 0
Session/RTP set nrunt_ 0
Session/RTP set loopbackLayer_ 1000
Source/RTP public layer-stat which {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set s [expr $s + [$l set $which]]
	}
	return $s
}
Source/RTP public ns {} {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set s [expr $s + [$l set cs_] - [$l set fs_]]
	}
	return $s
}
Source/RTP public missing {} {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set nm [expr [$l set cs_] - [$l set fs_] - [$l set np_]]
		if { $nm > 0 } {
			set s [expr $s + $nm]
		}
	}
	return $s
}
Source/RTP instproc is_mixer {} {
	return [expr [$self srcid] != [$self ssrc]]
}
SourceLayer/RTP set nrunt_ 0
SourceLayer/RTP set ndup_ 0
SourceLayer/RTP set fs_ 0
SourceLayer/RTP set cs_ 0
SourceLayer/RTP set np_ 0
SourceLayer/RTP set nf_ 0
SourceLayer/RTP set nb_ 0
SourceLayer/RTP set nm_ 0
Source/RTP public init { sm srcid ssrc addr } {
	$self next $srcid $ssrc $addr
	$self set sm_ $sm
	$self instvar layers_
	set k 0
	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 getid {} {
	set name [$self sdes name]
	if { $name == "" } {
		set name [$self sdes cname]
		if { $name == "" } {
			set name [$self addr]
		}
	}
	return $name
}
Source/RTP public format_name {} {
	$self instvar sm_
	return [$sm_ rtp_type [$self format]]
}
Class MediaAgent -superclass {SourceManager Observable}
foreach method "unregister activate deactivate \
		trigger_media \
		trigger_format \
		trigger_sdes \
		trigger_idle \
		notify" {
	Source/RTP public $method {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 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_
	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 {[$ab info class] != "AddressBlock"} {
	$self reset_spec $spec
    }
	if [info exists network_] {	
		delete $network_
	}
	set network_ [new NetworkManager $ab $session_ $self]
	$self app_loopback 1
	$self net_loopback [$self get_option loopback]
	set key [$self get_option sessionKey]
	if { $key != "" } {
		$network_ install-key $key
	}
	$self instvar local_
	if ![info exists local_] {
		$self mk_local_source
	}
	$session_ max-bandwidth [expr [$ab set maxbw_(0)]/1000.]
        $self instvar callback_
        if [info exists callback_] {
                eval $callback_ [list $ab]
	} else {
	        catch {[Application instance] reset $ab}
	}
}
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 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_(20) ldct
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(22) bvc
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_(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_(ldct) LDCT
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
	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}"
}
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_]
}
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
	$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 instvar interval_
	$self next
	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 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
	}
}
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
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v { 
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]	
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {	
			$msg set session_name_ $value 
		}
		i {	
			if { $media != "" } {
				$media set session_info_ $value 
			} else {
				$msg set session_info_ $value 
			}
		}
		p {
			set tmp "" 
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e { 
			set tmp "" 
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u { 
			$msg set uri_ $value
		} 
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				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 != "" } {
			$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 { } {
    set html {}
    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_(time_$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]
    } 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 } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } 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_]"
		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 "-"
	}
}
Class VideoAgent -superclass { RTPAgent RTP/Video } -configuration {
	megaVideoFormat h261
	megaRecvVideoPort 0
	megaVideoCtrl 224.4.5.24/50000/31
	megaVideoCtrlBW 20000
	videoServiceLocation urn:vgw
}
VideoAgent public init  { app spec {callback {}}} {
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
	} else {
		set ab ""
	}
	$self next $ab $callback
	if { $ab != "" } {
		delete $ab
	}
	$self site-drop-time [$self get_option siteDropTime]
	$self instvar decoders_ al_
	set decoders_ ""
	set localbw [$app get_option videoSessionBW]
	if { $localbw == "" } {
		set localbw [$app get_option maxVideoSessionBW]
	}
	$self sessionbw $localbw
	if { [$app get_option megaVideoSession] != "" } {
		set sname [$app get_option megaVideoSession]
		set sspec [$self get_option videoSessionSpec]
		set rportspec [$self get_option megaRecvVideoPort]
		set ofmt [$self get_option megaVideoFormat]
		set bw [expr 0.02*$localbw]
		set megaspec [$self get_option megaVideoCtrl]
		set loc [$self get_option videoServiceLocation]
		set al_ [new AnnounceListenManager/AS/Client/MeGa/Video \
				$self $megaspec $bw [Application name] video \
				$sname $sspec $rportspec $ofmt $loc]
	        $al_ start
	}
}
VideoAgent public reset_mega {} {
    $self instvar al_
    $al_ reset_spec [$self get_option videoSessionSpec]
}
VideoAgent public create_session {} {	
	return [new Session/RTP/Video]
}
VideoAgent public activate src {
	$self instvar decoders_
	set d [$self create_decoder $src]
	lappend decoders_ $d
	$src handler $d
	$self next $src
}
VideoAgent public deactivate src {
	$self instvar decoders_
	set d [$src handler]
	set k [lsearch -exact $decoders_ $d]
	set decoders_ [lreplace $decoders_ $k $k]
	$self next $src
	delete $d
}
VideoAgent public reactivate src {
        $self instvar decoders_
        set d [$src data-handler]
        if {$d!=""} {
  	        delete $d
	}
        set k [lsearch -exact $decoders_ $d]
        set decoders_ [lreplace $decoders_ $k $k]
        set decoder [$self create_decoder $src]
        lappend decoders_ $decoder
        $src data-handler $decoder
	return $decoder
}
VideoAgent public sessionbw b {
	$self set sessionbw_ $b
	$self notify_observers sessionbw $b
}
VideoAgent public local_bandwidth b {
	[$self set session_] data-bandwidth $b
}
Module/VideoDecoder public parameters_changed {} {
	$self instvar agent_ src_
	$agent_ dispatch "decoder_changed $src_"
}
VideoAgent public set_maxchannel n {
	$self instvar decoders_ channels_
	if [info exists decoders_] {
		foreach d $decoders_ {
			$d set maxChannel_ $n
		}
	}
	set channels_ $n
}
VideoAgent public create_decoder src {
	set c [$self classmap [$src format_name]]
	set decoder [new Module/VideoDecoder/$c]
	if { $decoder == "" } {
		set decoder [new Module/VideoDecoder/Null]
	}
	$decoder set agent_ $self
	$decoder set src_ $src
	$self instvar channels_
	$decoder set maxChannel_ $channels_
	return $decoder
}
Module instproc frame-format {} "return 422"
Module/VideoEncoder/Pixel/H261 instproc frame-format {} "return cif"
Module/VideoEncoder/Pixel/PVH instproc frame-format {} "return 411"
Module/VideoEncoder/Pixel/LDCT instproc frame-format {} "return 411"
Module/VideoEncoder set nb_ 0
Object Device
Device proc register_class c {
	$c proc nickname {} {
		return [$self set nickname_]
	}
	$c proc attributes {} {
		return [$self set attributes_]
	}
	foreach method "get_attribute supports" {
		$c proc $method args "eval Device $method $c \$args"
	}
}
Device proc get_attribute { cl attr } {
	$cl instvar attributes_
	set k [lsearch -exact $attributes_ $attr]
	if { $k >= 0 } {
		incr k
		return [lindex $attributes_ $k]
	}
	return ""
}
Device proc supports { cl key item } {
	set itemList [$self get_attribute $cl $key]
	if { $item == "*" } {
		if { $itemList == "" } {
			return 0
		} else {
			return 1
		}
	} else {
		return [inList $item $itemList]
	}
}
if [TclObject is-class VideoCapture] {
	foreach c [VideoCapture info subclass] {
		Device register_class $c
	}
}
proc inList { item L } {
	return [expr [lsearch -exact $L $item] >= 0]
}
Class VideoTap
VideoTap public init {} {
	$self next
	$self instvar device_ running_ fps_ bps_ decimate_
	set device_ ""
	set running_ 0
	set fps_ 8
	set bps_ 128000
	set decimate_ 2
}
VideoTap public target { target encoder } {
	$self instvar grabber_
	$grabber_ encoder $encoder
	$grabber_ target $target
}
VideoTap public running {} {
	return [$self set running_]
}
VideoTap public input_devices {} {
	if ![TclObject is-class VideoCapture] {
		return ""
	}
	return [VideoCapture info subclass]
}
VideoTap public release {} {
	$self instvar grabber_
	if [info exists grabber_] {
		$self close
	}
}
VideoTap public close {} {
	$self instvar grabber_ capwin_
	$self stop
	delete $grabber_
	unset grabber_
	if [info exists capwin_] {
		delete $capwin_
		destroy [winfo toplevel capwin_]
		unset capwin_
	}
}
VideoTap public stop {} {
	$self instvar running_ grabber_ capwin_
	if $running_ {
		$grabber_ send 0
		set running_ 0
		if [info exists capwin_] {
			wm withdraw [winfo toplevel $capwin_]
		}
	}
}
VideoTap public start {} {
	$self instvar running_ grabber_ capwin_
	if !$running_ {
		if ![info exists grabber_] {
			set err [$self open_device]
			if { $err != "" } {
				return $err
			}
		}
		if [info exists capwin_] {
			wm deiconify [winfo toplevel $capwin_]
			update idletasks
		}
		$grabber_ send 1
		set running_ 1
	}
	return ""
}
VideoTap public fillrate v {
	$self instvar grabber_
	if [info exists grabber_] {
		$grabber_ fillrate $v
	}
}
VideoTap public open { device videoType } {
	$self instvar grabber_ device_ capwin_ fps_ bps_ decimate_ port_
	if [info exists grabber_] {
		$self close
	}
	set device_ $device
	set grabber_ [new $device_ $videoType]
	if { $grabber_ == "" && $videoType == "411" } {
		set grabber_ [new $device_ cif]
	}
	if { $grabber_ == "" } {
		$self fatal "couldn't set up [$device nickname] grabber for $videoType"
	}
	set error [$grabber_ status]
	if { $error < 0 } {
		$self close
		if { $error == -2 } {
			return "Can't use jvideo with $format_ format"
		}
		return "can't open [$device_ nickname] capture device"
	}
	if { [$grabber_ need-capwin] && ![info exists capwin_] } {
		toplevel .capture -class Vic
		wm title .capture "Video Capture Window"
		$grabber_ create-capwin .capture.video
		set capwin_ .capture.video
		pack .capture.video
		bind .capture <Visibility> "raise .capture"
	}
	$grabber_ fps $fps_
	$grabber_ bps $bps_
	$grabber_ decimate $decimate_
	if [info exists port_] {
		$grabber_ port $port_
	}
	return ""
}
VideoTap instproc grabber args {
	$self instvar grabber_
	if [info exists grabber_] {
		eval $grabber_ $args
	}
}
VideoTap instproc set_bps v {
	$self instvar grabber_ bps_
	set bps_ $v
	if [info exists grabber_] {
		$grabber_ bps $v
	}
}
VideoTap instproc set_fps v {
	$self instvar grabber_ fps_
	set fps_ $v
	if [info exists grabber_] {
		$grabber_ fps $v
	}
}
VideoTap instproc set_decimate v {
	$self instvar grabber_ decimate_
	set decimate_ $v
	if [info exists grabber_] {
		$grabber_ decimate $v
	}
}
VideoTap instproc set_port p {
	$self instvar grabber_ port_
	set port_ $p
	if [info exists grabber_] {
		$grabber_ port $p
	}
}
Class VideoPipeline -superclass RTP/Video -configuration {
	mtu 1024 
}
VideoPipeline public init session {
	$self next
	$self instvar format_ tap_ session_ quality_ initialized_
	set tap_ [new VideoTap]
	set session_ $session
	set format_ ""
	set quality_ 10
        set initialized_ 0
}
VideoPipeline public set_decimate { v } {
	return [[$self set tap_] set_decimate $v]
}
VideoPipeline public running {} {
	return [[$self set tap_] running]
}
VideoPipeline public input_devices {} {
	return [[$self set tap_] input_devices]
}
VideoPipeline public set_bps args {
	return [eval [$self set tap_] set_bps $args]
}
VideoPipeline public set_fps args {
	return [eval [$self set tap_] set_fps $args]
}
VideoPipeline public start args {
        $self instvar initialized_ device_ format_
        if {!$initialized_} {
	    set err [$self open $device_ $format_]
	    if {$err==""} {
		set initialized_ 1
	    } else {
		return $err
	    }
	}
	return [eval [$self set tap_] start $args]
}
VideoPipeline public stop args {
	return [eval [$self set tap_] stop $args]
}
VideoPipeline public set_port args {
	return [eval [$self set tap_] set_port $args]
}
VideoPipeline public fillrate args {
	return [eval [$self set tap_] fillrate $args]
}
VideoPipeline public hardware args {
	return [eval [$self set tap_] grabber $args]
}
VideoPipeline public available_formats d {
	set sizes [$d get_attribute size]
	set formats [$d get_attribute format]
	set fmtList ""
	if [inList 422 $formats] {
		set fmtList "$fmtList nv nvdct cellb jpeg"
	}
	if [inList 411 $formats] {
		set fmtList "$fmtList pvh"
	}
	if [inList cif $sizes] {
		set fmtList "$fmtList h261"
	}
	if [inList jpeg $formats] {
		set fmtList "$fmtList jpeg"
		if [$self yesno [$self get_option useJPEGforH261]] {
			set fmtList "$fmtList h261"
		}
	}
	return $fmtList
}
VideoPipeline public release_device {} {
	$self instvar tap_ initialized_
	if $initialized_ {
		$self close
	}
}
VideoPipeline private close {} {
	$self instvar encoder_ tap_ initialized_
	$tap_ release
        set initialized_ 0
	if [info exists encoder_] {
		delete $encoder_
		unset encoder_
	}
}
VideoPipeline public select { device format } {
	$self instvar tap_
	set running [$tap_ running]
        $self instvar device_ format_ initialized_
        if $initialized_ {
	    if {($device_!=$device)||($format_!=$format)} {
		$self close
		set err [$self open $device $format]
	    }
	}
        set device_ $device
        set format_ $format
	if $running {
	    if {$err!=""} {return $err}
		$self start
	}
}
VideoPipeline private create_encoder fmt {
	set pt [$self rtp_fmt_number $fmt]
	if { $fmt == "nvdct" } {
		set encoder [new Module/VideoEncoder/Pixel/NV]
		$encoder use-dct 1
	} else {
		set fmt [$self classmap $fmt]
		set encoder [new Module/VideoEncoder/Pixel/$fmt]
	}
	if { $encoder == "" } {
		$self fatal "cannot allocate $fmt encoder"
	}
	if {$pt >= 0} {
		$encoder set pt_ $pt
	}
	return $encoder
}
VideoPipeline instproc open { device format } {
	set useJPEGforH261 [$self yesno [$self get_option useJPEGforH261]]
	$self instvar tap_ encoder_ format_ bufferPool_ session_ quality_
	$tap_ release
	set format_ $format
	set DF [$device get_attribute format]
	set DS [$device get_attribute size]
	if [inList $format_ $DF] {
		set encoder_ [$self create_encoder $format_]
		set grabtarget $encoder_
		set grabq ""
	} elseif { $format_ == "h261" && [inList jpeg $DF] && \
			$useJPEGforH261 } {
		set transcoder [new transcoder/jpeg/dct]
		set encoder_ [new Module/VideoEncoder/DCT/H261]
		$transcoder target $encoder_
		set grabtarget $transcoder
		set grabq "70"
	} elseif { [inList $format_ [$self available_formats $device] ] } {
		set encoder_ [$self create_encoder $format_]
		set grabtarget $encoder_
		set grabq ""
	}
	$encoder_ mtu [$self get_option mtu]
	if ![info exists bufferPool_] {
		set bufferPool_ [new BufferPool/RTP]
		$bufferPool_ srcid [$session_ get_local_srcid]
	}
	$encoder_ buffer-pool $bufferPool_
	$encoder_ target [$session_ get_transmitter]
	set ff [$grabtarget frame-format]
	set err [$tap_ open $device $ff]
	if { $err != "" } {
		return $err
	}
	$tap_ target $grabtarget $encoder_
	$self set_quality $quality_
	return ""
}
VideoPipeline public set_quality q {
	$self instvar format_ quality_
	set quality_ $q
	if { [catch "$self setq_$format_ $q" val] == 0 } {
		return $val
	}
	return -1
}
VideoPipeline private setq_jpeg value {
	incr value
	if { $value > 95 } {
		set value 95
	} elseif { $value < 5 } {
		set value 5
	}
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
VideoPipeline instproc setq_h261 value {
	set value [expr int((1 - $value / 100.) * 29) + 1]
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
VideoPipeline instproc setq_nv value {
	set value [expr (100 - $value) / 10]
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
set pvh_shmap { 0 1 2 1 }
set pvh_shs {
	{ lum-dct 0 5-1--11- }
	{ lum-dct 1 ---5111- }
	{ lum-dct 2 --51-11- }
	{ lum-sbc 0 ----4--2 }
	{ lum-sbc 1 ----4--2 }
	{ lum-sbc 2 ----4--2 }
	{ chm     0 -5---1-- }
	{ chm     1 ---5-1-- }
	{ chm     2 --5--1-- }
}
VideoPipeline instproc setq_pvh value {
	$self instvar encoder_
	if ![info exists encoder_] {
		return -1
	}
	global pvh_shmap pvh_shs
	set n [llength $pvh_shmap]
	set i 0
	while { $i < $n } {
		$encoder_ shmap $i [lindex $pvh_shmap $i]
		incr i
	}
	set i 0
	foreach tuple $pvh_shs {
		set compID [lindex $tuple 0]
		set shID [lindex $tuple 1]
		set pattern [lindex $tuple 2]
		$encoder_ comp $compID $shID $pattern
	}
	return -1
}
Class VideoHandler
VideoHandler public init { spec {callback {}} } {
	$self instvar agent_ vpipe_ localbw_
        set agent_ [new VideoAgent $self $spec $callback]	
	set vpipe_ [new VideoPipeline $agent_]
	set localbw_ [$self get_option videoSessionBW]
	if { $localbw_ == "" } {
		set localbw_ [$self get_option maxVideoSessionBW]
	}
	$agent_ sessionbw $localbw_
	if { [$self get_option useScuba] != "" } {
		$self init_scuba $spec 
	}
}
VideoHandler public agent {} {
	return [$self set agent_]
}
VideoHandler public vpipe {} {
	return [$self set vpipe_]
}
VideoHandler private init_scuba { spec } {
	$self instvar scuba_sess_ localbw_
	$self instvar vpipe_ agent_
	set rtpsess [$agent_ set session_]
	$rtpsess rtcp-thumbnail 1
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
	} else {
		set ab ""
	}
	set scuba_sess_ [new Session/Scuba/Vic $rtpsess $agent_ $ab $vpipe_]
	if { $ab != "" } {
		delete $ab
	}
	$scuba_sess_ sessionbw $localbw_
	$agent_ attach $scuba_sess_
}
VideoHandler instproc reset { ab } {
	$self instvar scuba_sess_ 
	if { [$self get_option useScuba] != "" } {
		$scuba_sess_ reset $ab
	}
}
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 {
	inputGain 32
	outputGain 180
	maxPlayout 6
	mikeAGCLevel 0
	speakerAGCLevel 0
	echoSuppressTime 400
	silenceThresh 20
	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]
	} else { 
		set ab ""
	}
	$self next $ab $callback
	if { $ab != "" } {
		delete $ab
	}	
	$self set-bandwidth 128000
	$self compute_controller_defaults
	$self site-drop-time [$self get_option siteDropTime]
	$self instvar bufferPool_ silenceThresh_ decoders_ audioTest_
	set decoders_ ""
	set silenceThresh_ 0
	set audioTest_ none
	if ![info exists bufferPool_] {
		set bufferPool_ [new BufferPool/RTP]
	}
	$self instvar classmap_
	set classmap_(pcm) PCM
	set classmap_(lpc) LPC
	set classmap_(gsm) GSM
	set classmap_(dvi) ADPCM
	set devList [$self device_list]
	if { $devList == "" } {
		$self fatal "no suitable audio device found."
	}
	foreach d $devList {
		if { "$d" != "AF" } {
			break
		} elseif [$self yesno useAF] {
			break
		}
	}
	$self open_device $d
	$self select_format PCM 2
	$self set_input_mute 1
	$self set_output_mute 0
	$self set_output_gain 5
	if ![$self have_audio] {
		$self obtain
	}
	$self instvar al_
	if { [$app get_option megaAudioSession] != "" } {
		set sname [$app 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 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 bufferPool_ audio_
	delete $bufferPool_
	$self close_device
	$self next
}
AudioAgent public reset_mega {} {
    $self instvar al_
    $al_ reset_spec [$self get_option audioSessionSpec]
}
AudioAgent private compute_controller_defaults {} {
	set AUDIO_SPS 8000
	set TALK_LEAD 4
	set TALK_TAIL 32
	set AUDIO_FRAMESIZE 160
	set SS_GRANULARITY 1440
	set v [expr [$self get_option maxPlayout] * $AUDIO_SPS]
	if [expr $v < ($TALK_LEAD + $TALK_TAIL + 2) * $AUDIO_FRAMESIZE] {
		set w [expr (($TALK_LEAD + $TALK_TAIL + 2) * \
			$AUDIO_FRAMESIZE + $AUDIO_SPS - 1) / $AUDIO_SPS]
		puts stderr "max playout delay $v too short - using $w sec"
		set v [expr ($TALK_LEAD + $TALK_TAIL + 2) * $AUDIO_FRAMESIZE]
	}
	set v [expr ($v + ($SS_GRANULARITY - 1)) / $SS_GRANULARITY]
	set v [expr $v * $SS_GRANULARITY / $AUDIO_FRAMESIZE]
	AudioController set max_playout_ $v
	AudioController set echo_suppress_time_ [expr \
		[$self get_option echoSuppressTime] / 20 * $AUDIO_FRAMESIZE]
}
AudioAgent private activate src {
	$self instvar decoders_
	set d [$self create_decoder $src]
	lappend decoders_ $d
	$src handler $d
	$self next $src
}
AudioAgent private deactivate src {
	$self instvar decoders_
	set d [$src handler]
	set k [lsearch -exact $decoders_ $d]
	set decoders_ [lreplace $decoders_ $k $k]
	$self next $src
	delete $d
}
AudioAgent 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 controller_ classmap_
	set decoder [new Module/AudioDecoder/$classmap_([$src format_name])]
	if { $decoder == "" } {
		set decoder [new Module/AudioDecoder/Null]
	}
	if ![info exists controller_] {
		puts stderr "AudioAgent: no audio controller."
		exit 0
	}
	$decoder set agent_ $self
	$decoder set src_ $src
	$decoder controller $controller_
	$src handler $decoder
	return $decoder
}
AudioAgent public select_format { fmt blksPerPkt } {
	$self instvar encoder_ bufferPool_ mtu_ session_ \
			controller_ blksPerPkt_ classmap_
	if [info exists encoder_] {
		delete $encoder_
	}
	set encoder_ [new Module/AudioEncoder/$fmt]
	set blksPerPkt_ $blksPerPkt
	if [info exists controller_] {
		$controller_ encoder $encoder_
		$controller_ blocks-per-packet $blksPerPkt
	}
	if { "$encoder_" == "" } {
		return -1
	}
	$encoder_ target $session_
	$encoder_ buffer-pool $bufferPool_
	return 0
}
AudioAgent private create_session {} {
	return [new Session/RTP/Audio]
}
AudioAgent public reset ab {
	$self next $ab
	$self app_loopback 0
	$self net_loopback [$self get_option loopback]
	$self set-bandwidth 128000
	$self instvar set_pool_srcid_
	if ![info exists set_pool_srcid_] {
		$self instvar bufferPool_
		if ![info exists bufferPool_]  {
			set bufferPool_ [new BufferPool/RTP]
		}
		$bufferPool_ srcid [$self get_local_srcid]
		set set_pool_srcid_ 1
	}
}
AudioAgent instproc reset_source_offsets {} {
	$self instvar decoders_
	foreach d $decoders_ {
		$d reset-offset
	}
}
AudioAgent public device_list {} {
	if ![TclObject is-class Audio] {
		return ""
	}
	return [Audio info subclass]
}
AudioAgent public bind_transducer { which o } {
	$self instvar meter_ controller_
	set meter_($which) $o
	if [info exists controller_] {
		$controller_ $which-meter $o
	}
}
AudioAgent private open_device dev {
	$self instvar audio_ meter_ controller_ silenceThresh_
	if [info exists audio_] {
		delete $audio_
		unset audio_
	}
	if [info exists controller_] {
		delete $controller_
		unset controller_
	}
	set audio_ [new $dev]
	$self instvar gain_
	set names [$self get_input_ports]
	foreach port $names {
		if {[$self get_option $port\Gain]!={}} {
			set gain_($port) [$self get_option $port\Gain]
		} else {
			set gain_($port) [$self get_option inputGain]
		}
	}
	set names [$self get_output_ports]
	foreach port $names {
		if {[$self get_option $port\Gain]!={}} {
			set gain_($port) [$self get_option $port\Gain]
		} else {
			set gain_($port) [$self get_option outputGain]
		}
		$self set_speakerphone $port [$self get_option $port\Mode]
	}
	$self instvar port_
	set port_(input) ""
	set port_(output) ""
}
AudioAgent private install_controller {} {
	$self instvar audio_ encoder_ blksPerPkt_ silenceThresh_ meter_ \
		controller_
	if [$audio_ set duplex_] {
		set duplex FullDuplex
	} else {
		set duplex HalfDuplex
		if ![$self have_audio] {
			$self obtain
		}
		if { [$self yesno forceFullDuplex] || [$audio_ set duplex_] } {
			set duplex FullDuplex
		}
	}
	set controller_ [new AudioController/$duplex]
	$controller_ audio $audio_
	if [info exists meter_(input)] {
		$controller_ input-meter $meter_(input)
	}
	if [info exists meter_(output)] {
		$controller_ output-meter $meter_(output)
	}
	$controller_ silence-thresh $silenceThresh_
	if [info exists encoder_] {
		$controller_ encoder $encoder_
		$controller_ blocks-per-packet $blksPerPkt_
	}
	$controller_ agc-input [$self get_option mikeAGCLevel]
	$controller_ agc-output [$self get_option speakerAGCLevel]
	$controller_ silence-thresh [$self get_option silenceThresh]
}
AudioAgent public obtain {} {
	$self instvar audio_ controller_
	$audio_ obtain
	if { ![info exists controller_] && [$audio_ have] } {
		$self install_controller
	}
}
AudioAgent public release {} {
	[$self set audio_] release
}
AudioAgent public set_silence_thresh thresh {
	$self instvar silenceThresh_ controller_
	set silenceThresh_ $thresh
	if [info exists controller_] {
		$controller_ silence-thresh $silenceThresh_
	}
}
AudioAgent public have_audio {} {
	$self instvar audio_
	if [info exists audio_] {
		return [$audio_ have]
	}
	return 0
}
AudioAgent public set_input_mute val {
	$self instvar audio_
	$audio_ set_input_mute $val
}
AudioAgent public set_output_mute val {
	$self instvar audio_
	$audio_ set_output_mute $val
}
AudioAgent public get_input_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_input_ports]]
}
AudioAgent public get_output_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_output_ports]]
}
AudioAgent public is_halfduplex {} {
	$self instvar audio_
	return [expr ![$audio_ set duplex_]]
}
AudioAgent public get_input_portno { } {
	$self instvar audio_
	return [$audio_ get_input_port]
}
AudioAgent public get_output_portno { } {
	$self instvar audio_
	return [$audio_ get_output_port]
}
AudioAgent public set_speakerphone { port mode } {
	$self instvar speakerphone_ port_
	set speakerphone_($port) $mode	
	if { [info exists port_(output)] && $port == $port_(output) } {
		$self instvar audio_
		$audio_ set_speakerphone $mode
	}
}
AudioAgent public audio_test type {
	$self instvar audioTest_ controller_
	$self set audioTest_ $type
	if [info exists controller_] {
		if { $type == "loopback" } {
			$controller_ test_tone none
			$controller_ loopback 1
		} else {
			$controller_ test_tone $type
			$controller_ loopback 0
		}
	}
}
AudioAgent private port_name_to_num { which name } {
	set L [$self get_$which\_ports]
	return [lsearch -exact $L $name]
}
AudioAgent public set_input_port port {
	$self instvar audio_ port_ gain_ speakerphone_
	set port_(input) $port
	$audio_ set_input_port [$self port_name_to_num input $port]
	$self set_input_gain $gain_($port)
}
AudioAgent public set_output_port port {
	$self instvar audio_ port_ gain_ speakerphone_
	set port_(output) $port
	$audio_ set_output_port [$self port_name_to_num output $port]
	$self set_output_gain $gain_($port)
	$self set_speakerphone $port $speakerphone_($port)
}
AudioAgent public set_input_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(input)) $gain
	return [$audio_ set_input_gain $gain]
}
AudioAgent public set_output_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(output)) $gain
	return [$audio_ set_output_gain $gain]
}
AudioAgent public get_input_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(input))
}
AudioAgent public get_output_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(output))
}
AudioAgent private close_device {} {
	if [info exists audio_] {
		delete $audio_
		unset audio_
		delete $controller_
		unset controller_
	}
}
AudioAgent public is_active {} {
	$self instvar controller_ audioTest_
	if [info exists controller_] {
		if { $audioTest_ != "none" } {
			return 1
		}
		return [$controller_ active]
	}
	return 0
}
AudioAgent public clear_active {} {
	$self instvar controller_
	if [info exists controller_] {
		$controller_ active 0
	}
}
AudioAgent instproc unix_time {} {
	$self instvar controller_
	if [info exists controller_] {
		return [$controller_ unix_time]
	}
	return 0
}
AudioAgent instproc ntp_time {} {
	$self instvar controller_
	if [info exists controller_] {
		return [$controller_ ntp_time]
	}
	return 0
}
bind Entry <Enter> {
	catch {
		global entryTab
		if $entryTab(%W:focus) {
			focus %W
		}
	}
}
bind Entry <Return> {
	focus .
	%W select clear
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		set oldval $entryTab(%W:value)
		set v [%W get]
		set entryTab(%W:value) $v
		if [$entryTab(%W:object) update $v] {
			set entryTab(%W:value) $oldval
			%W delete 0 end
			%W insert 0 $oldval
		}
	}
}
bind Entry <Escape> {
	focus .
	%W select clear
	%W delete 0 end
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		%W insert 0 $entryTab(%W:value)
	}
}
bind Entry <Control-g> [bind Entry <Escape>]
bind Entry <Control-u> {
    tkEntrySetCursor %W 0
    %W delete insert end
}
proc mk.entry { w action text } {
	puts stderr "Use the new Entry class"
	exit 1
}
Class Entry
Entry instproc init { w value {obj {}} } {
	$self instvar win_
	set win_ $w
	entry $w -relief raised -borderwidth 1 -exportselection 1 \
		-font [$self get_option entryFont]
	global entryTab
	if {$obj == {}} {
		set entryTab($w:object) $self
	} else {
		set entryTab($w:object) $obj
	}
	set entryTab($w:value) $value
	$w insert 0 $value
}
Entry instproc entry-value { } {
	global entryTab		
	$self instvar win_
	return $entryTab($win_:value)
}
Entry instproc 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 ""
}
set nids 0
proc uniqueID { } {
	global nids
	incr nids
	return $nids
}
proc isCIF fmt {
	if { $fmt == "h261" } {
		return 1
	}
	return 0
}
proc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
set current_icon_mark "XXX"
proc mk.key w {
	puts stderr "Use the new KeyEditor class"
	exit 1
}
Class KeyEditor
KeyEditor instproc init { w crypt } {
	$self instvar crypt_ entry_ win_
	set crypt_ $crypt
	set win_ $w
	frame $w.key
	checkbutton $w.key.button -text "Encryption Key:" -relief flat \
		-font [$self get_option smallfont] \
		-command "$self toggle" -variable [$self tkvarname encryptOn_]\
		-disabledforeground gray40
	set key [$self get_option sessionKey]
	set entry_ [new Entry $w.key.entry $key $self]
	$self set-key $key
	pack $w.key.button -side left
	pack $w.key.entry -side left -fill x -expand 1
}
KeyEditor instproc disable {} {
	$self instvar win_
	$win_.key.button configure -state disabled
}
KeyEditor instproc enable {} {
	$self instvar win_
	$win_.key.button configure -state normal
}
KeyEditor instproc set-key key {
	$self tkvar encryptOn_
	$self instvar crypt_
	if { $key == "" } {
		$crypt_ crypt_clear
		set encryptOn_ 0
		$self disable
	} elseif { [$crypt_ install-key $key] != "" } {
		$self disable
		set encryptOn_ 0
		$self clear
	} else {
		$self enable
		set encryptOn_ 1
	}
}
KeyEditor instproc toggle {} {
	$self instvar crypt_ entry_
        $self tkvar encryptOn_
	if $encryptOn_ {
		$crypt_ install-key [$entry_ entry-value]
	} else {
		$crypt_ install-key ""
	}
}
KeyEditor instproc update key {
	set key [string trim $key]
	$self set-key $key
	return 0
}
Class TextEntry -superclass Entry
TextEntry instproc init { target w text } {
	$self next $w $text
	$self set target_ $target
}
TextEntry instproc update s {
	$self instvar target_
	if { $s != "" } {
		set s [string trim $s]
	}
	return [eval $target_ \"$s"]
}
Class TkWindow -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
}
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
}
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
}
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
}
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
	$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
	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
		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 ControlMenu -superclass TopLevelWindow -configuration {
	recvOnly 0
	framerate 8
	maxbw -1
	bandwidth 128000 
	useHardwareDecode false 
	stillGrabber false 
}
ControlMenu proc fork_histtolut { } {
	$self tkvar ditherStyle_
	$self instvar vframe_ asm_ optionsMenu_
	if { $ditherStyle_ == "gray" } {
		new ErrorWindow "cannot optimize grayscale rendering"
		return
	}
	set ch [[$vframe_ set colorModel_] create-hist]
	set active 0
	foreach src [$asm_ active-sources] {
		set d [$src handler]
		if { ![$src mute] && $d != "" } {
			$d histogram $ch
			set active 1
		}
	}
	if !$active {
		new ErrorWindow "no active, unmuted sources"
		delete $ch
		return
	}
	set pid [pid]
	set outfile /tmp/vicLUT.$pid
	set infile /tmp/vicHIST.$pid
	if { [$ch dump $infile] < 0 } {
		new ErrorWindow "couldn't create $infile"
		delete $ch
		return
	}
	delete $ch
	set eflag ""
	if { $ditherStyle_ == "ed" } {
		set eflag "-e"
	}
	if [catch \
	  "open \"|histtolut $eflag -n 170 -o $outfile $infile\"" pipe] {
		new ErrorWindow "histtolut not installed in your path"
		return
	}
	fileevent $pipe readable "$self finish_histtolut $pipe $infile $outfile"
	$optionsMenu_ entryconfigure "Optimize Colormap" \
		-state disabled
	.menu configure -cursor watch
}
ControlMenu proc finish_histtolut { pipe infile outfile } {
	.menu configure -cursor ""
	$self instvar optionsMenu_ vframe_ asm_
	$optionsMenu_ entryconfigure "Optimize Colormap" -state normal
	set cm [$vframe_ set colorModel_]
	$cm free-colors
	$cm lut $outfile
	if ![$cm alloc-colors] {
		$vframe_ revert_to_gray
	}
	foreach src [$asm_ active-sources] {
		set d [$src handler]
		if { $d != "" } {
			$d redraw
		}
	}
	fileevent $pipe readable ""
	close $pipe
}
ControlMenu instproc have_transmit_permission {} {
	$self instvar vpipe_
	if { [$vpipe_ input_devices] != "" } {
		return ![$self yesno recvOnly]
	}
	return 0
}
ControlMenu instproc init { mainUI agent vpipe vframe asm uiSrcListWin} {
	$self next .menu
	$self instvar ui_ videoAgent_ qval_ lastFmt_ path_ vpipe_ ui_srclist_ vframe_ asm_
	set ui_ $mainUI
	set ui_srclist_ $uiSrcListWin
	set videoAgent_ $agent
	set vpipe_ $vpipe
	set vframe_ $vframe
	set asm_ $asm
	set lastFmt_ ""
	set qval_(h261) 68
	set qval_(nv) 80
	set qval_(nvdct) 80
	set qval_(pvh) 60
	set qval_(ldct) 68
	set qval_(jpeg) 29
	$self tkvar useHardwareDecode_ ditherStyle_
	set ditherStyle_ [$vframe_ set dither_]
	set useHardwareDecode_ [$self yesno useHardwareDecode]
	$self tkvar muteNewSources
	set muteNewSources [$self yesno muteNewSources]
}
ControlMenu instproc build w {
	$self create-window $w "Video Control Menu"
	wm withdraw $w
	catch "wm resizable $w false false"
	frame $w.session
	frame $w.cb
	$self build.xmit $w.cb
	if { [$self yesno useScuba] && [$self get_option megaVideoSession] != ""} {
		frame $w.scuba
		$self build.scuba $w.scuba
	}
	frame $w.encoder
	$self build.encoder $w.encoder
	frame $w.decoder
	$self build.decoder $w.decoder
	$self instvar videoAgent_
	$self build.session $w.session \
		[$videoAgent_ session-addr] \
		[$videoAgent_ session-sport]:[$videoAgent_ session-rport] \
		[$videoAgent_ get_local_srcid] \
		[$videoAgent_ session-ttl] \
		[$videoAgent_ local-name]
	button $w.dismiss -text Dismiss -borderwidth 2 -width 8 \
		-relief raised -anchor c \
		-command "$self toggle" -font [$self get_option medfont]
	pack $w.cb -padx 6 -fill x -expand 1
	if { [$self yesno useScuba] && [$self get_option megaVideoSession] != "" } {
		pack $w.scuba -padx 6 -fill x -expand 1
	}
	pack $w.encoder $w.decoder $w.session -padx 6 -fill x -expand 1
	pack $w.dismiss -anchor c -pady 4 
	if [$self have_transmit_permission] {
		$self selectInitialDevice
	}
}
ControlMenu instproc selectInitialDevice {} {
	$self instvar vpipe_ device_
	set L [$vpipe_ input_devices]
	set d [$self get_option defaultDevice]
	foreach v $L {
		if { [$v nickname] == "$d" && \
			[$v attributes] != "disabled" } {
			set device_ $v
			$self select_device $v
			return
		}
	}
	foreach v $L {
		if { "[$v attributes]" != "disabled" &&
			"[$v nickname]" != "still" } {
			set device_ $v
			$self select_device $v
			return
                }
	}
}
ControlMenu instproc create_global_window {} {
	$self instvar src_ global_win_
	if [info exists global_win_] {
		$self delete_global_window
	} else {
		set global_win_ [new GlobalWindow .globalStats "Session Stats" "$self stats" "$self delete_global_window"]
	}
}
ControlMenu instproc delete_global_window {} {
	$self instvar global_win_
	delete $global_win_
	unset global_win_
}
ControlMenu instproc stats {} {
	return [[$self set videoAgent_] stats]
}
ControlMenu instproc new_hostspec {} {
	$self instvar videoAgent_ addrspec_ namespec_
	if ![info exists addrspec_] {
		return
	}
	set dst [$videoAgent_ session-addr]
	set port [$videoAgent_ session-sport]:[$videoAgent_ session-rport]
	set ttl [$videoAgent_ session-ttl]
	set srcid [$videoAgent_ get_local_srcid]
	$addrspec_ configure -text \
			"Dest: $dst   Port: $port  ID: $srcid  TTL: $ttl"
	set name [$videoAgent_ local-name]
	$namespec_.entry delete 0 end
	$namespec_.entry insert 0 $name
	$self instvar transmitButton_
	$transmitButton_ configure -state normal
}
ControlMenu instproc build.session { w dst port srcid ttl name } {
	set f [$self get_option smallfont]	
	label $w.title -text Session
	pack $w.title -fill x
	frame $w.nb -relief sunken -borderwidth 2
	pack $w.nb -fill x
	frame $w.nb.frame
	pack append $w.nb \
			$w.nb.frame { top fillx }
	$self instvar addrspec_ namespec_
	label $w.nb.frame.info -font $f -anchor w \
			-text "Dest: $dst   Port: $port  ID: $srcid  TTL: $ttl"
	set addrspec_ $w.nb.frame.info
	frame $w.nb.frame.name
	label $w.nb.frame.name.label -text "Name: " -font $f -anchor e -width 6
	new TextEntry "$self update_name" $w.nb.frame.name.entry $name
	pack $w.nb.frame.name.label -side left
	pack $w.nb.frame.name.entry -side left -expand 1 -fill x -pady 2
	set namespec_ $w.nb.frame.name
	frame $w.nb.frame.msg
	label $w.nb.frame.msg.label -text "Note: " -font $f -anchor e -width 6
	new TextEntry "$self update_note" $w.nb.frame.msg.entry ""
	pack $w.nb.frame.msg.label -side left
	pack $w.nb.frame.msg.entry -side left -expand 1 -fill x -pady 2
	$self instvar videoAgent_
	new KeyEditor $w.nb.frame $videoAgent_
	frame $w.nb.frame.b
	button $w.nb.frame.b.stats -text "Global Stats" -borderwidth 2 \
		-anchor c -font $f -command create_global_window
	$w.nb.frame.b.stats configure -state disabled
	$self instvar ui_srclist_
	button $w.nb.frame.b.members -text Members -borderwidth 2 \
		-anchor c -font $f -command "$ui_srclist_ toggle"
        pack $w.nb.frame.b.stats $w.nb.frame.b.members \
		-side left -padx 4 -pady 2 -anchor c
	pack $w.nb.frame.info $w.nb.frame.name $w.nb.frame.msg \
		$w.nb.frame.key \
		-fill x -padx 2 -expand 1
	pack $w.nb.frame.b -pady 2 -anchor c
}
ControlMenu instproc setFillRate {} {
	$self instvar vpipe_
	global sendingSlides 
	$self tkvar transmitButtonState_
	if $transmitButtonState_ {
		if $sendingSlides {
			$vpipe_ fillrate 16
		} else {
			$vpipe_ fillrate 2
		}
	}
}
ControlMenu instproc update_name name {
	if { $name != ""} {
		$self instvar videoAgent_
		$videoAgent_ set_local_sdes name $name
		return 0
	}
	return -1
}
ControlMenu instproc update_note note {
	$self instvar videoAgent_
	$videoAgent_ set_local_sdes note $note
	return 0
}
ControlMenu instproc transmit { } {
	$self instvar vpipe_ device_
	$self tkvar transmitButtonState_
	global videoFormat
	if $transmitButtonState_ {
		set err [$vpipe_ select $device_ $videoFormat]
		if { $err != "" } {
			set transmitButtonState_ 0
			new ErrorWindow $err
			$self select_device $device_
			return
		}
		set err [$vpipe_ start]
		if { $err != "" } {
			set transmitButtonState_ 0
			new ErrorWindow $err
			$self select_device $device_
			return
		}
		$self tx-init
	} else {
		$vpipe_ stop
	}
}
ControlMenu instproc release {} {
        $self tkvar transmitButtonState_
        set transmitButtonState_ 0
	[$self set vpipe_] release_device
}
ControlMenu instproc build.buttons w {
	set f [$self get_option smallfont]
	$self instvar transmitButton_
	$self tkvar transmitButtonState_
	set transmitButton_ $w.send
	set transmitButtonState_ 0
	checkbutton $w.send -text "Transmit" \
		-relief raised -command "$self transmit" \
		-anchor w -variable [$self tkvarname transmitButtonState_] \
		-font $f \
		-state disabled -highlightthickness 0
	button $w.release -text "Release" \
		-relief raised -command "$self release" \
		-font $f -highlightthickness 0
	pack $w.send $w.release -fill both
}
ControlMenu instproc invoke_transmit {} {
	$self instvar transmitButton_
	$transmitButton_ invoke
}
ControlMenu instproc set_sessionbw { w value } {
	$self instvar videoAgent_
	$videoAgent_ sessionbw $value
	$w configure -text [format_bps $value]
	update idletasks
}
ControlMenu instproc set_bps { w value } {
	$self instvar vpipe_ videoAgent_
	$vpipe_ set_bps $value
	$videoAgent_ local_bandwidth $value    
	$w configure -text [format_bps $value]
	update idletasks
}
ControlMenu instproc set_fps { w value } {
	$self instvar vpipe_
	$vpipe_ set_fps $value
	$w configure -text "$value f/s"
	update idletasks
}
ControlMenu instproc build.sliders w {
	set f [$self get_option smallfont]
	global V
	global btext ftext
	$self instvar videoAgent_ 
	set key [$videoAgent_ set session_]
	set ftext($key) "0.0 f/s"
	set btext($key) "0.0 kb/s"
	if [$self yesno useScuba] {
		set rctext "Rate Control (SCUBA)"
		set maxbw [$self get_option maxVideoSessionBW]
	} else {
		set rctext "Rate Control"
		set maxbw [$self get_option maxbw]
	}
	frame $w.info
	label $w.info.label -text $rctext -font $f
	label $w.info.fps -textvariable ftext($key) -width 6 \
		-font $f -pady 0 -borderwidth 0
	label $w.info.bps -textvariable btext($key) -width 8 \
		-font $f -pady 0 -borderwidth 0
	pack $w.info.label -side left
	pack $w.info.bps $w.info.fps -side right
	frame $w.bps
	scale $w.bps.scale -orient horizontal -font $f \
		-showvalue 0 -from 1 -to $maxbw \
		-command "$self set_bps $w.bps.value" -width 12 \
		-relief groove
	label $w.bps.value -font $f -width 8 -anchor w
	frame $w.fps
	scale $w.fps.scale -font $f -orient horizontal \
		-showvalue 0 -from 1 -to 30 \
		-command "$self set_fps $w.fps.value" -width 12 \
		-relief groove
	label $w.fps.value -font $f -width 8 -anchor w
	pack $w.info -fill x
	pack $w.bps $w.fps -fill x
	pack $w.bps.scale -side left -fill x -expand 1
	pack $w.bps.value -side left -anchor w 
	pack $w.fps.scale -fill x -side left -expand 1
	pack $w.fps.value -side left -anchor w
	if [$self yesno useScuba] {
		set s [$videoAgent_ set session_]
		$w.bps.scale set [$s data-bandwidth]
		$w.fps.scale set 30
	} else {
		$w.bps.scale set [$self get_option bandwidth]
		$w.fps.scale set [$self get_option framerate]
		$w.bps.scale configure -resolution 1000
		$w.bps.scale configure -from 1000
	}
	global fps_slider bps_slider
	set fps_slider $w.fps.scale
	set bps_slider $w.bps.scale
}
ControlMenu instproc insert_grabber_panel devname {
	set k [string first - $devname]
	if { $k >= 0 } {
		incr k -1
		set devname [string range $devname 0 $k]
	}
	set k [string first " " $devname]
	if { $k >= 0 } {
		incr k -1
		set devname [string range $devname 0 $k]
	}
	set devname [string tolower $devname]
	set w .menu.$devname
	global grabberPanel
	if [info exists grabberPanel] {
		if { "$grabberPanel" == "$w" } {
			return
		}
		pack forget $grabberPanel
		unset grabberPanel
	}
	if { [$class info instprocs build.$devname] != "" } {
		if ![winfo exists $w] {
			frame $w
			label $w.label -text "Grabber ($devname)"
			frame $w.frame -relief sunken -borderwidth 0
			$self build.$devname $w.frame
			pack $w.label $w.frame -side top -fill x -expand 1
		}
		pack $w -before .menu.encoder -padx 6 -fill x
		set grabberPanel $w
	}
}
ControlMenu instproc select_device device {
	global formatButtons \
		videoFormat defaultFormat lastDevice defaultPort inputPort
	$self instvar videoAgent_ vpipe_ sizeButtons_ portButton_ \
		transmitButton_ 
	$self tkvar transmitButtonState_ 
	set wasTransmitting $transmitButtonState_
	if [info exists lastDevice] {
		set defaultFormat($lastDevice) $videoFormat
		set defaultPort($lastDevice) $inputPort
	}
	set lastDevice $device
	$vpipe_ release_device
	$self configure_formats $device
	if [$videoAgent_ have_network] {
		$transmitButton_ configure -state normal
	}
	$self configure_sizes $device
	$self configure_port $device
	$self insert_grabber_panel [$device nickname]
	set videoFormat $defaultFormat($device)
	$self select_format $videoFormat
	if $wasTransmitting {
		$vpipe_ start
	}
}
ControlMenu instproc configure_port { device } {
	$self instvar portButton_
	if [$device supports port *] {
		$portButton_ configure -state normal
		$self attach_ports $device
	} else {
		$portButton_ configure -state disabled
	}
}
ControlMenu instproc configure_sizes { device } {
	$self instvar sizeButtons_
	if [$device supports size small] {
		$sizeButtons_.b0 configure -state normal
	} else {
		$sizeButtons_.b0 configure -state disabled
	}
	if [$device supports size large] {
		$sizeButtons_.b2 configure -state normal
	} else {
		$sizeButtons_.b2 configure -state disabled
	}
}
ControlMenu instproc configure_formats { device } {
	$self instvar vpipe_
	global formatButtons
	set fmtList [$vpipe_ available_formats $device]
	foreach b $formatButtons {
		set fmt [lindex [$b configure -value] 4]
		if { [inList $fmt $fmtList] } {
			$b configure -state normal
		} else {
			$b configure -state disabled
		}
	}
}
ControlMenu instproc build.device w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -menu $m -text Device... \
		-relief raised -width 10 -font $f
	if ![$self have_transmit_permission] {
		$w configure -state disabled
		return
	}
	menu $m
	$self build.device_menu $m
}
ControlMenu instproc build.device_menu m {
	set f [$self get_option smallfont]
	global defaultFormat videoFormat
	set videoFormat [$self get_option videoFormat]
	if { $videoFormat == "h.261" } {
		set videoFormat h261
	}
	$self instvar vpipe_
	foreach d [$vpipe_ input_devices] {
		if { [$d nickname] == "still" && ![$self yesno stillGrabber] } {
			set defaultFormat($d) $videoFormat
			continue
		}
		$m add radiobutton -label [$d nickname] \
			-command "$self select_device $d" \
			-value $d -variable device_ -font $f
		if { "[$d attributes]" == "disabled" } {
			$m entryconfigure [$d nickname] -state disabled
		}
		set fmtList [$vpipe_ available_formats $d]
		if [inList $videoFormat $fmtList] {
			set defaultFormat($d) $videoFormat
		} else {
			set defaultFormat($d) [lindex $fmtList 0]
		}
	}
}
ControlMenu instproc format_col { w n0 { n1 {} } {n2 {} }} {
	set f [$self get_option smallfont]
	frame $w
	global formatButtons
	radiobutton $w.b0 -text $n0 -relief flat -font $f -anchor w \
		-variable videoFormat -value $n0 -padx 0 -pady 0 \
		-command "$self select_format $n0"
	pack $w.b0
	lappend formatButtons $w.b0
	if { $n1 != "" } {
		radiobutton $w.b1 -text $n1 -relief flat -font $f -anchor w \
			-variable videoFormat -value $n1 -padx 0 -pady 0 \
			-command "$self select_format $n1"
		pack $w.b1 -fill x 
		lappend formatButtons $w.b1 
	} 
	if { $n2 != "" } {
		radiobutton $w.b2 -text $n2 -relief flat -font $f -anchor w \
			-variable videoFormat -value $n2 -padx 0 -pady 0 \
			-command "$self select_format $n2"
		pack $w.b2 -fill x 
		lappend formatButtons $w.b2
	}
}
ControlMenu instproc build.format w {
	$self format_col $w.p0 nv nvdct cellb 
	$self format_col $w.p1 jpeg h261 pvh 
	$self format_col $w.p2 ldct
	frame $w.glue0
	frame $w.glue1
	pack $w.glue0 -side left -fill x -expand 1
	pack $w.p0 $w.p1 $w.p2 -side left
	pack $w.glue1 -side left -fill x -expand 1
}
ControlMenu instproc set-port p {
	$self instvar vpipe_
	$vpipe_ set_port $p
}
ControlMenu instproc set-decimate p {
	$self instvar vpipe_
	$vpipe_ set_decimate $p
}
ControlMenu instproc build.size w {
	set f [$self get_option smallfont]
	set b $w.b
	frame $b
	radiobutton $b.b0 -text "small" -command "$self set-decimate 4" \
		-padx 0 -pady 0 \
		-anchor w -variable inputSize -font $f -relief flat -value 4
	radiobutton $b.b1 -text "normal" -command "$self set-decimate 2" \
		-padx 0 -pady 0 \
		-anchor w -variable inputSize -font $f -relief flat -value 2
	radiobutton $b.b2 -text "large" -command "$self set-decimate 1" \
		-padx 0 -pady 0 \
		-anchor w -variable inputSize -font $f -relief flat -value 1
	pack $b.b0 $b.b1 $b.b2 -fill x 
	pack $b -anchor c -side left
	global inputSize 
	set inputSize 2
	$self instvar sizeButtons_
	set sizeButtons_ $b
}
ControlMenu instproc build.port w {
	set f [$self get_option smallfont]
	menubutton $w -menu $w.menu -text Port... \
		-relief raised -width 10 -font $f -state disabled
	global inputPort
	$self instvar portButton_
	set portButton_ $w
	set inputPort undefined
}
ControlMenu instproc attach_ports device {
	$self instvar portButton_
	catch "destroy $portButton_.menu"
	set m $portButton_.menu
	$self build.port_menu $device $m
}
ControlMenu instproc build.port_menu { device m } {
	global inputPort defaultPort
	set portnames [$device get_attribute port]
	set f [$self get_option smallfont]
	menu $m
	foreach port $portnames {
		$m add radiobutton -label $port \
			-command "$self set-port $port" \
			-value $port -variable inputPort -font $f
	}
	if ![info exists defaultPort($device)] {
		set nn [$device nickname]
		if [info exists defaultPort($nn)] {
			set defaultPort($device) $defaultPort($nn)
		} else {
			set s [$self get_option defaultPort($nn)]
			if { $s != "" } {
				set defaultPort($device) $s
			} else {
				set defaultPort($device) [lindex $portnames 0]
			}
		}
	}
	set inputPort $defaultPort($device)
}
ControlMenu instproc build.type w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Signal... -menu $m -relief raised \
		-width 10 -font $f -state disabled
	menu $m
	$m add radiobutton -label "auto" -command "$self restart" \
		-value auto -variable inputType -font $f
	$m add radiobutton -label "NTSC" -command "$self restart" \
		-value ntsc -variable inputType -font $f
	$m add radiobutton -label "PAL" -command "$self restart" \
		-value pal -variable inputType -font $f
	$m add radiobutton -label "SECAM" -command "$self restart" \
		-value secam -variable inputType -font $f
	global inputType typeButton
	set inputType auto
	set typeButton $w
}
ControlMenu instproc build.encoder_buttons w {
	set f [$self get_option smallfont]
	$self build.encoder_options $w.options
	$self build.device $w.device
	$self build.port $w.port
	pack $w.device $w.port $w.options -fill x
}
ControlMenu instproc build.encoder_options w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Options... -menu $m -relief raised -width 10 \
		-font $f
	$self build.encoder_options_menu $m
}
ControlMenu instproc build.encoder_options_menu m {
	set f [$self get_option smallfont]
	$self tkvar useJPEGforH261_
	set useJPEGforH261_ [$self yesno [$self get_option useJPEGforH261]]
	menu $m
    	$m add checkbutton -label "Sending Slides" \
		-variable sendingSlides -font $f -command "$self setFillRate"
    	$m add checkbutton -label "Use JPEG for H261" \
		-variable useJPEGforH261_ \
		-font $f -command "$self restart"
}
ControlMenu instproc build.tile w {
	$self instvar asm_
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Tile... -menu $m -relief raised -width 10 \
		-font $f
	menu $m
	set v [$self tkvarname ncol]
	$m add radiobutton -label Single -command "$asm_ redecorate 1" \
		-value 1 -variable $v -font $f
	$m add radiobutton -label Double -command "$asm_ redecorate 2" \
		-value 2 -variable $v -font $f
	$m add radiobutton -label Triple -command "$asm_ redecorate 3" \
		-value 3 -variable $v -font $f
	$m add radiobutton -label Quad -command "$asm_ redecorate 4" \
		-value 4 -variable $v -font $f
}
ControlMenu instproc use-hw {} {
	$self tkvar useHardwareDecode_
	return $useHardwareDecode_
}
ControlMenu instproc mute-new-sources {} {
	$self tkvar muteNewSources
	return $muteNewSources
}
ControlMenu instproc build.decoder_options w {
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Options... -menu $m -relief raised -width 10 \
		-font $f
	menu $m
    	$m add checkbutton -label "Mute New Sources" \
		-variable [$self tkvarname muteNewSources] -font $f
    	$m add checkbutton -label "Use Hardware Decode" \
		-variable [$self tkvarname useHardwareDecode_] -font $f
	$m add separator
    	$m add command -label "Optimize Colormap" \
		-command "$self fork_histtolut" -font $f
	$self instvar optionsMenu_
	set optionsMenu_ $m
	$self tkvar ditherStyle_
	if { $ditherStyle_ == "" } {
		$m entryconfigure "Optimize Colormap" -state disabled
	}
}
ControlMenu instproc build.external w {
	set f [$self get_option smallfont]
	set m $w.menu
	global outputDeviceList
	if ![info exists outputDeviceList] {
		set outputDeviceList ""
	}
	if { [llength $outputDeviceList] <= 1 } {
		button $w -text External -relief raised \
			-width 10 -font $f -highlightthickness 0 \
			-command "extout_select $outputDeviceList"
	} else {
		menubutton $w -text External... -menu $m -relief raised \
			-width 10 -font $f 
		menu $m
		foreach d $outputDeviceList {
			$m add command -font $f -label [$d nickname] \
				-command "extout_select $d"
		}
	}
	if { $outputDeviceList == "" } {
		$w configure -state disabled
	}
}
ControlMenu instproc set-dither d {
	$self instvar vframe_
	$vframe_ set-dither $d
}
ControlMenu instproc build.dither w {
	set f [$self get_option smallfont]
	$self tkvar ditherStyle_
	if { $ditherStyle_ != "" } {
		set state normal
	} else {
		set state disabled
	}
	set v $w.h0
	frame $v
	set dvar [$self tkvarname ditherStyle_]
	radiobutton $v.b0 -text "Ordered" -command "$self set-dither Dither" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat -value Dither
	radiobutton $v.b1 -text "Error Diff" -command "$self set-dither ED" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat -value ED
	set v $w.h1
	frame $v
	radiobutton $v.b2 -text Quantize -command "$self set-dither Quant" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat \
		-value Quant
	radiobutton $v.b3 -text Gray -command "$self set-dither Gray" \
		-padx 0 -pady 0 \
		-anchor w -variable $dvar -state $state \
		-font $f -relief flat -value Gray
	pack $w.h0.b0 $w.h0.b1 -anchor w -fill x
	pack $w.h1.b2 $w.h1.b3 -anchor w -fill x
	pack $w.h0 $w.h1 -side left
}
Class GammaEntry -superclass Entry
GammaEntry instproc init { w value vframe } {
	$self next $w $value
	$self instvar vframe_
	set vframe_ $vframe
}
GammaEntry instproc update { w s } {
	$self instvar vframe_
	return [$vframe_ set-gamma $s]
}
ControlMenu instproc build.gamma w {
	$self instvar vframe_
	frame $w
	label $w.label -text "Gamma: " -font [$self get_option smallfont] -anchor e
	new GammaEntry $w.entry [$vframe_ set gamma_] $vframe_
	$w.entry configure -width 6
	$self tkvar ditherStyle_
	if { $ditherStyle_ == "" } {
		$w.entry configure -state disabled -foreground gray60
		$w.label configure -foreground gray60
	}
	pack $w.label -side left
	pack $w.entry -side left -expand 1 -fill x -pady 2
}
ControlMenu instproc build.decoder w {
	set f [$self get_option smallfont]
	label $w.title -text Display
	frame $w.f -relief sunken -borderwidth 2
	set v $w.f.h0
	frame $v
	$self build.external $v.ext
	$self build.tile $v.tile
	$self build.decoder_options $v.options
	pack $v.options $v.tile $v.ext -fill x -expand 1
	set v $w.f.h2
	frame $v
	frame $v.dither -relief groove -borderwidth 2
	$self build.dither $v.dither
	frame $v.bot
	$self build.gamma $v.bot.gamma
	$self instvar ui_srclist_
	set top [$ui_srclist_ widget_path]
	label $v.bot.mode -text "\[[winfo depth $top]-bit\]" -font $f
	pack $v.bot.gamma $v.bot.mode -side left -padx 4
	pack $v.dither $v.bot -anchor c -pady 2
	pack $w.f.h0 -side left -padx 6 -pady 6
	pack $w.f.h2 -side left -padx 6 -pady 6 -fill x -expand 1
	pack $w.title $w.f -fill x
}
ControlMenu instproc build.encoder w {
	label $w.title -text Encoder
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h0 -relief flat
	frame $w.f.h1 -relief flat
	frame $w.f.h0.eb -relief flat
	frame $w.f.h0.format -relief groove -borderwidth 2
	frame $w.f.h0.size -relief groove -borderwidth 2
	frame $w.f.h0.gap -relief flat -width 4
	$self build.encoder_buttons $w.f.h0.eb
	$self build.format $w.f.h0.format
	$self build.size $w.f.h0.size
	$self build.q $w.f.h1
	pack $w.f.h0.eb -side left -anchor n -fill y -padx 6 -pady 4
	pack $w.f.h0.format -side left -anchor n -fill both -expand 1
	pack $w.f.h0.size -side left -anchor c -fill both
	pack $w.f.h0.gap -side left -anchor c
	pack $w.f.h0 -fill x -pady 4
	pack $w.f.h1 -fill x -pady 6
	pack $w.title $w.f -fill x
}
ControlMenu instproc restart { } {
	$self tkvar transmitButtonState_
	$self tkvar useJPEGforH261_
	$self instvar vpipe_
	if $useJPEGforH261_ {
		$self add_option useJPEGforH261 true
	} else {
		$self add_option useJPEGforH261 false
	}
	if $transmitButtonState_ {
		$vpipe_ stop
		$vpipe_ release_device
		$self tx-init
		$vpipe_ start
	} else {
		$vpipe_ release_device
	}
}
ControlMenu instproc disable_large_button { } {
	$self instvar sizeButtons_
	global inputSize
	if { $inputSize == 1 } {
		set inputSize 2
		$self set-decimate 2
	}
	$sizeButtons_.b2 configure -state disabled
}
ControlMenu instproc enable_large_button { } {
	$self instvar device_ sizeButtons_
	if { [info exists device_] && \
		[$device_ supports size large] } {
		$sizeButtons_.b2 configure -state normal
	}
}
ControlMenu instproc setq value {
	$self instvar vpipe_ qvalue_
	set v [$vpipe_ set_quality $value]
	$qvalue_ configure -text $v
}
ControlMenu instproc select_format fmt {
	if { $fmt == "h261" } {
		$self disable_large_button
	} else {
		$self enable_large_button
	}
	$self configure_quality $fmt
}
ControlMenu instproc configure_quality fmt {
	global videoFormat 
	$self instvar qval_ qscale_ qlabel_ lastFmt_
	set qval_($lastFmt_) [$qscale_ get]
	set lastFmt_ $videoFormat
	if [info exists qval_($fmt)] {
		$qscale_ set $qval_($fmt)
	}
	$self instvar vpipe_ device_
	$vpipe_ select $device_ $fmt
	if { ([info exists qval_($fmt)]) && \
		([$vpipe_ set_quality $qval_($fmt)] >= 0) } {
		$qscale_ configure -state normal -command "$self setq"
	        set fg [$self get_option foreground]
	} else {
	        set fg [$self get_option disabledForeground]
		$qscale_ configure -state disabled 
	}
	$qlabel_ configure -foreground $fg
}
ControlMenu instproc tx-init {} {
	$self instvar qscale_
	if { [lindex [$qscale_ configure -state] 4] == "normal" } {
		set cmd [lindex [$qscale_ configure -command] 4]
		eval $cmd [$qscale_ get]
	}
	$self instvar portButton_
	global inputPort inputType typeButton
	if { [$portButton_ cget -state] == "normal" } {
		$self set-port $inputPort
	}
	$self setFillRate
	update
}
ControlMenu instproc build.q w {
	set f [$self get_option smallfont]
	frame $w.tb
	label $w.title -text "Quality" -font $f -anchor w
	label $w.tb.value -text 0 -font $f -width 3
	scale $w.tb.scale -font $f -orient horizontal \
		-showvalue 0 -from 0 -to 99 \
		-width 12 -relief groove
	$self instvar qscale_ qvalue_ qlabel_
	set qscale_ $w.tb.scale
	set qvalue_ $w.tb.value
	set qlabel_ $w.title
	pack $w.tb.scale -side left -fill x -expand 1
	pack $w.tb.value -side left
	pack $w.title -padx 2 -side left
	pack $w.tb -fill x -padx 6 -side left -expand 1
}
ControlMenu instproc build.scuba w {
	set f [$self get_option smallfont]
	label $w.label -text SCUBA
	frame $w.frame -relief sunken -borderwidth 2
	pack $w.label -fill x
	pack $w.frame -fill both -expand 1
	set wf $w.frame
	frame $wf.title
	frame $wf.title.lglue 
	frame $wf.title.rglue 
	label $wf.title.l -text "Local Bandwidth: " -font $f
	label $wf.title.value -font $f -width 8 -anchor w
	pack $wf.title.lglue -expand 1 -fill x -side left
	pack $wf.title.l $wf.title.value -side left
	pack $wf.title.rglue -expand 1 -fill x -side right
	pack $wf.title -fill x -expand 1
	frame $wf.sessbw
	scale $wf.sessbw.scale -orient horizontal -font $f \
		-showvalue 0 -from 1000 -to [$self get_option maxVideoSessionBW] \
		-command "$self set_sessionbw $wf.title.value" -width 12 \
		-relief groove -resolution 1000
	pack $wf.sessbw -fill x -expand 1
	pack $wf.sessbw.scale -fill x -side left -expand 1
	$self instvar ui_
	set s [$ui_ set scuba_sess_]
	$wf.sessbw.scale set [$s set sessionbw_]
}
ControlMenu instproc build.xmit w {
	set f [$self get_option smallfont]
	label $w.label -text Transmission
	frame $w.frame -relief sunken -borderwidth 2
	pack $w.label -fill x
	pack $w.frame -fill both -expand 1
	frame $w.frame.buttons
	$self build.buttons $w.frame.buttons
	frame $w.frame.right
	$self build.sliders $w.frame.right
	pack $w.frame.buttons -side left -padx 6 
	pack $w.frame.right -side right -expand 1 -fill x -padx 10 -anchor c
}
ControlMenu instproc build.slicvideo { w } {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	label $w.title -text "Video Input"
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h -relief flat
	label $w.f.h.label  -font $f -anchor e -text "Hue"
	scale $w.f.h.scale -orient horizontal -width 12 -length 20 \
		           -relief groove -showvalue 0 -from -128 -to 127 \
                          -command "$vpipe_ hardware set HUE"
	pack  $w.f.h.label $w.f.h.scale -side left -fill x -expand 1
	frame $w.f.ll -relief flat 
	label $w.f.ll.label  -font $f -text "Luma" -anchor s
	label $w.f.ll.clabel -font $f -text "Contrast" -anchor s
	label $w.f.ll.blabel -font $f -text "Brightness" -anchor s
	pack  $w.f.ll.clabel $w.f.ll.label $w.f.ll.blabel \
			     -side left -fill x -expand 1
	frame $w.f.l  -relief flat
	scale $w.f.l.cscale   -orient horizontal -width 12 -relief groove \
                              -showvalue 0 -from 0 -to 127 \
                              -command "$vpipe_ hardware set LUMA_CONTRAST"
	scale $w.f.l.bscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 255 \
                            -command "$vpipe_ hardware set LUMA_BRIGHTNESS"
	pack  $w.f.l.cscale $w.f.l.bscale  -side left -fill x -expand 1
	frame $w.f.cl  -relief flat
	label $w.f.cl.label  -font $f -text "Chroma" -anchor n
	label $w.f.cl.glabel -font $f -text "Gain" -anchor n
	label $w.f.cl.slabel -font $f -text "Saturation" -anchor n
	pack  $w.f.cl.glabel $w.f.cl.label $w.f.cl.slabel \
			     -side left -fill x -expand 1
	frame $w.f.c -relief flat
	scale $w.f.c.gscale -orient horizontal -width 12 -relief groove \
                             -showvalue 0 -from 0 -to 255 \
                             -command "$vpipe_ hardware set CHROMA_GAIN"
	scale $w.f.c.sscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 127 \
                            -command "$vpipe_ hardware set CHROMA_SATURATION"
	pack  $w.f.c.gscale $w.f.c.sscale -side left -fill x -expand 1
	pack  $w.f.h $w.f.ll $w.f.l $w.f.c $w.f.cl \
	      -fill x -expand 1 -padx 1m 
	pack $w.title $w.f -fill x -expand 1
	$w.f.h.scale  set 0
	$w.f.l.cscale set 64
	$w.f.l.bscale set 128
	$w.f.c.gscale set 44
	$w.f.c.sscale set 64
}
ControlMenu instproc build.still { w } {
    set f [$self get_option smallfont]
    label $w.title -text "Video Input"
    frame $w.f -relief sunken -borderwidth 2
    label $w.f.label  -font $f -anchor e -text "File"
    mk.entry $w.f set.still.frame "frame"
    pack $w.title $w.f -fill x -expand 1
    pack $w.f.label -side left 
    pack $w.f.entry -side left -fill x -expand 1
}
ControlMenu instproc set.still.frame {w s } {
    global lastDevice
    $lastDevice file $s
}
ControlMenu instproc build.qcam { w } {
    $self instvar vpipe_
    global qcamwindow
    set f [$self get_option smallfont]
    label $w.title -text "Video Input"
    frame $w.f -relief sunken -borderwidth 2
    frame $w.f.s -relief flat
    frame $w.f.s.l -relief flat
    label $w.f.s.l.bright -font $f -anchor w -text "Brightness"
    label $w.f.s.l.cont   -font $f -anchor w -text "Contrast"
    label $w.f.s.l.wbal   -font $f -anchor w -text "White balance"
    pack  $w.f.s.l.bright $w.f.s.l.cont $w.f.s.l.wbal \
	-side top -fill x -expand 1
    frame $w.f.s.s -relief flat
    scale $w.f.s.s.bright -orient horizontal -width 12 \
		          -relief groove -showvalue 0 -from 1 -to 254 \
                          -command "$vpipe_ hardware set BRIGHT"
    scale $w.f.s.s.cont   -orient horizontal -width 12 \
                          -relief groove -showvalue 0 \
                          -from 0 -to 1.0 -resolution 0.002 \
                          -command "$vpipe_ hardware contrast"
    frame $w.f.s.s.wbal -relief flat
    scale $w.f.s.s.wbal.scale  -orient horizontal -width 12 \
                             -relief groove -showvalue 0 -from 1 -to 254 \
                             -command "$vpipe_ hardware set WBAL"
    button $w.f.s.s.wbal.button -font $f -text Auto \
	-command "$vpipe_ hardware set WBAL auto"
    pack  $w.f.s.s.wbal.scale $w.f.s.s.wbal.button \
	-side left -fill x -expand 1
    pack $w.f.s.s.bright $w.f.s.s.cont $w.f.s.s.wbal \
        -side top -fill x -expand 1
    pack $w.f.s.l $w.f.s.s -side left -fill x -expand 1
    frame $w.f.bpp -relief flat
    label $w.f.bpp.label  -font $f -anchor w -text "Pixel depth"
    radiobutton $w.f.bpp.bpp4 -font $f -text "4-bit" \
	-variable qcambpp -value 4 -command "$vpipe_ hardware set BPP 4"
    radiobutton $w.f.bpp.bpp6 -font $f -text "6-bit" \
	-variable qcambpp -value 6 -command "$vpipe_ hardware set BPP 6"
    pack $w.f.bpp.label $w.f.bpp.bpp4 $w.f.bpp.bpp6 \
	-side left -fill x -expand 1
    pack  $w.f.s $w.f.bpp \
	 -fill x -expand 1 -padx 1m 
    pack $w.title $w.f -fill x -expand 1
    set qcamwindow(setbright) "$w.f.s.s.bright set"
    set qcamwindow(setcont) "$w.f.s.s.cont set"
    set qcamwindow(setwbal) "$w.f.s.s.wbal.scale set"
    set qcamwindow(setbpp) "set qcambpp"
}
ControlMenu instproc build.brooktree848 { w } {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	label $w.title -text "Video Input"
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h -relief flat
	label $w.f.h.label  -font $f -anchor e -text "Hue"
	scale $w.f.h.scale -orient horizontal -width 12 -length 20 \
		           -relief groove -showvalue 0 -from -128 -to 127 \
                          -command "$vpipe_ hardware set HUE"
	pack  $w.f.h.label $w.f.h.scale -side left -fill x -expand 1
	frame $w.f.ll -relief flat 
	label $w.f.ll.label  -font $f -text "Luma" -anchor s
	label $w.f.ll.clabel -font $f -text "Contrast" -anchor s
	label $w.f.ll.blabel -font $f -text "Brightness" -anchor s
	pack  $w.f.ll.clabel $w.f.ll.label $w.f.ll.blabel \
			     -side left -fill x -expand 1
	frame $w.f.l  -relief flat
	scale $w.f.l.cscale   -orient horizontal -width 12 -relief groove \
                              -showvalue 0 -from 0 -to 127 \
                              -command "$vpipe_ hardware set contrast"
	scale $w.f.l.bscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 255 \
                            -command "$vpipe_ hardware brightness"
	pack  $w.f.l.cscale $w.f.l.bscale  -side left -fill x -expand 1
	frame $w.f.cl  -relief flat
	label $w.f.cl.label  -font $f -text "Chroma" -anchor n
	label $w.f.cl.glabel -font $f -text "Gain" -anchor n
	label $w.f.cl.slabel -font $f -text "Saturation" -anchor n
	pack  $w.f.cl.glabel $w.f.cl.label $w.f.cl.slabel \
			     -side left -fill x -expand 1
	frame $w.f.c -relief flat
	scale $w.f.c.gscale -orient horizontal -width 12 -relief groove \
                             -showvalue 0 -from 0 -to 255 \
                             -command "$vpipe_ hardware set CHROMA_GAIN"
	scale $w.f.c.sscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 127 \
                            -command "$vpipe_ hardware set CHROMA_SATURATION"
	pack  $w.f.c.gscale $w.f.c.sscale -side left -fill x -expand 1
	checkbutton $w.f.b -text PAL -variable signalFormat -onvalue pal \
		-offvalue ntsc -command \
		"$vpipe_ hardware format \$signalFormat"
	pack  $w.f.h $w.f.ll $w.f.l $w.f.c $w.f.cl $w.f.b \
	      -fill x -expand 1 -padx 1m 
	pack $w.title $w.f -fill x -expand 1
	$w.f.h.scale  set 0
	$w.f.l.cscale set 64
	$w.f.l.bscale set 128
	$w.f.c.gscale set 44
	$w.f.c.sscale set 64
}
ControlMenu instproc build.brooktree848 w {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.h -relief flat
	label $w.f.h.label  -font $f -text "Hue" -width 12
	scale $w.f.h.hscale -orient horizontal \
		           -relief groove -showvalue 0 -from -128 -to 127 \
                          -command "$vpipe_ hardware hue"
	pack $w.f.h.label -side left 
	pack $w.f.h.hscale -side left -fill x -expand 1
	frame $w.f.l -relief flat
	frame $w.f.l.l
	label $w.f.l.l.clabel -font $f -text "Contrast" -width 12
	scale $w.f.l.l.cscale -orient horizontal -relief groove -width 12 \
                              -showvalue 0 -from 0 -to 127 \
                              -command "$vpipe_ hardware contrast"
	pack  $w.f.l.l.clabel -side left
	pack  $w.f.l.l.cscale -side left -fill x -expand 1
	frame $w.f.l.r
	label $w.f.l.r.blabel -font $f -text "Brightness" -width 12
	scale $w.f.l.r.bscale -orient horizontal -relief groove -width 12 \
                            -showvalue 0 -from -128 -to 127 \
                            -command "$vpipe_ hardware brightness"
	pack  $w.f.l.r.blabel -side left
	pack  $w.f.l.r.bscale -side left -fill x -expand 1
	pack  $w.f.l.l $w.f.l.r  -side top -fill x -expand 1
	frame $w.f.cl  -relief flat
	frame $w.f.cl.l
	label $w.f.cl.l.glabel -font $f -text "Chroma Gain" -width 12
	scale $w.f.cl.l.gscale -orient horizontal -relief groove -width 12 \
                             -showvalue 0 -from 0 -to 255 \
                             -command "$vpipe_ hardware uvgain"
	pack  $w.f.cl.l.glabel -side left
	pack  $w.f.cl.l.gscale -side left -fill x -expand 1
	frame $w.f.cl.r
	label $w.f.cl.r.slabel -font $f -text "Saturation" -width 12
	scale $w.f.cl.r.sscale -orient horizontal -relief groove -width 12 \
                            -showvalue 0 -from 0 -to 127 \
                            -command "$vpipe_ hardware saturation"
	pack  $w.f.cl.r.slabel -side left
	pack  $w.f.cl.r.sscale -side left -fill x -expand 1
	pack  $w.f.cl.r $w.f.cl.l  -side top -fill x -expand 1
	checkbutton $w.f.b -text PAL -variable signalFormat -onvalue pal \
		-offvalue ntsc -command \
		"$vpipe_ hardware format \$signalFormat"
	pack $w.f.l $w.f.h $w.f.cl $w.f.b -side top -fill both -expand 1
	pack $w.f -fill both -expand 1
		$w.f.h.hscale set 0
		$w.f.l.l.cscale set 64
		$w.f.l.r.bscale set 0
		$w.f.cl.l.gscale set 44
		$w.f.cl.r.sscale set 64
}
Class Switcher -configuration {
	switchInterval 5 
}
Switcher instproc init src {
	$self next
	$self instvar src_ switch_list_
	set src_ $src
	Switcher set all_($self) 1
}
Switcher instproc destroy {} {
	$self cancel_timer
	Switcher unset all_($self)
}
Switcher instproc enable {} {
	$self touch
}
Switcher instproc enabled {} {
	$self instvar ts_
	return [info exists ts_]
}
Switcher instproc disable {} {
	$self instvar ts_
 	unset ts_
}
Switcher public set_timer {} {
	$self sched
}
Switcher instproc cancel_timer {} {
	$self instvar timer_id_
	if [info exists timer_id_] {
		after cancel $timer_id_
		unset timer_id_
	}
}
Switcher instproc switch_to src {
	$self instvar src_ switch_list_
	if { $src != $src_  && [lsearch $switch_list_ $src] != -1 } {
		$self switch $src
		set src_ $src
	}
}
Switcher instproc forward {} {
	$self instvar src_
	$self switch_to [$self next_active_src $src_]
}
Switcher instproc reverse {} {
	$self instvar src_
	$self switch_to [$self prev_active_src $src_]
}
Switcher set clock_ 1
Switcher instproc touch {} {
	Switcher instvar clock_
	$self instvar ts_
	set ts_ $clock_
	incr clock_
}
Switcher proc focus src {
	Switcher instvar ignore_
	if [info exists ignore_($src)] {
		return
	}
	Switcher instvar all_ speaker_
	set speaker_ $src
	foreach o [array names all_] {
		if { [$o enabled] && 
	             [lsearch [$o set switch_list_] $src] != -1 } {
			 $o switch_to $src
		}
	}
}
Switcher private sched {} {
	$self instvar timer_id_
	set ms [expr 1000 * [$self get_option switchInterval]]
	set timer_id_ [after $ms "$self timeout"]
}
Switcher private timeout {} {
	$self instvar timer_id_
	if [info exists timer_id_] {
		$self forward
		$self sched
	}
}
Switcher proc rebuild_switch_list_menu { } {
        Switcher instvar all_
        foreach o [array names all_] {
	        $o rebuild_switch_list_menu
	}
}
Class CuesReceiver 
CuesReceiver proc set_cb { cb } {
	CuesReceiver set glob_chan_ $cb
        $cb register AWARE_ear "$self recv"
        $cb register AWARE_hand "$self recv"
	$cb register AWARE_yes "$self recv"
	$cb register AWARE_no "$self recv"
        $cb register UNAWARE_ear "$self recv"
        $cb register UNAWARE_hand "$self recv"
	$cb register UNAWARE_yes "$self recv"
	$cb register UNAWARE_no "$self recv"
}
CuesReceiver proc recv { list msg } {
	array set info $list
        set event [split $info(event) "_"]
        set cue [lindex $event 1]
	switch -- [lindex $event 0] {
		AWARE { set fn start_blink }
		UNAWARE { set fn stop_blink }
	}
        CuesReceiver instvar all_
        if [info exists all_] {
		foreach cr $all_ {
			$cr $fn $cue $msg
		}
	}
}
CuesReceiver instproc init { path size } {
	$self instvar cname_ size_ cues_
	set cname_ 0
	set size_ $size
	set cues_ "hand ear yes no"
	CuesReceiver instvar all_
	lappend all_ $self
	$self instvar top_ colors_
        set top_ $path
	foreach c $cues_ {
		$self set ${c}_l [label ${top_}.${c} \
				  -bitmap ${size_}_${c}]
		pack ${top_}.${c} -side left -padx 10
	}
        set colors_(1) red
        set colors_(0) gray
}
CuesReceiver instproc destroy { } {
	CuesReceiver instvar all_
        set i [lsearch $all_ $self]
        set all_ [lreplace $all_ $i $i]
	$self instvar cues_ cnames_
	foreach cue $cues_ {
		foreach cname $cnames_ {
			$self stop_blink $cue $cname
		}
	}
	$self next
}
CuesReceiver instproc enable { cname } {
	$self set cname_ $cname
	$self refresh
}
CuesReceiver instproc refresh { } {
	$self instvar top_ cues_ colors_
	foreach c $cues_ {
		${top_}.${c} conf -background $colors_(0)
	}
}
CuesReceiver instproc start_blink { cue cname } {
	$self instvar ${cname}_info_ accum_ cnames_
	if [info exists ${cname}_info_($cue)] {
 	        return
        }
        set ${cname}_info_($cue) 1
	set ${cname}_info_(${cue}_accum) 0
	set ${cname}_info_(${cue}_after) 0
	set ${cname}_info_(${cue}_color) 0
	if { ![info exists cnames_] || [lsearch cnames_ $cname] == -1 } {
		lappend cnames_ $cname
        }
        $self blinklite 100 $cue $cname
}
CuesReceiver instproc stop_blink { cue cname } {
        $self instvar top_ colors_ ${cname}_info_
        if { [info exists ${cname}_info_($cue)] } {
	        unset ${cname}_info_($cue)
		set w ${top_}.${cue} 
		if [winfo exists $w] {
			$w conf -background $colors_(0)
		}
	}
	if { [info exists ${cname}_info_(${cue}_after)] } {
		after cancel [set ${cname}_info_(${cue}_after)]
	}
}
CuesReceiver instproc blinklite { interval cue cname } {
        $self instvar ${cname}_info_ colors_ cname_ top_
        if ![info exists ${cname}_info_($cue)] {
		return 
	}
	if { [set ${cname}_info_(${cue}_accum)] >= 30000 } {
	        $self stop_blink $cue $cname
	        return
	}
        set ${cname}_info_(${cue}_color) \
		[expr {([set ${cname}_info_(${cue}_color)] + 1) % 2}]
	set ${cname}_info_(${cue}_accum) \
		[expr [set ${cname}_info_(${cue}_accum)] + $interval]
        if { "$cname_" == "$cname" } {
		${top_}.${cue} conf \
			-background $colors_([set ${cname}_info_(${cue}_color)])
	}
        set ${cname}_info_(${cue}_after) \
		[after $interval \
		 "$self blinklite [expr int($interval * 1.05)] $cue $cname"]
}
Class UserWindow -superclass Switcher -configuration {
	suppressUserName true
}
VideoWindow instproc adjust-voff d {
	set ow [$self width]
	set oh [$self height]
	set iw [$d width]
	set ih [$d height]
	$self voff 0
	if { $ow == 320 && $oh == 240 } {
		if { $iw == 352 && $ih == 288 } {
			$self voff 8
		} elseif { $iw == 176 && $ih == 144 } {
		}
	} elseif { $ow == 640 && $oh == 480 } {
		if { $iw == 352 && $ih == 288 } {
			$self voff 16
		}
	}
}
UserWindow instproc resize { w h } {
	$self instvar vw_
	$self instvar as_
	$as_ detach-window $self
	[$vw_ window] resize $w $h
	update idletasks
	$as_ attach-window $self
}
proc viewing_window w {
	if { [string range $w 0 2] == ".vw"} {
		return 1
	} else {
		return 0
	}
}
UserWindow instproc init { asm as usecues cb {w {}} } {
	$self next $as
	$self instvar asm_ usecues_
	$self tkvar switched_ timed_ slow_ hw_
	set asm_ $asm
	set usecues_ $usecues
	set switched_ 0
	set timed_ 0
	set slow_ 0
	set hw_ 0
	if { $cb != "" } {
		$self create-window $w $as 1
	} else {
		$self create-window $w $as 0
	}
}
UserWindow instproc destroy {} {
	$self instvar as_ path_ vw_
	set w $path_.frame.video
	$as_ detach-window $self
	$vw_ destroy
	set x [winfo rootx $w]
	set y [winfo rooty $w]
	incr x [winfo vrootx $w]
	incr y [winfo vrooty $w]
	set top [winfo toplevel $w]
	global userwin_x userwin_y userwin_size size$top
	set userwin_x($as_) $x
	set userwin_y($as_) $y
	set userwin_size($as_) [set size$top]
	destroy $top
	$self instvar cr_
	if [info exists cr_] {
		delete $cr_
	}
	$self next
}
UserWindow instproc is-switched {} {
	$self tkvar switched_
	return $switched_
}
UserWindow instproc reallocate_renderer w {
	$self instvar as_
	$as_ detach-window $self
	$as_ attach-window $self
}
Class VideoWidget -superclass TkWindow -configuration {
	stampInterval 1000 
}
VideoWidget instproc init { w width height } {
	$self next $w
	$self instvar window_ is_slow_ 
	set window_ [new VideoWindow $w $width $height]
	set is_slow_ 0
}
VideoWidget instproc window {} {
	return [$self set window_]
}
VideoWidget instproc is-slow {} {
	return [$self set is_slow_]
}
VideoWidget instproc redraw {} {
	[$self set window_] redraw
}
foreach type { TrueColor/24 TrueColor/16 PseudoColor/8/Dither
		PseudoColor/8/ED PseudoColor/8/Gray PseudoColor/8/Quant } {
	set body "return \[new Renderer/$type \$self \$win \$dec]"
	Colormodel/$type instproc alloc-renderer { win dec } $body
	Renderer/$type set nb 0
}
VideoWidget instproc attach-decoder { src colorModel useHW } {
	set d [$src handler]
        if {$d==""} {
	    global src_nickname
	    puts stderr "can't attach-decoder: no handler for src $src_nickname($src); format is [$src format_name]"
	    return
	}
	$self instvar window_ target_ is_slow_
	set target_ ""
	if { $useHW } {
		set fmt [$src format_name]
		if { $fmt == "jpeg" } {
			set fmt $fmt/[$d decimation]
		}
		if ![catch "new assistor/$fmt" v] {
			set target_ $v
			$target_ window $window_
		}
	}
	if { $target_ == "" } {
		set target_ [$colorModel alloc-renderer $window_ [$d decimation]]
	}
	if $is_slow_ {
		$target_ update-interval [$self get_option stampInterval]
	}
	$window_ adjust-voff $d
	$d attach $target_
}
VideoWidget instproc set_slow {} {
	$self instvar is_slow_ target_
	set is_slow_ 1
	if { [info exists target_] } {
		$target_ update-interval [$self get_option stampInterval]
	}
}
VideoWidget instproc set_normal {} {
	$self instvar is_slow_ target_
	set is_slow_ 0
	if { [info exists target_] } {
		$target_ update-interval 0
	}
}
VideoWidget instproc destroy {} {
	$self instvar target_
	if [info exists target_] {
		delete $target_
		$self next
	}
}
VideoWidget instproc detach-decoder src {
	$self instvar target_
	set d [$src handler]
	$d detach $target_
	delete $target_
	unset target_
}
UserWindow instproc create-window { w as useCB } {
	set f [$self get_option smallfont]	
	set uid [uniqueID]
	$self instvar asm_ usecues_
	if { $w=={} } {
		set w .vw$uid
		Application toplevel $w
	} else {
		frame $w
	}
	catch "wm resizable $w false false"
	frame $w.frame
	$self instvar vw_ as_ path_ controlMenu_
	set as_ $as
	set path_ $w
	global size$w userwin_x userwin_y userwin_size
	if [info exists userwin_x($as)] {
		if { [winfo toplevel $w]==$w } {
			wm geometry $w +$userwin_x($as)+$userwin_y($as)
			wm positionfrom $w user
		}
		set size$w $userwin_size($as)
		set d [split $userwin_size($as) x]
		set vw_ [new VideoWidget $w.frame.video \
			 [lindex $d 0] [lindex $d 1] ]
	} elseif [$as isCIF] {
		set vw_ [new VideoWidget $w.frame.video 352 288 ]
		set size$w 352x288
	} else {
		set vw_ [new VideoWidget $w.frame.video 320 240 ]
		set size$w 320x240
	}
	frame $w.bar
	button $w.bar.dismiss -text Dismiss -font $f -width 8 \
		-highlightthickness 0 -command "$self destroy"
	set m $w.bar.mode.menu
	menubutton $w.bar.mode -text Modes... -menu $m -relief raised \
		-width 8 -font $f
	menu $m
	$m add checkbutton -label Voice-switched \
		-command "$self set_switched" \
		-font $f -variable [$self tkvarname switched_]
	$m add checkbutton -label Timer-switched \
		-command "$self set_timed" \
		-font $f -variable [$self tkvarname timed_]
	$m add checkbutton -label Save-CPU \
		-command "$self set_slow" \
		-font $f -variable [$self tkvarname slow_]
	$m add checkbutton -label Use-Hardware \
		-command "$self reallocate_renderer $w.frame.video" \
		-font $f -variable [$self tkvarname hw_]
	$m add cascade -label "Switch options..." -menu $m.opt \
                -font $f
	menu $m.opt -tearoff no
        $self instvar switch_list_
        global src_nickname ${self}_switchname
        foreach s [$asm_ active-sources] {
		set ${self}_switchname($s) 1
		lappend switch_list_ $s
                $m.opt add checkbutton -label $src_nickname($s) \
                        -command "$self set_switch_list $s" \
                        -font $f -variable ${self}_switchname($s)
        }
	if !$useCB {
		$m entryconfigure Voice-switched -state disabled
	}
	set m $w.bar.size.menu
	menubutton $w.bar.size -text Size... -menu $m -relief raised -width 8 \
		-font $f
	menu $m
	$m add radiobutton -label QCIF -command "$self resize 176 144" \
		-font $f -value 176x144 -variable size$w
	$m add radiobutton -label CIF -command "$self resize 352 288" \
		-font $f -value 352x288 -variable size$w
	$m add radiobutton -label SCIF -command "$self resize 704 576" \
		-font $f -value 704x576 -variable size$w
	$m add separator
	$m add radiobutton -label "1/16 NTSC" \
		-command "$self resize 160 120" \
		-font $f -value 160x120 -variable size$w
	$m add radiobutton -label "1/4 NTSC" \
		-command "$self resize 320 240" \
		-font $f -value 320x240 -variable size$w
	$m add radiobutton -label NTSC \
		-command "$self resize 640 480" \
		-font $f -value 640x480 -variable size$w
	$m add separator
	$m add radiobutton -label "1/16 PAL" \
		-command "$self resize 192 144" \
		-font $f -value 192x144 -variable size$w
	$m add radiobutton -label "1/4 PAL" \
		-command "$self resize 384 288" \
		-font $f -value 384x288 -variable size$w
	$m add radiobutton -label PAL \
		-command "$self resize 768 576" \
		-font $f -value 768x576 -variable size$w
	label $w.bar.label -text "" -anchor w -relief raised
	pack $w.bar.label -expand 1 -side left -fill both
	pack $w.bar.size $w.bar.mode $w.bar.dismiss -side left -fill y
	pack $w.frame.video -anchor c
	pack $w.frame -expand 1 -fill both
	if $usecues_ {
		frame $w.cues -relief ridge -borderwidth 2
		label $w.cues.l -font $f -text "Cues:"
		pack $w.cues.l -side left -padx 10
		$self instvar cr_
		set cr_ [new CuesReceiver $w.cues lg]
		$cr_ enable [[$as_ set src_] sdes cname]
		pack $w.cues -fill x
	}
	pack $w.bar -fill x
	bind $w <Enter> { focus %W }
	bind $w <d> "$self destroy"
	bind $w <q> "$self destroy"
	$w.bar.dismiss configure -command "$self destroy"
	bind $w <Return> "$self forward"
	bind $w <space> "$self forward"
	bind $w <greater> "$self forward"
	bind $w <less> "$self reverse"
	bind $w <comma> "$self reverse"
	$as attach-window $self
}
UserWindow instproc set_switch_list s {
        $self instvar switch_list_
        global ${self}_switchname
        if [set ${self}_switchname($s)] {
	        lappend switch_list_ $s
	} else {
	        set i [lsearch $switch_list_ $s] 
	        set switch_list_ [lreplace $switch_list_ $i $i]
	}
}
UserWindow instproc rebuild_switch_list_menu { } {
        $self instvar path_ asm_ switch_list_
	set m $path_.bar.mode.menu
        destroy $m.opt
        menu $m.opt -tearoff no
	set new_all_list [$asm_ active-sources]
	global src_nickname ${self}_switchname
	foreach s $new_all_list {
	        if { [lsearch $switch_list_ $s] != -1 } {
		    set ${self}_switchname($s) 1 
		    lappend new_switch_list $s
		} else {
		    set ${self}_switchname($s) 0
		}
	        $m.opt add checkbutton -label $src_nickname($s) \
			-command "$self set_switch_list $s" \
			-font [$self get_option smallfont] \
			-variable ${self}_switchname($s)
	}
	set switch_list_ $new_switch_list
}
UserWindow instproc video-widget {} {
	return [$self set vw_]
}
UserWindow instproc attached-source {} {
	return [$self set as_]
}
UserWindow instproc set-name name {
	$self instvar path_
	set w $path_
	if ![$self yesno suppressUserName] {
		$w.bar.label configure -text $name
	}
	if { [winfo toplevel $w]==$w } {
		wm iconname $w vic:$name
		wm title $w $name
	}
}
UserWindow instproc switch src {
	$self instvar as_ asm_ usecues_ 
	set as [$asm_ set active_($src)]
	if { $as_ != $as } {
		if $usecues_ {
			$self instvar cr_
			$cr_ enable [$src sdes cname]
		}
		$as_ detach-window $self
		set as_ $as
		$as_ attach-window $self
	}
}
UserWindow instproc next_active_src src {
        $self instvar switch_list_ last_src_
	if { [$self enabled] && [info exists last_src_] } {
	        set src $last_src_
	} 
        set i [lsearch $switch_list_ $src]
        incr i
        if { $i >= [llength $switch_list_] } {
	        set i 0
	}
	set next_src [lindex $switch_list_ $i]
	set last_src_ $next_src
        return $next_src
}
UserWindow instproc prev_active_src src {
	$self instvar asm_
	set list [$asm_ active-sources]
	set k [lsearch -exact $list $src]
	if { $k < 0 } {
		set k 0
	} else {
		if { $k == 0 } {
			set k [llength $list]
		}
		incr k -1
	}
	return [lindex $list $k]
}
UserWindow instproc set_switched {} {
	$self tkvar switched_
	if $switched_ {
		$self enable
	} else {
		$self disable
	}
}
UserWindow instproc set_timed {} {
	$self tkvar timed_
	if $timed_ {
		$self set_timer
	} else {
		$self cancel_timer
	}
}
UserWindow instproc set_slow {} {
	$self tkvar slow_
	$self instvar vw_
	if $slow_ {
		$vw_ set_slow
	} else {
		$vw_ set_normal
	}
}
proc isWidgetObject { cl } {
	if { [$cl info heritage WidgetObject] != {} || $cl=="WidgetObject" } {
		return 1
	} else {
		return 0
	}
}
Class WidgetClass -superclass Class
WidgetClass proc unknown { cl args } {
	set private_options(-configspec) ""
	set private_options(-default) ""
	set private_options(-alias) ""
	set len [llength $args]
	for { set idx 0 } { $idx < $len } { incr idx 2 } {
		if { [info exists private_options([lindex $args $idx])] } {
			set private_options([lindex $args $idx]) \
					[lindex $args [expr $idx+1]]
			set args [lreplace $args $idx [expr $idx+1]]
			incr idx -2
		}
	}
	set idx [lsearch $args "-superclass"]
	if { $idx!=-1 } {
		incr idx
		if { [llength $args] <= $idx } {
			error "missing argument for option '-superclass'"
		}
		set superclasses [lindex $args $idx]
		set need_WidgetObject 1
		foreach superclass $superclasses {
			if { [$superclass info heritage WidgetObject]!="" } {
				set need_WidgetObject 0
				break
			}
		}
		if { $need_WidgetObject && $cl!="WidgetObject"} {
			lappend superclasses WidgetObject
			set args [lreplace $args $idx $idx $superclasses]
		}
	} else {
		if { $cl!="WidgetObject" } {
			lappend args -superclass WidgetObject
		}
	}
	eval [list $self] next [list $cl] $args
	$cl heritage_defaults
	foreach option [array names private_options] {
		set arg $private_options($option)
		$cl set_[string range $option 1 end] $arg
	}
}
WidgetClass proc set_widget_default { } {
	set count 0
	while [winfo exists .dummy_${count}__] { incr count }
	set dummy .dummy_${count}__
	button $dummy
	$self set_widget_default_ $dummy { -background -foreground \
			-activebackground -activeforeground -borderwidth \
			-cursor -disabledforeground -highlightbackground\
			-highlightcolor -highlightthickness -takefocus \
			{-boldfont -font} }
	destroy $dummy
	entry $dummy
	$self set_widget_default_ $dummy { -font -selectbackground \
			-selectforeground -selectborderwidth }
	destroy $dummy
}
WidgetClass proc set_widget_default_ { path options } {
	$self instvar widget_defaults_
	foreach option $options {
		if { [llength $option]==1 } {
			set option [lindex $option 0]
			set widget_defaults_($option) [$path cget $option]
		} else {
			set widget_defaults_([lindex $option 0]) \
					[$path cget [lindex $option 1]]
		}
	}
}
WidgetClass proc widget_default { option } {
	$self instvar widget_defaults_
	if { [info exists widget_defaults_($option) ] } {
		return $widget_defaults_($option)
	} else {
		error "no such default option \"$option\""
	}
}
WidgetClass proc translate_default { option value } {
	if { ![string compare $value "WidgetDefault"] } {
		return [WidgetClass widget_default $option]
	} elseif { [regexp {WidgetDefault\((.*)\)} $value dummy \
			defaultOption] } {
		return [WidgetClass widget_default $defaultOption]
	}
	return $value
}
WidgetClass set_widget_default
WidgetClass instproc heritage_defaults { } {
	set heritage [$self info heritage]
	set len [expr [llength $heritage]-1]
	while { $len >= 0 } {
		set cl [lindex $heritage $len]
		incr len -1
		if { [isWidgetObject $cl] } {
			$self configspec_ [$cl info configspec] 1
			$self default_ [$cl info default]
		}
	}
}
WidgetClass instproc set_configspec { specs } {
	$self configspec_ $specs 0
}
WidgetClass instproc configspec_ { specs {isAncestor} } {
	$self instvar configspec_
	foreach spec $specs {
		if { ! $isAncestor } {
			set option  [lindex $spec 0]
			set default [lindex $spec 3]
			set spec [lreplace $spec 3 3 [WidgetClass \
					translate_default $option $default]]
			set configspec_($option) $spec
		}
		option add *$self.[lindex $spec 1] \
				[lindex $spec 3] widgetDefault
	}
}
WidgetClass instproc set_alias { aliases } {
	$self instvar configspec_
	foreach alias $aliases {
		set al   [lindex $alias 0]
		set orig [lindex $alias 1]
		if { ![info exists configspec_($orig)] } {
			error "no configspec $orig (specified in alias list)"
		}
		set configspec_($al) $configspec_($orig)
	}
}
WidgetClass instproc set_default { defaults } {
	$self default_ $defaults
	$self set defaults_ $defaults
}
WidgetClass instproc default_ { defaults } {
	foreach default $defaults {
		set option [lindex $default 0]
		set star [string last "*" $option]
		set dot  [string last "." $option]
		if { $star < $dot } {
			set idx [expr $dot+1]
		} else {
			set idx [expr $star+1]
		}
		option add *${self}$option [WidgetClass translate_default \
				-[string tolower [string range $option $idx \
				end]] [lindex $default 1]] widgetDefault
	}
}
WidgetClass instproc create { widget args } {
	eval [list $self] next [list _o$widget] [list $widget] $args
	return $widget
}
WidgetClass instproc info { option args } {
	if { $option == "default" } {
		if { $args != "" } {
			error "extra arguments in call to 'info $option'"
		}
		return [$self set defaults_]
	} elseif { $option == "configspec" } {
		$self instvar configspec_
		set len [llength $args]
		if { $len == 0 } {
			set list {}
			foreach el [array names configspec_] {
				lappend list $configspec_($el)
			}
			return $list
		}
		if { [llength $args] != 1 } {
			error "extra arguments in call to 'info $option'"
		}
		if { [info exists configspec_($args)] } {
			return $configspec_($args)
		} else {
			return ""
		}
		return [eval [list $self] next [list $option] $args]
	} else {
		return [eval [list $self] next [list $option] $args]
	}
}
WidgetClass WidgetObject -configspec {
	{-options options Options {} widget_options widget_options}
}
WidgetObject instproc init { widget args } {
	$self next
	$self instvar path_ widget_proc_
	set path_ $widget
	$self create_root_widget $widget
	if { ![winfo exists $widget] } {
		error "must create a widget $widget inside\
				[$self info class]::create_root_widget"
	}
	$self instvar widget_proc_
	set widget_proc_ "proc_$self"
	rename $widget $widget_proc_
	proc ::$widget { args } "return \[uplevel [list $self] \$args\]"
	$self build_widget $widget
	set heritage [[$self info class] info heritage]
	set idx 0
	for { set idx [expr [llength $heritage]-1] } {$idx>=0} {incr idx -1} {
		set cl [lindex $heritage $idx]
		if { [isWidgetObject $cl] } {
			$self configure_default $cl
		}
	}
	$self configure_default [$self info class]
	if { $args!="" } {
		eval [list $self] configure $args
	}
	if { [winfo toplevel $path_]==$path_ } {
		bind $widget <Destroy> "if \{\"%W\"==\"$path_\"\} \
				\{delete $self\}"
	} else {
		bind $widget <Destroy> "delete $self"
	}
}
WidgetObject instproc create_root_widget { path } {
	frame $path -class [$self info class]
}
WidgetObject instproc build_widget { path } {
}
WidgetObject instproc info { option args } {
	switch $option {
		"path" {
			if { $args != "" } {
				error "extra arguments in call to 'info $option'"
			}
			return [$self set path_]
		}
		"self" { return $self }
		default {
			return [eval [list $self] next [list $option] $args]
		}
	}
}
WidgetObject instproc unknown { method args } {
	return [eval [list $self] widget_proc [list $method] $args]
}
WidgetObject instproc widget_proc { args } {
	$self instvar widget_proc_
	return [eval [list $widget_proc_] $args]
}
WidgetObject instproc config { args } {
	return [eval [list $self] configure $args]
}
WidgetObject instproc configure_default { cl } {
	set path [$self info path]
	set widget_class [winfo class $path]
	if { $widget_class == [$self info class] } {
		foreach spec [$cl info configspec] {
			set optVal [option get $path [lindex $spec 1] $cl]
			$self configure [lindex $spec 0] $optVal
		}
	} else {
		foreach spec [$cl info configspec] {
			$self configure [lindex $spec 0] [lindex $spec 3]
		}
	}
}
WidgetObject instproc configure { args } {
	set len [llength $args]
	switch $len {
		0 { return [$self configure_all] }
		1 { return [$self configure_one $args] }
		default {
			if { $len % 2 != 0 } {
				error "odd number of arguments for configure"
			}
			for { set i 0 } { $i < $len } { incr i 2 } {
				$self configure_one [lindex $args $i] \
						[lindex $args [expr $i+1]]
			}
		}
	}
}
WidgetObject instproc configure_one { args } {
	set option [lindex $args 0]
	if { [string index $option 0] != "-" } {
		error "invalid option $option: must start with -"
	}
	set option [string range $option 1 end]
	set spec [[$self info class] info configspec -$option]
	if { $spec!="" } {
		set config_proc [lindex $spec 4]
		set cget_proc   [lindex $spec 5]
		if { $cget_proc=={} } { set cget_proc $config_proc }
		if { [llength $args] < 2 } {
			return [lreplace $spec 4 end [$self $cget_proc \
					"-$option"]]
		} else {
			return [$self $config_proc "-$option" [lindex $args 1]]
		}
	}
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set spec [$cl info configspec -$option]
			if { $spec!="" } {
				set config_proc [lindex $spec 4]
				set cget_proc   [lindex $spec 5]
				if { $cget_proc=={} } {
					set cget_proc $config_proc
				}
				if { [llength $args] < 2 } {
					return [lreplace $spec 4 end \
							[$self $cget_proc \
							"-$option"]]
				} else {
					return [$self $config_proc "-$option" \
							[lindex $args 1]]
				}
			}
		}
	}
	return [eval [list $self] widget_proc configure $args]
}
WidgetObject instproc configure_all { } {
	set result [$self configure_all_ [$self info class]]
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set result [concat $result [$self configure_all_ $cl]]
		}
	}
	set result [concat $result [$self widget_proc configure]]
	return $result
}
WidgetObject instproc configure_all_ { cl } {
	set result ""
	foreach spec [$cl info configspec] {
		set option [lindex $spec 0]
		if { $option != "-options" } {
			lappend result [$self configure $option]
		}
	}
	return $result
}
WidgetObject instproc cget { option } {
	return [lindex [$self configure_one $option] 4]
}
WidgetObject instproc widget_options { option args } {
	if { [llength $args]==0 } {
		error "options has no value; cannot read it"
	}
	set root [$self info path]
	foreach option [lindex $args 0] {
		set opt [string trim [lindex $option 0]]
		set arg [lindex $option 1]
		set lastdot [string last . $opt]
		if { $lastdot <= 0 } {
			set path $root
		} else {
			set firstdot  [string first . $opt]
			set path [string range $opt 0 [expr $firstdot-1]]
			set path [$self subwidget $path]
			if { $firstdot < $lastdot } {
				set path $path.[string range $opt \
						[expr $firstdot+1] \
						[expr $lastdot -1]]
			}
		}
		set opt [string range $opt [expr $lastdot+1] end]
		$path configure -$opt $arg
	}
}
WidgetObject instproc subwidget { widget args } {
	set path "[$self info path].$widget"
	if { ![winfo exists $path] } {
		$self instvar subwidgets_
		if { ![info exists subwidgets_($widget)] } {
			error "no subwidget $widget inside [$self info path]"
		}
		set path $subwidgets_($widget)
	}
	if { [llength $args]==0 } {
		return $path
	}
	return [eval [list $path] $args]
}
WidgetObject instproc set_subwidget { name path } {
	$self instvar subwidgets_
	$self set subwidgets_($name) $path
}
WidgetObject instproc ignore_args { args } {
}
WidgetObject instproc do_when_idle { command } {
	$self instvar do_idle_ids_
	set command [string trim $command]
	if ![info exists do_idle_ids_($command)] {
		set do_idle_ids_($command) \
				[after idle "WidgetObject do_idle_ \
				[list $self] [list $command]"]
	}
}
WidgetObject proc do_idle_ { o command } {
	$o instvar do_idle_ids_
	catch {unset do_idle_ids_($command)}
	if { [info command $o]!=$o } {
		return
	}
	set w [$o info path]
	if {![winfo exists $w] || [string compare [winfo class $w] \
			[$o info class]] != 0} {
		return
	} else {
		uplevel #0 $command
	}
}
WidgetClass proc transparent_gif { {color {}} } {
	global TRANSPARENT_GIF_COLOR
	if { $color!={} } {
		set TRANSPARENT_GIF_COLOR $color
	} else {
		set TRANSPARENT_GIF_COLOR [$self widget_default -background]
	}
}
WidgetClass proc EntryBindings { tag } {
	bind $tag <FocusIn>  "$self EntryBindings_FocusIn %W"
	bind $tag <FocusOut> "$self EntryBindings_FocusOut %W"
}
WidgetClass proc EntryBindings_FocusIn { entry } {
	if [string compare [$entry get] ""] {
		$entry selection from 0
		$entry selection to   end
		$entry icursor end
	} else {
		$entry selection clear
	}
}
WidgetClass proc EntryBindings_FocusOut { entry } {
    $entry selection clear
}
WidgetClass EntryBindings Entry
WidgetClass VideoBox -configspec {
	{ -attachSource attachSource AttachSource {} attach_source get_attribute }
	{ -size size Size medium set_size get_attribute }
	{ -updateSpeed updateSpeed UpdateSpeed normal set_speed get_attribute }
	{ -cb cb CB {} set_cb get_attribute }
	{ -switchMode switchMode SwitchMode voice&timer set_switchMode get_attribute }
	{ -switchTimer switchTimer SwitchTimer 15 set_switchTimer get_attribute }
	{ -switchSet switchSet SwitchSet {} define_switchSet get_attribute }
	{ -outputMeter outputMeter OutputMeter false set_outputMeter get_attribute }
	{ -cameraCtrls cameraCtrls CameraCtrls false set_cameraCtrls get_attribute }
	{ -border border Border true set_border get_attribute }
	{ -nametag nametag Nametag true set_nametag get_attribute }
	{ -ui ui UI {} set_ui get_attribute }
} -default {
} -alias {
	{ -src -attachSource }
}
VideoBox public get_default_attr { attributes } {
	$self instvar tkWidgetName_
	foreach attribute $attributes {
		regsub {\-} $attribute ""  attributename
		regsub {(.*)} $attributename &_ instvariable      
		$self instvar $instvariable
		set $instvariable [option get $tkWidgetName_ $attributename [$self info class]]
	}
}
VideoBox private build_widget { tkWidgetName } {
	$self instvar tkWidgetName_
	set tkWidgetName_ $tkWidgetName
	$self get_default_attr { -border -as -size -nametag }
	$self set_dimensions
	$self instvar vw_ vbox_ width_ height_ vwPath_
	set vbox_ [frame $tkWidgetName.vbox -relief ridge -borderwidth 5]
	set vwPath_ $vbox_.vw
	set vw_ [new VideoWidget $vwPath_ $width_ $height_]
	pack $vbox_.vw -anchor c		
	pack $vbox_ -fill none -expand 0
	$self set_label_text "Waiting for a source to fill this VideoBox"
	$self instvar isEmpty_ 
	set isEmpty_ 1
	$self unset_manager_switched
}
VideoBox public set_manager_switched { } {
	$self instvar isManagerSwitched_
	set isManagerSwitched_ 1
}
VideoBox public unset_manager_switched { } {
	$self instvar isManagerSwitched_
	set isManagerSwitched_ 0
}
VideoBox public is_manager_switched { } {
	$self instvar isManagerSwitched_
	return $isManagerSwitched_ 
}
VideoBox public get_video_widget {} {
	$self instvar vw_
	return [$self set vw_]
}
VideoBox public get_video_widget_path {} {
	return [$self set vwPath_]
}
VideoBox private set_attribute { option value } {
	regsub {\-} $option ""  optionname
	regsub {(.*)} $optionname &_ instvariable      
	$self instvar $instvariable
	set $instvariable $value
	puts "set_attribute: set $instvariable $value"
}
VideoBox public get_attribute { option } {
	regsub {\-} $option ""  optionname
	regsub {(.*)} $optionname &_ instvariable      
	$self instvar $instvariable
	set val [$self set $instvariable]
	puts "get_attribute $option        returns $val"
	return [$self set $instvariable]
}
VideoBox private attach_source { option src } {
	if { $src != {} } {
		$self switch $src
	}
}
VideoBox private set_size { option size } {
	$self instvar size_
	set size_ $size
	$self set_dimensions
	$self resize
}
VideoBox private set_dimensions {} {
	$self instvar size_ width_ height_ border_
	if { $border_ } { 
		switch -- $size_ {
			"thumbnail" {
				set width_ 80
				set height_ 60
			}
			"small" {
				set width_ 176
				set height_ 144
			}
			"medium" {
				set width_ 352
				set height_ 288
			}
			"large" {
				set width_ 704
				set height_ 576
			}
			default {
				set width_ 80
				set height_ 60
			}
			"thumbnail" {
				set width_ 80
				set height_ 60
			}
			"small" {
				set width_ 160
				set height_ 120
			}
			"medium" {
				set width_ 320
				set height_ 240
			}
			"large" {
				set width_ 640
				set height_ 480
			}
			default {
				set width_ 80
				set height_ 60
			}
		}
	} else {
		switch -- $size_ {
			"thumbnail" {
				set width_ 80
				set height_ 60
			}
			"small" {
				set width_ 160
				set height_ 120
			}
			"medium" {
				set width_ 320
				set height_ 240
			}
			"large" {
				set width_ 640
				set height_ 480
			}
			default {
				set width_ 80
				set height_ 60
			}
		}		
	}
}
VideoBox private resize { } {
	$self instvar width_ height_ vw_ as_
	if { $as_ != {} } {
		$as_ detach_videobox $self
	}
	[$vw_ window] resize $width_ $height_
	if { $as_ != {} } {
		update idletasks
		puts "RE-ATTACHING VB"
		$as_ attach_videobox $self
	}
	$self update_label
}
VideoBox private set_cb { option cb } {
	$self instvar cb_
	set cb_ $cb
}
VideoBox private set_switchMode { option mode } {
	$self instvar switchMode_
	set switchMode_ $mode
}
VideoBox private set_switchTimer { option timeout } {
	$self instvar switchTimer_
	set switchTimer_ $timeout
}
VideoBox private define_switchSet { option switchset } {
	$self instvar switchSet_
	set switchSet_ $switchset
}
VideoBox private set_outputMeter { option bool } {
	$self instvar outputMeter_
	set outputMeter_ $bool
}
VideoBox private set_cameraCtrls { option bool } {
	$self instvar cameraCtrls_
	set cameraCtrls_ $bool
}
VideoBox private set_speed { option speed } {
	$self instvar updateSpeed_ vw_
	set updateSpeed_ $speed
	if { $updateSpeed_ == "slow" } {
		$vw_ set_slow
	} else {
		$vw_ set_normal
	}
}
VideoBox private set_border { option bool } {
	$self instvar border_ size_
	set border_ $bool
	$self set_dimensions
	$self resize
}
VideoBox private set_ui { option ui } {
	$self instvar ui_
	set ui_ $ui
}
VideoBox private set_nametag { option bool } {
	$self instvar nametag_
	set nametag_ $bool
	$self update_label
}
VideoBox private set_label_text { label_text } {
	$self instvar vbox_ vbox_label_
	if { ![winfo exists $vbox_.label] } {
		set vbox_label_ [label $vbox_.label]
	}
	$vbox_label_ config -text $label_text
	$self update_label	
}
VideoBox private set_label_textvariable { label_textvariable } {
	$self instvar vbox_ vbox_label_
	if { ![winfo exists $vbox_.label] } {
		set vbox_label_ [label $vbox_.label]
	}
	$vbox_label_ config -textvariable $label_textvariable
	$self update_label	
}
VideoBox private update_label {} {
	$self instvar nametag_ vbox_ vbox_label_ vbox_label_frame_ width_
	if { ![winfo exists $vbox_.label] } {
		set vbox_label_ [label $vbox_.label]
	}
	if { ![winfo exists $vbox_.label_frame] } {
		set vbox_label_frame_ [frame $vbox_.label_frame]
	}
	$vbox_label_ config -font [$self get_option medfont] -pady 1 -borderwidth 0 -anchor w
	$vbox_label_frame_ config -width $width_ -height 15
	if { $nametag_ } {
		pack $vbox_label_ -anchor c -expand 0 -side top -fill none -in $vbox_label_frame_
		pack $vbox_label_frame_ -anchor c -expand 0 -side top -fill none 
		raise $vbox_label_
		pack propagate $vbox_label_frame_ 0
	} else {
		pack forget $vbox_label_
		pack forget $vbox_label_frame_
	}
}
VideoBox public highlight_border { } {
}
VideoBox public unhighlight_border { } {
}
VideoBox public highlight_nametag { } {
}
VideoBox public unhighlight_nametag { } {
}
VideoBox public start_border_blinking { } {
}
VideoBox public stop_border_blinking { } {
}
VideoBox public start_nametag_blinking { } {
}
VideoBox public stop_nametag_blinking { } {
}
VideoBox public switch { src } {
	$self instvar as_ ui_ src_ isEmpty_
	set src_ $src
	set as [[$ui_ set asm_] set active_($src)]
	if { $as_ != $as } {
		if { $as_ != {} } {
			$as_ detach_videobox $self
		}
		set as_ $as
		$as_ attach_videobox $self
		$self set_label_textvariable src_nickname($src_)
		set isEmpty_ 0
	}
	$self instvar sequenceStamp_
	set sequenceStamp_ [VideoBox incr_sequence_counter]
}
VideoBox proc incr_sequence_counter {} {
	$self instvar seqCounter_
	if {![info exist seqCounter_]} {
		set seqCounter_ 0
	} else {
		incr seqCounter_
	}
	return $seqCounter_
}
VideoBox public get_sequence_stamp {} {
	$self instvar sequenceStamp_
	if {![info exist sequenceStamp_]} {
		return 0
	} else {
		return $sequenceStamp_
	}
}
VideoBox public is_empty {} {
	$self instvar isEmpty_
	return $isEmpty_
}
VideoBox public get_src_displayed {} {
	if {[$self is_empty]} {
		return 
	} else {
		$self instvar src_
		return $src_
	}
}
Class ActiveSource -superclass TkWindow
ActiveSource instproc update {} {
	$self instvar src_ ui_
	global ftext
	if ![info exists ftext($src_)] {
		return
	}
	update_rate $src_
	$ui_ trigger_sdes $src_
	after 1000 "$self update"
}
ActiveSource instproc destroy {} {
	$self instvar vw_ info_win_ rtp_win_ decoder_win_ scuba_win_
	$vw_ destroy
	if [info exists info_win_] {
		delete $info_win_
	}
	if [info exists rtp_win_] {
		delete $rtp_win_
	}
	if [info exists decoder_win_] {
		delete $decoder_win_
	}
	if [info exists scuba_win_] {
		delete $scuba_win_
	}
	$self next
}
ActiveSource instproc create-info-window {} {
	$self instvar src_ info_win_
	if [info exists info_win_] {
		$self delete-info-window
	} else {
		set info_win_ [new InfoWindow .info$src_ $src_ $self]
	}
}
ActiveSource instproc delete-info-window {} {
	$self instvar info_win_
	delete $info_win_
	unset info_win_
}
ActiveSource instproc stats {} {
	$self instvar src_
	return "Kilobits [expr [$src_ layer-stat nb_] >> (10-3)] \
		Frames [$src_ layer-stat nf_] \
		Packets [$src_ layer-stat np_] \
		Missing [$src_ missing] \
		Misordered [$src_ layer-stat nm_] \
		Runts [$src_ layer-stat nrunt_] \
		Dups [$src_ layer-stat ndup_] \
		Bad-S-Len [$src_ set badsesslen_] \
		Bad-S-Ver [$src_ set badsessver_] \
		Bad-S-Opt [$src_ set badsessopt_] \
		Bad-Sdes [$src_ set badsdes_] \
		Bad-Bye [$src_ set badbye_]"
}
ActiveSource instproc decoder-stats {} {
	$self instvar src_
	set d [$src_ handler]
	return [$d stats]
}
ActiveSource instproc create-rtp-window {} {
	$self instvar src_ rtp_win_
	if [info exists rtp_win_] {
		$self delete-rtp-window
	} else {
		set rtp_win_ [new RtpStatWindow .rtp$src_ $src_ \
					"RTP Statistics" \
					"$self stats" \
					"$self delete-rtp-window"]
	}
}
ActiveSource instproc delete-rtp-window {} {
	$self instvar rtp_win_
	delete $rtp_win_
	unset rtp_win_
}
ActiveSource instproc create-decoder-window {} {
	$self instvar src_ decoder_win_
	if [info exists decoder_win_] {
		$self delete-decoder-window
	} else {
		if { "[$src_ handler]" == "" } {
			new ErrorWindow "no decoder stats yet"
			return
		}
		set decoder_win_ [new RtpStatWindow .decoder$src_ $src_  \
				"Decoder Statistics" \
				"$self decoder-stats" \
				"$self delete-decoder-window"]
	}
}
ActiveSource instproc delete-decoder-window {} {
	$self instvar decoder_win_
	if [info exists decoder_win_] {
		delete $decoder_win_
		unset decoder_win_
	}
}
ActiveSource instproc build_info_menu {src m} {
	menu $m
	set f [$self get_option smallfont]
	$m add command -label "Site Info" \
		-command "$self create-info-window" -font $f
	$m add command -label "RTP Stats"\
		-command "$self create-rtp-window" -font $f
	$m add command -label "Decoder Stats" \
		-command "$self create-decoder-window" -font $f
	$self instvar ui_
	if [in_multicast [[$ui_ set videoAgent_] 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
	}
	$ui_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$m add command -label "Scuba Info" -font $f \
			-command "$self create-scuba-window"
	}
}
ActiveSource instproc create-scuba-window {} {
	$self instvar scuba_win_ ui_ src_
	$ui_ instvar scuba_sess_
	if [info exists scuba_win_] {
		$self delete-scuba-window
	} else {
		set scuba_win_ [new ScubaInfoWindow .scubainfo$self \
				$src_ $self $scuba_sess_]
		[$scuba_sess_ source-manager] attach $scuba_win_
		$scuba_win_ timeout
	}
}
ActiveSource instproc delete-scuba-window {} {
	$self instvar scuba_win_ ui_
	$ui_ instvar scuba_sess_
	[$scuba_sess_ source-manager] detach $scuba_win_
	delete $scuba_win_
	unset scuba_win_
}
ActiveSource private create_user_window { } {
	$self instvar asm_ localChannel_
	new UserWindow $asm_ $self [$self yesno useCues] $localChannel_ 
}
ActiveSource private select-thumbnail-to-drag {} {
	$self instvar draggableToplevel_
	raise $draggableToplevel_
	puts stderr "selecting ActiveSource = $self"
}
ActiveSource private move-thumbnail {} {
	$self instvar draggableToplevel_
	set x [winfo pointerx $draggableToplevel_]
	set y [winfo pointery $draggableToplevel_]
	puts "moving +$x+$y"
	raise $draggableToplevel_
	wm geometry $draggableToplevel_ +$x+$y
	wm deiconify $draggableToplevel_
	update idletasks 
}
ActiveSource private release-thumbnail {} {
	$self instvar draggableToplevel_
	set x [expr [expr [winfo width $draggableToplevel_] / 2] + [winfo rootx $draggableToplevel_]]
	set y [expr [expr [winfo height $draggableToplevel_] / 2] + [winfo rooty $draggableToplevel_]]
	wm withdraw $draggableToplevel_
	puts "dropped off at [winfo containing $x $y]"
	puts "Have vbm go thru vb's and find the one w/ the matching widgetpath & put the selected ActiveSource in there"
}
ActiveSource instproc init { asm ui w src localChannel } {
	$self next $w
	$asm add_active $self $src
	frame $w -relief groove -borderwidth 0 \
		-visual [Application set visual_] \
		-colormap [Application set colormap_]
	$self instvar src_ ui_ thumbnail_ userwindows_ videoboxes_ asm_ localChannel_
	set src_ $src
	set ui_ $ui
	set userwindows_ ""
	set videoboxes_ ""
	set asm_ $asm
	set localChannel_ $localChannel
	after 1000 "$self update"
	set stamp $w.stamp
	frame $stamp -relief ridge -borderwidth 2
	bind $stamp <Enter> "%W configure -background gray90"
	bind $stamp <Leave> "%W configure -background \
		[$self get_option background]"
	if {[$ui_ info class] != "MuiUI"} {
		set video_widget_path $stamp.video
		set thumbnail_ [new VideoWidget $video_widget_path 80 60]
		$thumbnail_ set is_slow_ 1
		$self attach-thumbnail
		pack $stamp.video -side left -anchor c -padx 2
		pack $stamp -side left -fill y
		bind $video_widget_path <ButtonPress-1> "$self select-thumbnail"
		frame $w.r
		$self display_cw $w.r	
		$self display_ctrl $w.r	
		pack $w.r -side left -expand 1 -fill x
	} else {
		set vb [VideoBox $stamp.video -size thumbnail -border false -nametag true -ui $ui_ -updateSpeed slow -src $src_]
		pack $stamp.video -side left -anchor c -padx 0
		pack $stamp -side top -fill y
		set thumbnail_ [$vb get_video_widget]
		set video_widget_path [$vb get_video_widget_path]
		bind $video_widget_path <ButtonPress-2> "$self select-thumbnail"
		$self instvar draggableToplevel_
		set draggableToplevel_ .$self
		toplevel $draggableToplevel_
		wm overrideredirect $draggableToplevel_ 1
		VideoBox $draggableToplevel_.vb -size thumbnail -border false -nametag true -ui $ui_ -updateSpeed slow -src $src_
		pack $draggableToplevel_.vb
		wm withdraw $draggableToplevel_
		bind $video_widget_path <ButtonPress-1> "$self select-thumbnail-to-drag"
		bind $video_widget_path <B1-Motion> "$self move-thumbnail"
		bind $video_widget_path <ButtonRelease-1> "$self release-thumbnail"
	}
	bind $video_widget_path <Enter> { focus %W }
	bind $video_widget_path <d> "$src deactivate"
	update idletasks
}
ActiveSource public display_cw { w } {
	$self instvar src_ 
	set f [$self get_option smallfont]
	frame $w.cw -relief groove -borderwidth 2
	pack $w.cw -side left -expand 1 -fill both -anchor w -padx 0
	label $w.cw.name -textvariable src_nickname($src_) -font $f \
		-pady 1 -borderwidth 0 -anchor w 
	label $w.cw.addr -textvariable src_info($src_) -font $f \
		-pady 1 -borderwidth 0 -anchor w
	global ftext btext ltext
	set ftext($src_) "0.0 f/s"
	set btext($src_) "0.0 kb/s"
	set ltext($src_) "(0%)"
	frame $w.cw.rateinfo
	label $w.cw.rateinfo.fps -textvariable ftext($src_) -width 6 \
		-font $f -pady 0 -borderwidth 0
	label $w.cw.rateinfo.bps -textvariable btext($src_) -width 8 \
		-font $f -pady 0 -borderwidth 0
	label $w.cw.rateinfo.loss -textvariable ltext($src_) -width 6 \
		-font $f -pady 0 -borderwidth 0
	pack $w.cw.rateinfo.fps $w.cw.rateinfo.bps $w.cw.rateinfo.loss \
		-side left -anchor w
	pack $w.cw.name $w.cw.addr $w.cw.rateinfo -anchor w -fill x
	pack $w.cw -fill x -side top
}
ActiveSource public display_ctrl { w } {
	$self instvar src_ ui_
	set f [$self get_option smallfont]
	frame $w.ctrl -borderwidth 0
	global mutebutton
	set mutebutton($src_) [$ui_ mute_new_sources]
	$src_ mute $mutebutton($src_)
	checkbutton $w.ctrl.mute -text mute -borderwidth 2 \
		-highlightthickness 1 \
		-relief groove -font $f -width 4 \
		-command "$src_ mute \$mutebutton($src_)" \
		-variable mutebutton($src_)
	checkbutton $w.ctrl.color -text color -borderwidth 2 \
		-highlightthickness 1 \
		-relief groove -font $f -width 4 \
		-command "\[$src_ handler\] color \$colorbutton($src_)" \
		-variable colorbutton($src_)
	set m $w.ctrl.info.menu$src_
	menubutton $w.ctrl.info -text info... -borderwidth 2 \
		-highlightthickness 1 \
		-relief groove -font $f -width 5 \
		-menu $m
	$self build_info_menu $src_ $m
	pack $w.ctrl.mute -side left -fill x -expand 1
	pack $w.ctrl.color -side left -fill x -expand 1
	pack $w.ctrl.info -side left -fill both -expand 1
	global colorbutton
	set colorbutton($src_) 1
	pack $w.ctrl -fill x -side top
}
ActiveSource instproc isCIF {} {
	$self instvar src_
	return [expr [string compare [$src_ format_name] h261] == 0]
}
ActiveSource instproc attach-window uw {
	$self instvar src_ ui_ 
	[$uw video-widget] attach-decoder $src_ [[$ui_ set vframe_] set colorModel_] [$ui_ use_hw_decode]
	$self instvar userwindows_
	lappend userwindows_ $uw
	$uw set-name [$src_ getid]
	$ui_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_focus $src_
	}
}
ActiveSource instproc attach_videobox { vb } {
	$self instvar src_ ui_ vb_
	set vb_ $vb
	[$vb get_video_widget] attach-decoder $src_ [[$ui_ set vframe_] set colorModel_] [$ui_ use_hw_decode]
	$self instvar videoboxes_
	lappend videoboxes_ $vb
	$ui_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_focus $src_
	}
}
ActiveSource instproc user-windows {} {
	return [$self set userwindows_]
}
ActiveSource instproc video_boxes {} {
	return [$self set videoboxes_]
}
ActiveSource instproc detach-window uw {
	$self instvar userwindows_ src_ ui_
	$ui_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_unfocus $src_
	}
	[$uw video-widget] detach-decoder $src_
	set k [lsearch -exact $userwindows_ $uw]
	if { $k < 0 } {
		puts "[$self get_option appname]: detach-window: XXX"
		exit 1
	}
	set userwindows_ [lreplace $userwindows_ $k $k]
}
ActiveSource instproc detach_videobox vb {
	$self instvar videoboxes_ src_ ui_
	$ui_ instvar scuba_sess_
	if [info exists scuba_sess_] {
		$scuba_sess_ scuba_unfocus $src_
	}
	[$vb get_video_widget] detach-decoder $src_
	set k [lsearch -exact $videoboxes_ $vb]
	if { $k < 0 } {
		puts "[$self get_option appname]: detach-window: XXX"
		exit 1
	}
	set videoboxes_ [lreplace $videoboxes_ $k $k]
}
ActiveSource instproc detach-windows {} {
	$self instvar userwindows_
	foreach uw $userwindows_ {
		$self detach-window $uw
	}
	$self detach-thumbnail
}
ActiveSource instproc detach_videoboxes {} {
	$self instvar videoboxes_
	foreach vb $videoboxes_ {
		$self detach_videobox $vb
	}
}
ActiveSource instproc attach-thumbnail {} {
        $self instvar src_ ui_ thumbnail_
        $thumbnail_ attach-decoder $src_ [[$ui_ set vframe_] set colorModel_] [$ui_ use_hw_decode]
}
ActiveSource instproc detach-thumbnail {} {
        $self instvar src_ thumbnail_
        $thumbnail_ detach-decoder $src_
}
ActiveSource 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
}
ActiveSource public select-thumbnail {} {
	foreach uw [$self user-windows] {
		if { [$uw attached-source] == "$self" && ![$uw is-switched] } {
			$uw destroy
			return
		}
	}
	$self instvar ui_
	$self create_user_window 
}
Class ActiveSourceManager -superclass {Observer} -configuration {
	tile 1 
}
ActiveSourceManager public init {ui w videoAgent list_direction localChannel} {
	$self next 
	$self instvar ui_ videoAgent_ localChannel_
	set ui_ $ui
	set videoAgent_ $videoAgent
	set localChannel_ $localChannel
	$self instvar curcol_ currow_ ncol_ nrow_ list_direction_
	set curcol_ 0
	set currow_ 0
	set list_direction_ $list_direction
	set ncol_ [$self get_option tile]
	set nrow_ [$self get_option tile]
	$videoAgent_ attach $self	
}
ActiveSourceManager public init_grid {w} {
	$self instvar grid_ label_
	frame $w
	set grid_ $w.grid
	frame $grid_
	set label_ $w.label
	label $label_ -text "Waiting for video..."
	pack $label_ -anchor c -expand 1 -side left -fill both
}
ActiveSourceManager public add_active { as src } {
	$self instvar active_ grid_ label_
	set active_($src) $as
	if { [array size active_] == 1 } {
		pack forget $label_
		pack $grid_ -expand 1 -fill x -anchor n 
	}
}
ActiveSourceManager public rm_active src {
	$self instvar active_ grid_ label_
	unset active_($src)
	if { [array size active_] == 0 } {
		pack forget $grid_
		pack $label_ -anchor c -expand 1 -side left
	}
}
ActiveSourceManager public active-sources {} {
	$self instvar active_
	return [array names active_]
}
ActiveSourceManager public bump { } {
	$self instvar curcol_ currow_ list_direction_
	if { $list_direction_ == "vertical" } {	
		$self instvar ncol_
		incr curcol_
		if { $curcol_ == $ncol_ } {
			set curcol_ 0
			incr currow_
		}
	} else {
		$self instvar nrow_
		incr currow_
		if { $currow_ == $nrow_ } {
			set currow_ 0
			incr curcol_
		}
	}
}
ActiveSourceManager public redecorate n {
	$self instvar curcol_ currow_ list_direction_
	set curcol_ 0
	set currow_ 0
	if { $list_direction_ == "vertical" } {
		$self instvar ncol_
		set ncol_ $n
	} else {
		$self instvar nrow_
		set nrow_ $n
	}
	$self instvar grid_
	if ![info exists grid_] {
		return
	}
	foreach src [$self active-sources] {
		grid $grid_.$src -row $currow_ -column $curcol_ -sticky we
		if { $list_direction_ == "vertical" } {	
			grid columnconfigure $grid_ $curcol_ -weight 1
		} else {
			grid rowconfigure $grid_ $currow_ -weight 1
		}
		$self bump
	}
}
ActiveSourceManager public activate src {
	after idle "$self really_activate $src"
}
ActiveSourceManager public really_activate src {
	$self instvar grid_ curcol_ currow_ ui_ list_direction_ localChannel_
	set as [new ActiveSource $self $ui_ $grid_.$src $src $localChannel_]
	grid $grid_.$src -row $currow_ -column $curcol_ -sticky we
	if { $list_direction_ == "vertical" } {	
		grid columnconfigure $grid_ $curcol_ -weight 1
	} else {
		grid rowconfigure $grid_ $currow_ -weight 1
	}
	$ui_ update_decoder $src
	$self bump
	Switcher rebuild_switch_list_menu
	if {[$ui_ info class] == "MuiUI"} {
		$ui_ maybe_switch_in $src
	}
}
ActiveSourceManager public deactivate {src} {
	$self instvar active_
	if [info exists active_($src)] {
		set as $active_($src)
		set L [$as user-windows]
		foreach uw $L {
			delete $uw
		}
		$as detach-windows
		$as delete-decoder-window
	}
	$self instvar grid_
	set w $grid_.$src
	if [winfo exists $w] {
		grid forget $w
		destroy $w
		$self rm_active $src
	}
	$src handler ""
	Switcher rebuild_switch_list_menu
	global ftext btext ltext fpshat bpshat lhat shat
	unset ftext($src)
	unset btext($src)
	unset ltext($src)
	unset fpshat($src)
	unset bpshat($src)
	unset lhat($src)
	unset shat($src)
}
ActiveSourceManager public focus_speaker { infoname msg } {
	foreach s [$self active-sources] {
		if { [$s sdes cname] == $msg } {
		        Switcher focus $s
		} 
        }
}
ActiveSourceManager public change_name {src} {
	set name [$src sdes name]
	$self instvar active_
	if [info exists active_($src)] {
		set as $active_($src)
		foreach uw [$as user-windows] {
			if { [$uw attached-source] == "$as" } {
				$uw set-name $name
			}
		}
	}
	Switcher rebuild_switch_list_menu
}
ActiveSourceManager public trigger_format {src} {
	$self instvar active_ videoAgent_ ui_
	if ![info exists active_($src)] {
		return
	}
	set as $active_($src)
	set L [$as user-windows]
	$as detach-windows
	set extoutList [extout_detach_src $src]
	set d [$videoAgent_ reactivate $src]
	$ui_ update_decoder $src
	global colorbutton
	$d color $colorbutton($src)
	foreach uw $L {
		$as attach-window $uw
		[$uw video-widget] redraw
	}
	$as attach-thumbnail
	extout_attach_src $src $extoutList
}
ActiveSourceManager public decoder_changed {src} {
	$self instvar active_
	if ![info exists active_($src)] {
		return
	}
	set as $active_($src)
	set L [$as user-windows]
	$as detach-windows
	set extoutList [extout_detach_src $src]
	foreach w $iw {
		$as attach-window $uw
		$w redraw
	}
	extout_attach_src $src $extoutList
	return
}
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
	frame $w.spkr -borderwidth 0
	$self instvar spkr_meter_ mike_meter_ agent_ arbiter_
	set agent_ $agent
	set arbiter_ [new AudioArbiter $agent]
	set spkr_meter_ [$self mk.pane $w.spkr output speaker listen]
	frame $w.mike -borderwidth 0
	set mike_meter_ [$self mk.pane $w.mike input mike talk]
	pack $w.spkr $w.mike -side left -expand 1 -fill y
	set f [$self get_option ctrlFont]
	checkbutton $top.panel.button -text "Keep Audio" -font $f \
		-command "$self invoke_keep_audio" \
		-variable [$self tkvarname audioHeld] -anchor c \
		-relief ridge -borderwidth 2 -highlightthickness 0
	global keepAudioButton
	set keepAudioButton $top.panel.button
	$self invoke_keep_audio
	pack $top.panel.button -fill x -side 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 -borderwidth 1 -relief raised
	set cb [new CheckButton $w.mute.b -text $label -font $f -relief ridge \
		-anchor c \
		-command "$self mute_invoke $which" \
		-borderwidth 2 \
		-onvalue unmuted \
		-offvalue muted \
		-highlightthickness 0]
	$cb set-val unmuted
	$self instvar $which\_mute_ 
	set $which\_mute_ $cb
	pack $w.mute.b -expand 1 -fill x
	frame $w.select -borderwidth 2 -relief raised
	button $w.select.b -bitmap $bitmap -relief flat -borderwidth 2 \
		-command "$self changePort $which $w.select.b $w.frame.scale" \
		-height 24 -highlightthickness 1
	pack $w.select.b -expand 1 -fill x
	$self instvar agent_
	if { [llength [$agent_ get_$which\_ports]] <= 1 } {
		$w.select.b configure -state disabled
	}
	frame $w.frame -borderwidth 2 -relief raised
	set meter [new Meter/Linear $w.frame.meter]
	scale $w.frame.scale -orient vertical \
			-showvalue 0 \
			-from 256 -to 0 \
			-command "$self setgain $which" \
			-relief groove -borderwidth 2 -length 200 \
			-highlightthickness 0
	global $which\Scale $which\PortButton
	set $which\Scale $w.frame.scale
	set $which\PortButton $w.select.b
	pack $w.frame.meter $w.frame.scale -side left -expand 1 -fill y
	pack $w.mute $w.select -fill x
	pack $w.frame -expand 1 -fill y
	return $meter
}
AudioPanel instproc ptt-press {} {
	$self instvar input_mute_
	if { "[$input_mute_ get-val]" == "muted" } {
		$input_mute_ invoke
	}
}
AudioPanel instproc ptt-release {} {
	$self instvar input_mute_
	if { "[$input_mute_ get-val]" == "unmuted" } {
		$input_mute_ invoke
	}
}
AudioPanel instproc set_recv_only v {
	$self instvar input_mute_
	if $v {
		$self ptt-release
		$input_mute_ configure -state disabled
	} else {
		$input_mute_ configure -state normal
	}
}
AudioPanel instproc action {} {
	$self instvar agent_ arbiter_ output_mute_
	if { ![$agent_ have_audio] && "[$output_mute_ get-val]" == "unmuted" } {
		$arbiter_ request
	}
}
AudioPanel instproc cancel_timer {} {
	$self instvar arbiter_
	delete $arbiter_
}
Class UISrcListWindow -superclass TopLevelWindow
UISrcListWindow public init {w videoAgent} {
	$self instvar nSRCLIST_
	set nSRCLIST_ 0
	$self next $w\X$nSRCLIST_
	set win $w\X$nSRCLIST_
	$self create-window $win "Video Participants"
	wm geometry $win 300x320
	wm minsize $win 0 0
	new UISrcList $win $videoAgent
	incr nSRCLIST_
}
Class UISrcList -superclass {TkWindow Observer} 
UISrcList public init {w videoAgent} {
	$self instvar bottom_
	set bottom_ 2
	$self instvar srclist_
	frame $w.b -borderwidth 2 -relief sunken
	scrollbar $w.b.scroll -relief groove -borderwidth 2 \
			-command "$w.b.list yview"
	canvas $w.b.list -relief groove -borderwidth 0 \
		-height 10 -width 10 -yscrollcommand "$w.b.scroll set" 
	set srclist_ $w.b.list
	button $w.ok -text " Dismiss " -borderwidth 0 -relief raised \
		-command "wm withdraw $w" -font [$self get_option medfont] 
	pack $w.b -fill both -expand 1
	pack $w.b.scroll -side left -fill y
	pack $w.b.list -side left -expand 1 -fill both
	pack $w.ok -fill x
	$videoAgent attach $self
}
UISrcList instproc register src {
	$self next
	$self instvar nametag_ srclist_ bottom_ srcstate_
	set srcstate_($src) 1
	set f [$self get_option medfont]
	set nametag_($src) [$srclist_ create text 5 $bottom_  \
			-font $f -text [$src addr] -anchor nw ]
	set bottom_ [lindex [$srclist_ bbox $nametag_($src)] 3]
	incr bottom_ 2
	$srclist_ config -scrollregion "0 0 2.5i $bottom_"
}
UISrcList instproc change_name src {
	$self instvar srclist_ nametag_
	if [info exists nametag_($src)] {
		$srclist_ itemconfigure $nametag_($src) -text [$src getid]
	}
}
UISrcList instproc adjustNames { thresh h } {
	$self instvar nametag_ srclist_ bottom_
	foreach s [array names nametag_] {
		set y [lindex [$srclist_ coords $nametag_($s)] 1]
		if { $y > $thresh } {
			$srclist_ move $nametag_($s) 0 -$h
		}
	}
	incr bottom_ -$h
	$srclist_ config -scrollregion "0 0 2.5i $bottom_"
}
UISrcList instproc unregister src {
	$self instvar nametag_ srclist_
	global name_line info_line
	destroy_rtp_stats $src
	if [info exists name_line($src)] {
		unset name_line($src)
		unset info_line($src)
	}
	set thresh [lindex [$srclist_ coords $nametag_($src)] 1]
	set bb [$srclist_ bbox $nametag_($src)]
	set height [expr [lindex $bb 3] - [lindex $bb 1]]
	incr height 2
	$srclist_ delete $nametag_($src)
	unset nametag_($src)
	$self adjustNames $thresh $height
}
UISrcList instproc trigger_idle src {
	$self instvar nametag_ srclist_ srcstate_
	if [info exists nametag_($src)] {
		if [$src lost] {
			$srclist_ itemconfigure $nametag_($src) -stipple gray50
			set srcstate_($src) 2
		} else {
			$srclist_ itemconfigure $nametag_($src) -stipple {}
			set srcstate_($src) 1
		}
	}
}
Class VisualFrame -configuration {
	dither Dither 
	gamma 0.7 
}
VisualFrame instproc lookup_visual {} {
	set vlist [winfo visualsavailable .]
	if { [lsearch -exact $vlist "truecolor 24"] >= 0 || \
		 [lsearch -exact $vlist "truecolor 32"] >= 0 } {
		set visual "truecolor 24"
	} elseif { [lsearch -exact $vlist "truecolor 16"] >= 0 } {
		set visual "truecolor 16"
	} elseif { [lsearch -exact $vlist "pseudocolor 8"] >= 0 } {
		set visual "pseudocolor 8"
	} elseif { [lsearch -exact $vlist "staticgray 1"] >= 0 } {
		set visual "staticgray 1"
	} else {
		puts stderr "[$self get_option appname]: no support for your display type {$vlist}"
		exit 1
	}
}
VisualFrame instproc init {w ui} {
	global V
	$self instvar gamma_ dither_ ui_
	set ui_ $ui
	Application set colormap_ $w
	set dither [$self get_option dither]
	if { $dither == "best" } {
		set dither ED
	}    
	if { $dither == "dither" } {
		set dither Dither
	}
	if { $dither == "gray" } {
		set dither Gray
	}
	if { $dither == "quantize" } {
		set dither Quant
	}
	set gamma_ [$self get_option gamma]
	if { [lsearch -exact "Dither ED Gray Quant" $dither] < 0 } {
		puts stderr "[$self get_option appname]: unknown dither: $dither"
		exit 1
	}
	set visual [$self get_option visual]
	if { $visual == "" } {
		set visual [$self lookup_visual]
	} elseif { $visual == "pseudocolor" } {
		set visual "pseudocolor 8"
	}
	set cmap ""
	if [$self yesno privateColormap] {
		set cmap "-colormap new"
	}
	if [catch "frame $w -visual {$visual} $cmap"] {
		$self fatal "bad visual: $visual"
	}
	if { [winfo depth $w] == 8 } {
		set dither_ $dither
	} else {
		set dither_ ""
	}
	Application set visual_ $visual
	if ![$self init_color] {
		if { [winfo depth $w] != 8 } {
			puts stderr "[$self get_option appname]: internal error: no colors"
			exit 2
		}
		puts stderr \
		    "[$self get_option appname]: warning: ran out of colors; using private colormap"
		destroy $w
		frame $w -visual [Application set visual_] -colormap new
		if ![$self init_color] {
			puts stderr "[$self get_option appname]: internal error: no colors"
			exit 2
		}
	}
}
set vmap(truecolor) TrueColor
set vmap(pseudocolor) PseudoColor
VisualFrame instproc init_color {} {
	global vmap
	$self instvar dither_ gamma_ colorModel_
	if [info exists colorModel_] {
		delete $colorModel_
		unset colorModel_
	}
	set colormap [Application set colormap_]
	set v [winfo visual $colormap]
	set v $vmap($v)
	set d [winfo depth $colormap]
	if { $d == 8 } {
		set id $v/$d/$dither_
	} else {
		set id $v/$d
	}
	if { $id == "TrueColor/32" } {
		set id TrueColor/24
	}
	set cm [new Colormodel/$id]
	if { $cm == "" } {
		puts stderr "[$self get_option appname]: unsupported visual type: $v"
		exit 1
	}
	$cm visual $colormap
	$cm gamma $gamma_
	if ![$cm alloc-colors] {
		delete $cm
		return 0
	}
	set colorModel_ $cm
	return 1
}
VisualFrame instproc revert_to_gray {} {
	$self instvar dither_
	if { $dither_ == "Gray" } {
		puts stderr "[$self get_option appname]: out of colors"
		exit 1
	}
	new ErrorWindow "ran out of colors; reverting to gray"
	$self set_dither Gray
}
VisualFrame instproc set-dither {d} {
	$self instvar dither_ ui_
	set dither_ $d
	if ![$self init_color] {
		$self revert_to_gray
	}
	set asm [$ui_ set asm_]
	foreach s [$asm active-sources] {
		$asm trigger_format $s
	}
}	
VisualFrame instproc set-gamma {s} {
	$self instvar colorModel_ gamma_
	global win_src
	set cm $colorModel_
	if ![$cm gamma $s] {
		return -1
	}
	set gamma_ $s
	$cm free-colors
	if ![$cm alloc-colors] {
		$self revert_to_gray
	}
	foreach src [session active] {
		set d [$src handler]
		if { $d != "" } {
			$d redraw
		}
	}
	return 0
}
Class VicUI -superclass Observer -configuration {
	minwidth 200
	minheight 100
	filterGain 0.25
	geometry {}
	vain false
}
VicUI instproc build_menubar { w controlWindow helpWindow exitCmd } {
	frame $w -relief ridge -borderwidth 2
	label $w.title -text "[$self get_option appname] v[version]" -font [$self get_option smallfont] \
		-relief flat -justify left
	button $w.quit -text Quit -relief raised \
		-font [$self get_option smallfont] -command $exitCmd \
		-highlightthickness 1
	button $w.menu -text Menu -relief raised \
		-font [$self get_option smallfont] -highlightthickness 1 \
		-command "$controlWindow toggle"
	button $w.help -text Help -relief raised \
		-font [$self get_option smallfont] -highlightthickness 1 \
		-command "$helpWindow toggle"
	pack $w.title -side left -fill both -expand 1
	pack $w.menu $w.help $w.quit -side left -padx 1 -pady 1
}
VicUI instproc window-title { prefix name } {
	$self instvar name_ prefix_
	set name_ $name
	set prefix_ $prefix
	wm iconname . "$prefix_$name_"
	wm title . "$prefix_$name_"
	proc mark_icon mark "$self mark-icon \$mark"
}
VicUI instproc mark-icon mark {
	$self instvar name_ prefix_
	global current_icon_mark
	if {$mark != $current_icon_mark} {
		set current_icon_mark $mark
		append mark $prefix_$name_
		wm iconname . $mark
	}
}
VicUI instproc init { w localChannel globalChannel videoAgent vpipe exitCmd {vspec {}} {CINDY_HACK_HAVE_VIDEO 1} } {
	$self next 
	$self instvar localChannel_ globalChannel_ videoAgent_ vpipe_ exitCmd_ 
	set localChannel_ $localChannel
	set globalChannel_ $globalChannel
	set videoAgent_ $videoAgent 
	set vpipe_ $vpipe
	set exitCmd_ "$exitCmd"
	if !$CINDY_HACK_HAVE_VIDEO {
		$self layout_gui $w	
		set conf [$self get_option conferenceName]
	} else {
		$videoAgent attach $self
		$self build_gui $w 
		if { $vspec == "" } {
			set conf "Contacting MeGa..."
		} else {
			set conf [$self get_option conferenceName]
		}
	}
	set prefix [$self get_option iconPrefix]
	$self window-title $prefix $conf
	$self set-geometry
	if [$self yesno transmitOnStartup] {
		[$self set controlMenu_] build_window
		[$self set controlMenu_] invoke_transmit
	}
	$self init_keybindings "$exitCmd_"	
}
VicUI instproc reset {} {
	$self new_hostspec
	set conf [$self get_option conferenceName]
	$self window-title [$self get_option iconPrefix] $conf	
}
VicUI public init_keybindings { exitCmd } {
	bind . <Enter> { focus %W }
	bind . <q> "$exitCmd"
	bind . <Control-c> "$exitCmd"
	bind . <Control-d> "$exitCmd"
}
VicUI instproc build_gui { w } {
	$self instvar videoAgent_ userwindows_ path_ vpipe_ asm_ localChannel_ globalChannel_
	$self set_rate_vars [$videoAgent_ set session_]
	$self instvar id_
	set id_ [after 1000 "$self periodic_update"]
	if { ![$self yesno vain] && [$videoAgent_ have_network] } {
		Switcher set ignore_([$videoAgent_ local]) 1
	}
	$self layout_gui $w	
	set cb $localChannel_
	if { $cb != "" } {
		$cb register FOCUS_SPEAKER "$asm_ focus_speaker"
	}
	set cb $globalChannel_
	if { [$self yesno useCues] && $cb!="" }  {
		CuesReceiver set_cb $cb
	}
}
VicUI public layout_gui {w} {
	$self instvar asm_ controlMenu_ videoAgent_ vpipe_ vframe_ exitCmd_ localChannel_
	set vframe_ [new VisualFrame $w.top $self]
	set asm_ [new ActiveSourceManager $self $w.top $videoAgent_ vertical $localChannel_]	
	foreach i { 1 2 3 4 } {
		bind . <Key-$i> "$asm_ redecorate $i"
	}
	pack $w.top -expand 1 -fill both
        set controlMenu_ [new ControlMenu $self $videoAgent_ $vpipe_ $vframe_ $asm_ [new UISrcListWindow $w $videoAgent_]]
	bind . <t> "$controlMenu_ build_window ; $controlMenu_ invoke_transmit"
	$self build_menubar $w.top.bar $controlMenu_ [new VicHelpWindow .help] "$exitCmd_"
	pack $w.top.bar -fill x -side bottom
	$asm_ init_grid $w.top.f
	pack $w.top.f -expand 1 -fill both -side top
}
VicUI public use_hw_decode {} {
	$self instvar controlMenu_
	return [$controlMenu_ use-hw]
}
VicUI public mute_new_sources {} {
	$self instvar controlMenu_
	return [$controlMenu_ mute-new-sources]
}
VicUI instproc set-geometry {} {
	if { ![info exists mash(environ)] || $mash(environ)!="mplug" } {
	    wm withdraw .
	}
	wm geometry . [$self get_option geometry]
	update idletasks
	set minwidth [winfo reqwidth .]
	set minheight [winfo reqheight .]
	if { $minwidth < [$self get_option minwidth] } {
		set minwidth [$self get_option minwidth]
	}
	if { $minheight < [$self get_option minheight] } {
		set minheight [$self get_option minheight]
	}
	wm minsize . $minwidth $minheight
	global mash
	if { ![info exists mash(environ)] || $mash(environ)!="mplug" } {
		wm deiconify .
	}
}
VicUI instproc periodic_update { } {
	$self instvar videoAgent_ vpipe_ id_
	if [$vpipe_ running] {
		update_rate [$videoAgent_ set session_]
	}
	update idletasks
	set id_ [after 1000 "$self periodic_update"]
}
VicUI instproc clean_timers { } {
	$self cancel_periodic_update
}
VicUI instproc cancel_periodic_update { } {
        $self instvar id_
        if [info exists id_] {
                after cancel $id_
                unset id_
        }
}
VicUI instproc set_rate_vars {src} {
	global fpshat bpshat lhat shat
	if [info exists fpshat($src)] {
		unset fpshat($src)
		unset bpshat($src)
		unset lhat($src)
		unset shat($src)
	}
	set gain [$self get_option filterGain]
	set fpshat($src) 0
	rate_variable fpshat($src) $gain
	set bpshat($src) 0
	rate_variable bpshat($src) $gain
	set lhat($src) 0
	rate_variable lhat($src) $gain
	set shat($src) 0
	rate_variable shat($src) $gain
}
VicUI instproc new_hostspec {} {
	$self instvar controlMenu_
	if [info exists controlMenu_] {
		$controlMenu_ new_hostspec
	}
}
VicUI instproc trigger_sdes src {
	$self instvar asm_
	global src_info src_nickname src_name
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set src_nickname($src) $addr
			set info $addr/[$src format_name]
		} else {
			set src_nickname($src) $cname
			set info "$addr/[$src format_name]"
		}
	} elseif [cname_redundant $name $cname] {
		set src_nickname($src) $name
		set info $addr/[$src format_name]
	} else {
		set src_nickname($src) $name
		set info $cname/[$src format_name]
	}
	set msg [$src sdes note]
	if { $msg != "" } {
		set info $msg
	}
	set src_info($src) $info
	if { ![info exists src_name($src)] || "$src_name($src)" != "$name" } {
		set src_name($src) $name
		$asm_ change_name $src
	}
}
VicUI instproc trigger_media src {}
VicUI instproc update_decoder src {
	$self set_rate_vars $src
	$self trigger_sdes $src
}
proc update_rate src {
	global ftext btext ltext fpshat bpshat lhat shat V
	set key $src
	if [string match Session/* [$src info class]] {
		set bpshat($key) [expr 8 * [$src set nb_]]
		set fpshat($key) [$src set nf_]
	} else {
		set p [$src layer-stat np_]
		set s [$src ns]
		set shat($key) $s
		set lhat($key) [expr $s-$p]
		if {$shat($key) <= 0.} {
			set loss 0
		} else {
			set loss [expr 100*$lhat($key)/$shat($key)]
		}
		if {$loss < .1} {
			set ltext($key) (0%)
		} elseif {$loss < 9.9} {
			set ltext($key) [format "(%.1f%%)" $loss]
		} else {
			set ltext($key) [format "(%.0f%%)" $loss]
		}
		set bpshat($key) [expr 8 * [$src layer-stat nb_]]
		set fpshat($key) [$src layer-stat nf_]
	}
	set fps $fpshat($key)
	set bps $bpshat($key)
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.0f kb/s" [expr $bps / 1000]]
	} else {
		set bps [format "%.1f Mb/s" [expr $bps / 1000000]]
	}
	set ftext($key) $fps
	set btext($key) $bps
}
Class VicHelpWindow -superclass HelpWindow
VicHelpWindow instproc build w {
	$self create-window $w "Help" {
"Transmit video by clicking on the ``Transmit'' button \
in the ``Menu'' window.  You need video capture hardware to do this."
"Incoming video streams appear in the main vic window.  \
If you see the message ``Waiting for video...'', then no one is transmitting \
video to the conference address you're running on.  Otherwise, you'll \
see a thumbnail sized image and accompanying information for each source. \
Click on the thumbnail to open a larger viewing window.  You can tile the \
thumbnails in multiple columns using the ``Tile'' menu in the ``Menu'' window."
"Clicking on the ``mute'' button for a given source will \
turn off decoding.  It is usually a good idea to do \
this for your own, looped-back transmission."
"The transmission rate is controlled with the bit-rate \
and frame-rate sliders in the ``Transmission'' panel of the ``Menu'' window.  \
The more restrictive setting limits the transmission rate."
"The video windows need not be fixed to a given source. \
The ``Mode...'' menu attached to a viewing window allows you to specify \
voice-switched and/or timer-switched modes.   In timer-switched mode, the \
window automatically cycles through (unmuted) sources, while in \
oice-switched mode, the window switches to whomever is talking \
(using cues from vat).  You can have more than one voice-switched window, \
which results in a simple LRU allocation of the windows to most recent \
speakers.  See the man page for more details."
"If the user interface looks peculiar, you might \
have X resources that conflict with tk.  A common problem is \
defining ``*background'' and/or ``*foreground''."
"Bugs and suggestions to mash-developers@mash.cs.berkeley.edu.  Thanks."
	}
}
VicUI instproc create-audio-ui agent {
	$self instvar audioUI_ path_
	set audioUI_ [new VicAudioUI $path_.top.f $self $agent]
}
Class VicAudioUI
VicAudioUI instproc init { w mainUI agent } {
	$self instvar mainUI_ panel_
	set mainUI_ $mainUI 
	set panel_ [new AudioPanel $w $agent]
	global meterDisable
	set meterDisable 0
	$panel_ install_meters
	$panel_ ptt-release
	$agent select_format PCM 2
}
VicAudioUI instproc destroy {} {
	$self instvar panel_
	delete $panel_
}
VicAudioUI instproc register src {
	puts "VicAudioUI::register [$src getid]"
}
VicAudioUI instproc activate src {
	puts "ACTIVATE: [$src getid]"
}
VicAudioUI instproc trigger_media src {
	puts "AUDIO-FROM: [$src getid]"
}
VicAudioUI instproc trigger_idle src {
	puts "IDLE: [$src getid] [$src lost]"
}
VicAudioUI instproc trigger_sdes src {
	puts "SDES: [$src getid]"
}
package provide ExtOut
proc extout_build_thumbnail { w d } {
	set stamp $w.stamp
	frame $stamp -relief groove -borderwidth 2
	create_video_widget $stamp.video 80 60
	global win_is_slow win_use_hw extout_tn
	set win_is_slow($stamp.video) 1
	set extout_is_slow($d) 0
	set extout_tn($d) $stamp.video
	pack $stamp.video -anchor c -padx 2
	pack $stamp -fill y
	frame $w.b -background purple
	button $w.b.rev -bitmap rev -command "switcher_prev $d" 
	button $w.b.fwd -bitmap fwd -command "switcher_next $d"
	pack $w.b.rev $w.b.fwd -side left -fill x -expand 1 -padx 0
	pack $w.b -fill x
}
proc extout_build_modes { w d } {
	set f [$self get_option smallfont]
	checkbutton $w.ts -text "Timer-Switched" -font $f -anchor w \
		-variable extout_is_timed($d) \
		-command "extout_set_timed $d"
	checkbutton $w.vs -text "Voice-Switched" -font $f -anchor w \
		-variable extout_is_switched($d) \
		-command "extout_set_switched $d"
	if ![have cb] {
		$w.vs configure -state disabled
	}
	checkbutton $w.sc -text "Save-CPU" -font $f -anchor w \
		-variable extout_is_slow($d) \
		-command "extout_set_slow $d"
	pack $w.vs $w.ts $w.sc -anchor w -fill x
}
proc extout_set_scale d {
	global extout_target extout_scale
	if [info exists extout_target($d)] {
		$extout_target($d) scale $extout_scale($d)
	}
}
proc extout_build_buttons { w d } {
	set f [$self get_option smallfont]
	set m $w.mb.menu
	menubutton $w.mb -text Port... -menu $m \
		-relief raised -font $f
	$w.mb configure -state disabled
	checkbutton $w.ext -text "Scale-Up" -font $f \
		-relief raised -anchor w -highlightthickness 0 \
		-variable extout_scale($d) \
		-command "extout_set_scale $d"
	button $w.sd -text "Shutdown" -font $f \
		-command "extout_shutdown $d [winfo toplevel $w]" \
		-highlightthickness 0
	pack $w.mb $w.ext $w.sd -anchor w -fill x
}
proc extout_mb_post { d flag x y } {
	if { $flag != "" } {
		global extout_mb src_nickname
		set menu $extout_mb($d).menu
		if [winfo exists $menu] {
			destroy $menu
		}
		menu $menu
		foreach src [session active] {
			$menu add command -label $src_nickname($src) \
				-command "switcher_set $d $src"
		}
		tkMbPost $flag $x $y
	}
}
proc extout_select d {
	set w .$d
	if [winfo exists $w] {
		if [winfo ismapped $w] {
			wm withdraw $w
		} else {
			wm deiconify $w
		}
		return
	}
	create_toplevel $w "[$d nickname]"
	catch "wm resizable $w false false"
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief ridge
	label $w.title.main -borderwidth 0 -anchor w \
		-text "External Output Controls ([$d nickname])"
	frame $w.frame -borderwidth 2 -relief ridge
	frame $w.frame.v
	frame $w.frame.v.tn
	extout_build_thumbnail $w.frame.v.tn $d
	frame $w.frame.v.modes -relief groove -borderwidth 2
	extout_build_modes $w.frame.v.modes $d
	frame $w.frame.v.buttons
	extout_build_buttons $w.frame.v.buttons $d
	pack $w.frame.v.tn $w.frame.v.modes $w.frame.v.buttons \
		-side left -padx 2
	set mb $w.frame.src
	menubutton $mb -text "<no stream>" -menu $mb.menu \
		-relief raised -width 20
	global extout_mb
	set extout_mb($d) $mb
	bind $mb <1> "extout_mb_post $d \$tkPriv(inMenubutton) %X %Y"
	pack $w.frame.v $w.frame.src -fill x -pady 2 -padx 2
	pack $w.title.main -anchor w
	pack $w.title -fill x
	pack $w.frame -expand 1 -fill both -anchor center
	wm geometry $w +[winfo pointerx .]+[winfo pointery .]
	wm deiconify $w
	button $w.dismiss -relief raised \
		-command "wm withdraw $w" -text Dismiss -font $f
	pack $w.dismiss -anchor c -pady 2
	switcher_register $d "" extout_switch
}
proc extout_switch { d src } {
	extout_release $d
	extout_bind $d $src
}
proc extout_shutdown { d w } {
	extout_release $d
	destroy $w
}
proc extout_release d {
	global extout_target extout_src extout_tn
	if [info exists extout_src($d)] {
		detach_window $extout_src($d) $extout_tn($d)
		extout_detach $d
		unset extout_src($d)
	}
}
proc extout_detach d {
	global extout_target extout_src
	set src $extout_src($d)
	[$src handler] detach $extout_target($d)
	delete $extout_target($d)
	unset extout_target($d)
}
proc extout_bind { d src } {
	extout_release $d
	extout_attach $d $src
	global extout_tn
	attach_window $src $extout_tn($d)
}
proc extout_attach { d src } {
	global extout_target extout_src extout_mb extout_scale src_nickname
	set fmt [$src format_name]
	if { $fmt == "jpeg" } {
		set fmt $fmt/[[$src handler] decimation]
	}
	set target [$d assistor $fmt]
	if { $target == "" } {
		set target [$d renderer [[$src handler] decimation]]
	}
	if { $target != "" } {
		set extout_src($d) $src
		set extout_target($d) $target
		$target scale $extout_scale($d)
		[$src handler] attach $target
		$extout_mb($d) configure -text $src_nickname($src)
		extout_set_slow $d
		return $target
	}
	return ""
}
proc extout_detach_src src {
	global extout_src
	if ![info exists extout_src] {
		return
	}
	set list ""
	foreach d [array names extout_src] {
		if { $extout_src($d) == $src } {
			extout_detach $d
			set list "$list $d"
		}
	}
	return $list
}
proc extout_attach_src { src list } {
	foreach d $list {
		extout_attach $d $src
	}
}
proc extout_set_switched d {
	global extout_is_switched
	if { $extout_is_switched($d) != 0 } {
		switcher_enable $d
	} else {
		switcher_disable $d
	}
}
proc extout_set_timed d {
	global extout_is_timed
	if { $extout_is_timed($d) != 0 } {
		switcher_set_timer $d
	} else {
		switcher_cancel_timer $d
	}
}
proc extout_set_slow d {
	global extout_target extout_is_slow
	if [info exists extout_target($d)] {
		if $extout_is_slow($d) {
			set interval [option get . stampInterval Vic]
		} else {
			set interval 0
		}
		$extout_target($d) update-interval $interval
	}
}
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 VicApplication -superclass RTPApplication
VicApplication instproc init {widgetPath argv} {
	$self next vic
	set o [$self options]
	$self init_args $o
	new FontInitializer $o
	option add *Font [$o get_option helv12b] startupFile
	$self init_resources $o
	$o load_preferences "rtp vic"
	set argv [$o parse_args $argv]
	set spec [$self check_hostspec $argv [$self get_option megaVideoSession]]
	$self check_rtp_sdes
	set t [$self get_option maxbw]
	if { $t > 0 } {
		$o add_option maxbw [expr 1000*$t]
	}
	if { $spec != "" } {
		$o add_option maxbw [[new AddressBlock $spec] set maxbw_(0)]
	}
	$self init_confbus
	$self instvar agent_ vpipe_ handler_ scuba_sess_
	set handler_ [new VideoHandler $spec]
	set agent_ [$handler_ agent]
	set vpipe_ [$handler_ vpipe]
	if { [$self get_option useScuba] != "" } {
		set scuba_sess_ [$handler_ set scuba_sess_]
	}
	$self instvar ui_
	set ui_ [$self init_ui $widgetPath $spec]
	set aspec [$self get_option audioSessionSpec]
	if { $aspec != "" } {
		$self instvar audioUI_ audioAgent_
		set audioAgent_ [new AudioAgent $self $aspec]
		set audioUI_ [$ui_ create-audio-ui $audioAgent_]
		$audioAgent_ attach $audioUI_
		$o add_option geometry 330x350
	}
	$self user_hook
}
VicApplication instproc init_ui { widgetPath spec } {
	$self instvar agent_ vpipe_ scuba_sess_
        $self instvar local_chan_ glob_chan_
	frame $widgetPath
	set ui [new VicUI $widgetPath $local_chan_ $glob_chan_ $agent_ $vpipe_ "$self exit" $spec]
	pack $widgetPath -expand 1 -fill both
	update idletasks
	if { [$self get_option useScuba] != "" } {
		$ui set scuba_sess_ $scuba_sess_
	}
	return $ui
}
VicApplication instproc exit {} {
	$self instvar agent_
	$agent_ shutdown
	exit 0
}
VicApplication private init_args o {
	$o register_option -a audioSessionSpec
	$o register_option -B maxbw
	$o register_option -C conferenceName
	$o register_option -c dither
	$o register_option -D device
	$o register_option -f videoFormat
	$o register_option -F maxfps
	$o register_option -I confBusChannel
	$o register_option -K sessionKey
	$o register_option -M colorFile
	$o register_option -m mtu
	$o register_option -o outfile
	$o register_option -q jpegQfactor
	$o register_option -t defaultTTL
	$o register_option -T softJPEGthresh
	$o register_option -U stampInterval
	$o register_option -V visual
	$o register_option -N rtpName
	$o register_list_option -map rtpMap
	$o register_boolean_option -H useHardwareDecode
	$o register_boolean_option -P privateColormap
	$o register_option -rport megaRecvVideoPort
	$o register_option -ofmt megaVideoFormat
	$o register_option -usemega megaVideoSession
	$o register_option -megactrl megaVideoCtrl
	$o register_option -sspec videoSessionSpec
	$o register_option -maxsbw maxVideoSessionBW 
	$o register_option -sbw videoSessionBW 
	$o register_option -sloc videoServiceLocation
	$o register_boolean_option -scuba useScuba
	$o register_boolean_option -localscuba localScubaScope
	$o register_boolean_option -useCues useCues
	$o register_boolean_option -useRLM useRLM
}
VicApplication instproc reset { ab } {
	$self instvar handler_ ui_
	$handler_ reset $ab
	$ui_ reset
}
VicApplication private init_resources o {
        global tcl_platform
	new WidgetResourceInitializer
	$o add_default iconPrefix vic:
	$o add_default defaultTTL 16
	$o add_default confBusChannel 0 
	$o add_default videoFormat h.261
	$o add_default useJPEGforH261 false
	$o add_default useLayersWindow 1
	$o add_default useRLM 0
	$o add_default jvColors 32 
	$o add_default softJPEGthresh -1 
	$o add_default softJPEGcthresh 6 
	$o add_default maxVideoSessionBW 128000
        if {$tcl_platform(platform) != "windows"} {
	        option add Vic.background gray85 startupFile
	        option add Vic.foreground black startupFile
	        option add Vic.disabledForeground gray40 startupFile
	        $o add_default background gray85
                $o add_default foreground black
                $o add_default disabledForeground gray40
        }
}
VicApplication instproc init_confbus {} {
        $self instvar local_chan_ glob_chan_
        set local_chan_ [new CoordinationBus -channel 2]
        set ttl [$self get_option defaultTTL]
        set glob_chan_ [new CoordinationBus -channel 3 -ttl $ttl]
}
new VicApplication .[pid] $argv
