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

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

Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	if [info exists name_] {
		set name $name_
	} else {
		global argv0
		if [info exists argv0] {
			set name [file tail $argv0]
		} else {
			set name mash
		}
	}
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$options_ add_default appname mash
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_ arg_option_default_
	set arg_option_($flag) $option
	if { [lindex $args 0] == "-default" } {
		set arg_option_default_($flag) [lindex $args 1]
		set args [lrange $args 2 end]
	}
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_
	$self instvar arg_option_ arg_bool_ arg_bool_val_ arg_list_option_ \
			arg_option_default_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		set fatal_msg ""
		if [info exists arg_option_($arg)] {
			if { [llength $argv] > 0 && \
					[string index $val 0]!="-" } {
				$self add_option $arg_option_($arg) $val
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			if { [llength $argv] > 0 || \
					[string index $val 0]!="-" } {
				set o $arg_list_option_($arg)
				set l [$self get_option $o]
				lappend l $val
				$self add_option $o $l
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		$self usage
		$self fatal "unknown/invalid command option: $arg ($fatal_msg)"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]"
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {[file isdirectory $mash]} {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
Configuration public open_preferences { suffix {mode w} } {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open $mash/prefs-$suffix $mode 0644]
	return $f
}
Configuration public write_preference { file key value } {
	puts $file "$key: $value"
}
Configuration public close_preferences { file } {
	close $file
}
Class TkWindow -configuration {
	background gray85
}
Class TopLevelWindow -superclass TkWindow
TkWindow public init {path} {
	$self next
	$self instvar path_
	set path_ $path
}
TkWindow public widget_path {} {
	$self instvar path_
	return $path_
}
TkWindow instproc destroy {} {
	$self instvar path_
	if [winfo exists $path_] {
		destroy $path_
	}
	$self next
}
TkWindow instproc highlight { color } {
	$self instvar path_
	if { $path_ != "" } {
		$path_ configure -background $color
		foreach child [winfo children $path_] {
			window_highlight $child $color
		}
	}
}
TkWindow instproc set_background { color } {
	$self instvar path_
	$path_ configure -background $color
}
TopLevelWindow public build_window {} {
	$self instvar path_
	if ![winfo exists $path_] {
		$self build $path_
	}
}
TopLevelWindow instproc toggle {} {
	$self build_window
	$self instvar path_
	set w $path_
	$self instvar __mappedBefore__
	if { [winfo ismapped $w] } {
		wm withdraw $w
		return
	} elseif ![info exists __mappedBefore__] {
		set __mappedBefore__ 1
		wm transient $w .
		update idletasks
		set x [winfo rootx .]
		set y [winfo rooty .]
		incr y [winfo height .]
		incr y -[winfo reqheight $w]
		incr y -20
		incr x [winfo vrootx .]
		incr y [winfo vrooty .]
		if { $y < 0 } { set y 0 }
		if { $x < 0 } {
			set x 0
		} else {
			set right [expr [winfo screenwidth .] - \
					[winfo reqwidth $w]]
			if { $x > $right } {
				set x $right
			}
		}
		wm geometry $w +$x+$y
	}
	wm deiconify $w
}
TopLevelWindow instproc create-window { w title } {
	Application toplevel $w
	set title "[$self get_option iconPrefix] $title"
	wm transient $w .
	wm title $w $title
	wm iconname $w $title
	bind $w <Enter> "focus $w"
	wm withdraw $w
}
Class HelpWindow -superclass TopLevelWindow
HelpWindow instproc create-window { w title items } {
	$self next $w $title
	frame $w.frame -borderwidth 0 -relief flat
	set p $w.frame
	set n 0
	foreach m $items {
		set h $w.h$n
		incr n
		frame $h
		$self helpitem $h $m
		pack $h -expand 1 -fill both
	}
	button $w.frame.ok -text " Dismiss " -borderwidth 2 -relief raised \
		-command "wm withdraw $w" -font [$self get_option medfont]
	pack $w.frame.ok -pady 6 -padx 6 -anchor e
	pack $w.frame -expand 1 -fill both
        wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
}
HelpWindow instproc helpitem { w text } {
	set f [$self get_option helpFont]
	canvas $w.bullet -width 12 -height 12
	$w.bullet create oval 6 3 12 9 -fill black
	message $w.msg -justify left -anchor w -font $f -width 450 -text $text
	pack $w.bullet -side left -anchor ne -pady 5
	pack $w.msg -side left -expand 1 -fill x -anchor nw
}
Class ErrorWindow -superclass TopLevelWindow
ErrorWindow public init text {
	set w .dialog
	$self next $w
	catch "destroy $w"
	global V
	set applname [Application name]
	if { $applname == "" } {
		set applname "mash shell"
	}
	$self create-window $w "$applname error"
	label $w.label -text "$applname: $text" -font [$self get_option medfont] \
		-borderwidth 2 -relief groove
	button $w.button -text OK -command "$self destroy" \
			-font [$self get_option medfont]
	pack $w.label -expand 1 -fill x -ipadx 4 -ipady 4
	pack $w.button -pady 4
	wm withdraw $w
	update idletasks
	set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
		- [winfo vrootx [winfo parent $w]]]
	set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
		- [winfo vrooty [winfo parent $w]]]
	wm geom $w +$x+$y
	wm deiconify $w
	bind $w <Enter> "focus $w"
	tkwait window .dialog
}
Class CheckButton
CheckButton public init { w args } {
	$self instvar var_ path_
	set path_ $w
	set var_ [TclObject getid]
	eval checkbutton $w -variable $var_ $args
}
CheckButton instproc get_val {} {
	$self instvar var_
	global $var_
	return [set $var_]
}
CheckButton instproc set_val v {
	$self instvar var_
	global $var_
	set $var_ $v
}
CheckButton instproc set-val v { $self set_val $v }
CheckButton instproc get-val {} { $self get_val }
CheckButton instproc unknown args {
	$self instvar path_
	eval $path_ $args
}
Class RadioButtonsObj
RadioButtonsObj public init { w labelsList args } {
    $self instvar var_ path_ numButtons_
    set path_ $w
    set var_ [TclObject getid]
    set c 0
    foreach i $labelsList {
	eval radiobutton $w.rb$c -variable $var_ $args
	$w.rb$c configure -text [list $i]
	$w.rb$c configure -value [list $i]
	pack $w.rb$c -in $w -anchor w
	incr c
    }
    set numButtons_ $c
}
RadioButtonsObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
RadioButtonsObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
RadioButtonsObj private unknown args {
    $self instvar path_ numButtons_
    for {set i 0} {$i < $numButtons_} {incr i} {
	eval $path_.rb$i $args
    }
}
Class ScaleObj
ScaleObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval scale $w -variable $var_ $args
}
ScaleObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
ScaleObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
ScaleObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
Class EntryObj
EntryObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval entry $w -textvariable $var_ $args
}
EntryObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
EntryObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
Object instproc has_method { method } {
	if { [$self info procs $method]!="" } {
		return 1
	}
	return [[$self info class] has_method $method]
}
Class instproc has_method { method } {
	if { [$self info instprocs $method]!="" } {
		return 1
	}
	foreach cl [$self info heritage] {
		if { [$cl info instprocs $method]!="" } {
			return 1
		}
	}
	return 0
}
proc version {} {
	global mash
	return $mash(version)
}
proc local_fqdn {} {
	set host ""
	catch {set host [lookup_host_name [localaddr]]}
	if { [string first . $host] < 0 } {
		return ""
	}
	return $host
}
proc email_heuristic {} {
	set user [user_heuristic]
	set addr [local_fqdn]
	if { $addr == "" } {
		return ""
	}
	return $user@$addr
}
proc user_heuristic {} {
	global env
	if [info exists env(USER)] {
		set user $env(USER)
	} elseif [info exists env(LOGNAME)] {
		set user $env(LOGNAME)
	} else {
		catch {set env(USER) [getusername]}
		if [info exists env(USER)] {
			return $env(USER)
		}
		return "UNKNOWN"
	}
}
proc format_fps f {
	set fps $f
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	return $fps
}
proc format_bps b {
	set bps $b
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.1f kb/s" [expr $bps / 1000.]]
	} else {
		set bps [format "%.2f Mb/s" [expr $bps / 1000000.]]
	}
	return $bps
}
proc gettime {sec} {
    clock format $sec
}
proc sdr_gettimeofday {} {
    clock seconds
}
proc gettimenow {} {
    gettime [clock seconds]
}
proc getreadabletime {} {
    return [clock format [clock seconds] -format {%H:%M, %d/%m/%y}]
}
proc unix_to_ntp {unixtime} {
    set oddoffset 2208988800
    if {$unixtime==0} {return 0}
    return [format %u [expr $unixtime + $oddoffset]]
}
proc ntp_to_unix {ntptime} {
    set oddoffset 2208988800
    if {($ntptime==0)||($ntptime==1)} {return $ntptime}
    if {[catch {expr $ntptime - $oddoffset}] !=0} {
	    return 0
    }
    return [format %u [expr $ntptime - $oddoffset]]
}
proc duration_readable {secs {option terse}} {
	set ret ""
	set r [expr round($secs)]
	set h [expr $r / 3600]
	set r [expr $r % 3600]
	set m [expr $r / 60]
	set s [expr $r % 60]
	if {$option == "verbose"} then {
		if {$h} {
			set ret "$ret $h\h"
		}
		if {$m} {
			set ret "$ret $m\m"
		}
		if {$s} {
			set ret "$ret and $s\s"
		}
	} else {
		set ret "$h:$m:$s"
	}
		return $ret
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
proc invalid_addr a {
    set l [split $a .]
    if {[llength $l] != 4} { return 1 }
    foreach i $l {
	if {![is_number $i] || $i<0 || $i>255} { return 1 }
    }
    return 0
}
proc is_number n {
    if [catch {expr $n}] {
	return 0
    }
	return 1
}
proc parray {a {pattern *}} {
    upvar 1 $a array
    if ![array exists array] {
        error "\"$a\" isn't an array"
    }
    set maxl 0
    foreach name [lsort [array names array $pattern]] {
        if {[string length $name] > $maxl} {
            set maxl [string length $name]
        }
    }
    set maxl [expr {$maxl + [string length $a] + 2}]
    foreach name [lsort [array names array $pattern]] {
        set nameString [format %s(%s) $a $name]
        puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
    }
}
Class RTPApplication -superclass Application
RTPApplication public init name {
	$self next $name
}
RTPApplication public run_resource_dialog { name email } {
	set font [$self get_option medfont]
	set w .form
	global V
	frame $w
	frame $w.msg -relief ridge
	label $w.msg.label -font $font -wraplength 4i \
		-justify left -text \
"Please specify values for the following resources. \
These strings will identify you by name and by email address \
in any RTP-based conference.  Please use your real name and \
affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
The values you enter will be saved in ~/.mash/prefs so you will \
not have to re-enter them." -relief ridge
	pack $w.msg.label -padx 6 -pady 6
	pack $w.msg -side top
	foreach i {name email} {
		frame $w.$i -bd 2
		entry $w.$i.entry -relief sunken
		label $w.$i.label -width 10 -anchor e
		pack $w.$i.label -side left
		pack $w.$i.entry -side left -fill x -expand 1 -padx 8
	}
	$w.name.label config -text rtpName:
	$w.email.label config -text rtpEmail:
	pack $w.msg -pady 10
	pack $w.name $w.email -side top -fill x
	$w.$i.entry insert 0 [email_heuristic]
	frame $w.buttons
	button $w.buttons.accept -text Accept -command "set dialogDone 1"
	button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
	pack $w.buttons.accept $w.buttons.dismiss \
		-side left -expand 1 -padx 20 -pady 10
	pack $w.buttons
	pack $w -padx 10
	global dialogDone
	while { 1 } {
		set dialogDone 0
		focus $w.name.entry
		tkwait variable dialogDone
		if { $dialogDone < 0 } {
			exit 0
		}
		set name [string trim [$w.name.entry get]]
		if { [string length $name] <= 3 } {
			new ErrorWindow "please enter a reasonable name"
			continue
		}
		set email [string trim [$w.email.entry get]]
		if { [string first . $email] < 0 || \
			[string first @ $email] < 0 } {
			new ErrorWindow "email address should have form user@host.domain"
			continue
		}
		break
	}
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open [file join $mash prefs] a+ 0644]
	puts $f "rtpName: $name"
	puts $f "rtpEmail: $email"
	close $f
	pack forget $w
	destroy $w
}
RTPApplication public check_rtp_sdes {} {
	set name [$self get_option rtpName]
	if { $name == "" } {
		set name [$self get_option sessionName]
		option add *rtpName $name startupFile
	}
	set email [$self get_option rtpEmail]
	if { $name == "" || $email == "" } {
		$self run_resource_dialog $name $email
	}
}
RTPApplication private check_hostspec { argv megaSession } {
	if { $argv == "" } {
		if { $megaSession == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 1]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
Class AddressBlock -configuration {
	defaultTTL 1
	maxbw -1
}
Class AddressBlock/RTP -superclass AddressBlock
Class AddressBlock/Simple -superclass AddressBlock
AddressBlock instproc init spec {
	$self next
	$self set nchan_ 0
	foreach s [split $spec ,] {
		set err [$self parse $s]
		if { $err != "" } {
			$self fatal $err
		}
	}
}
AddressBlock instproc data-port p {
	return [expr $p &~ 1]
}
AddressBlock instproc fmt {} {
	$self instvar fmt_
	if [info exists fmt_] { return $fmt_ } else { return "" }
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	$self instvar ttl_
	if [info exists ttl_($k)] { return $ttl_($k) } else { return {} }
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port ($s)"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n==3 && [regexp {^[0-9]+$} $fmt] } {
			set ttl $fmt
			set fmt {}
		}
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" } {
		$self set fmt_ $fmt
	}
	if [info exists confid] {
		$self add_option confid $confid
	}
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 10000000
			} elseif { $ttl <= 64 } {
				set maxbw 4000000
			} elseif  { $ttl <= 128 } {
				set maxbw 1000000
			} elseif { $ttl <= 192 } {
				set maxbw 128000
			} else {
				set maxbw 56000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
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 port_ $rport
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	set result [$dn_ open $addr_ $sport_ $rport_ $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	set cn_ [new Network]
	set result [$cn_ open $addr_ [expr $sport_ + 1] [expr $rport_ + 1] $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	if [info exists dn_] {
		delete $dn_
	}
	if [info exists cn_] {
		delete $cn_
	}
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
		$session_ data-net "" $channel_
		$session_ ctrl-net "" $channel_
	}
}
NetworkLayer instproc notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
	set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
				$sport $rport $ttl $nchan_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar net_
	foreach chan [array names net_] {
		delete $net_($chan)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
Class 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_
    if {[array names focus_set_ $src] == $src} {
        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
SourceLayer/RTP set ntp_ts_sec_ 0
SourceLayer/RTP set ntp_ts_fsec_ 0
SourceLayer/RTP set mts_ 0
SourceLayer/RTP set ref_ntp_sec_ 0
SourceLayer/RTP set ref_ntp_fsec_ 0
SourceLayer/RTP set ref_mts_ 0
Source/RTP public init { sm srcid ssrc addr } {
	$self next $srcid $ssrc $addr
	$self set sm_ $sm
	$self instvar layers_
	set k 0
	set report 0
	if { [$sm info vars network_] != "" } {
		set net [$sm set network_]
		set n [$net set nchan_]
		set report [$net usingRLM]
	} else {
		set n [SourceLayer/RTP set nchan_]
	}
	while { $k < $n } {
		set l [new SourceLayer/RTP]
		lappend layers_ $l
		$self layer $k $l
		incr k
	}
	$self set reportLoss_ $report
}
Source/RTP public destroy {} {
	$self instvar sm_
	foreach layer [$self set layers_] {
		$layer destroy
	}
	if {[$self data-handler] != ""} {
		$self deactivate
	}
	$self unregister
	$sm_ delete $self;
	$self next
}
Source/RTP public getid {} {
	set name [$self sdes name]
	if { $name == "" } {
		set name [$self sdes cname]
		if { $name == "" } {
			set name [$self addr]
		}
	}
	return $name
}
Source/RTP public format_name {} {
	$self instvar sm_
	return [$sm_ rtp_type [$self format]]
}
Class MediaAgent -superclass {SourceManager Observable}
foreach method "unregister activate deactivate \
		trigger_media \
		trigger_format \
		trigger_sdes \
		trigger_idle \
		trigger_sr \
		notify" {
	Source/RTP public $method {args} \
		"\$self instvar sm_ ; eval \$sm_ $method \$self \$args"
	MediaAgent public $method src "\$self notify_observers $method \$src"
}
MediaAgent public init {} {
	$self next
	$self set sources_ ""
}
MediaAgent public destroy {} {
	$self instvar sources_
	foreach src $sources_ {
		$src destroy;
	}
	$self next
}
MediaAgent public active_list {} {
	$self instvar active_
	if ![info exists active_] {
		return ""
	}
	return [array names active_]
}
MediaAgent public activate src {
	$self instvar active_
	set active_($src) 1
	$self notify_observers activate $src
}
MediaAgent public deactivate src {
	$self instvar active_
	unset active_($src)
	$self notify_observers deactivate $src
}
MediaAgent public unregister src {
	$self notify_observers unregister $src
	$self instvar sources_
	set k [lsearch -exact $sources_ $src]
	set sources_ [lreplace $sources_ $k $k]
}
MediaAgent public attach o {
	$self attach_observer $o
	$self instvar sources_ active_
	foreach s $sources_ {
		$o update register $s
		if [info exists active_($s)] {
			$o update activate $s
			$s enable_trigger
		}
	}
}
MediaAgent public detach o {
	$self detach_observer $o
	$self instvar sources_ active_
	foreach s $sources_ {
		if [info exists active_($s)] {
			$o update deactivate $s
		}
		$o update unregister $s
	}
}
MediaAgent public create-source { srcid ssrc addr srcsess } {
	set s [new Source/RTP $self $srcid $ssrc $addr]
	$s set session_ $srcsess
	$self instvar sources_
	lappend sources_ $s
	return $s
}
Class RTPAgent -superclass MediaAgent -configuration {
	mtu 1024
	loopback 0
	siteDropTime "300"
}
RTPAgent public init {ab {callback {}} } {
	$self next
	$self instvar session_ mtu_ callback_
	if { $callback!={} } { set callback_ $callback }
	set session_ [$self create_session]
	$session_ sm $self
	$session_ buffer-pool [new BufferPool]
	if { $ab != "" } {
		$self reset $ab
	}
	set mtu_ [$self get_option mtu]
	global V
	set V(sm) $self
}
RTPAgent public destroy {} {
	$self instvar session_ network_
	$session_ exit;
	delete $session_
	delete $network_
	$self next
}
RTPAgent public reset_spec spec {
	set ab [new AddressBlock $spec]
	$self reset $ab
	delete $ab
}
RTPAgent public reset ab {
	$self instvar network_ session_ sources_
	if {([catch {$ab info class}]) || ([$ab info class] != "AddressBlock")} {
		$self reset_spec $ab
		return
	}
	if [info exists network_] {
		set old_network $network_
	}
	set old_sources $sources_
	$session_ exit
	set network_ [new NetworkManager $ab $session_ $self]
	$self app_loopback 1
	$self net_loopback [$self get_option loopback]
	set key [$self get_option sessionKey]
	if { $key != "" } {
		$network_ install-key $key
	}
	$self mk_local_source
	$session_ max-bandwidth [expr [$ab set maxbw_(0)]/1000.]
	$self instvar callback_
	if [info exists callback_] {
	    eval $callback_ [list $ab]
	} else {
	    catch {
			set a [Application instance]
			if [catch {$a reset $ab rtp $self}] {
				$a reset $ab
			}
		}
	}
	foreach src $old_sources {
		$src destroy;
	}
	if [info exists old_network] {
		delete $old_network
	}
}
RTPAgent private notify {src layer} {
	$self instvar network_
	if ![$network_ usingRLM] { return }
	$network_ notify-loss $src $layer
}
RTPAgent public stats {} {
	set s [$self set session_]
	return " \
		Bad-RTP-version [$s set badversion_] \
		Bad-RTPv1-options [$s set badoptions_] \
		Bad-Payload-Format [$s set badfmt_] \
		Bad-RTP-Extension [$s set badext_] \
		Runts [$s set nrunt_]"
}
RTPAgent private mk_local_source {} {
	$self instvar network_ session_ local_
	set net [$network_ data-net 0]
	set a [$net addr]
	set srcid [$session_ random-srcid $a]
	set src [$self create-local $srcid [$net interface]]
	set local_ $src
	$self notify_observers register $local_
	set cname [$self get_option cname]
	if { $cname == "" } {
		set interface [$net interface]
		if { $interface == "0.0.0.0" } {
			set interface [$session_ local-addr-heuristic]
		}
		set cname [user_heuristic]@$interface
	}
	$src sdes name [$self get_option rtpName]
	$src sdes email [$self get_option rtpEmail]
	$src sdes loc [$self get_option rtpLoc]
	$src sdes cname $cname
	set tool [Application name]\-[version]
	global tcl_platform
	if {[info exists tcl_platform(os)] && $tcl_platform(os) != "" && \
			$tcl_platform(os) != "unix"} {
		set p $tcl_platform(os)
		if {$tcl_platform(osVersion) != ""} {
			set p $p-$tcl_platform(osVersion)
		}
		if {$tcl_platform(machine) != ""} {
			set p $p-$tcl_platform(machine)
		}
		set tool "$tool/$p"
	}
	$src sdes tool $tool
	return $src
}
RTPAgent public have_network {} {
	$self instvar network_
	return [info exists network_]
}
RTPAgent public have_localsrc {} {
	$self instvar local_
	return [info exists local_]
}
RTPAgent public install-key key {
	$self instvar network_
	if [info exists network_] {
		$network_ install-key $key
	}
}
RTPAgent public network {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [$network_ data-net 0]
}
RTPAgent public session-addr {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] addr]
}
RTPAgent public session-port {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] port]
}
RTPAgent public session-rport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] rport]
}
RTPAgent public session-sport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] sport]
}
RTPAgent public get_local_srcid {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	$self instvar local_
	return [$local_ srcid]
}
RTPAgent public get_transmitter {} {
	return [$self set session_]
}
RTPAgent public session-ttl {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] ttl]
}
RTPAgent public local-name {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	$self instvar local_
	return [$local_ sdes name]
}
RTPAgent public set_local_sdes { which value } {
	$self instvar local_
	$local_ sdes $which $value
}
RTPAgent public crypt_clear {} {
	if [info exists network_] {
		$network_ crypt_clear
	}
}
RTPAgent public shutdown {} {
	$self instvar session_
	$session_ exit
}
RTPAgent public set_maxchannel n {}
RTPAgent public set-bandwidth bps {
	[$self set session_] data-bandwidth $bps
}
RTPAgent public net_loopback enable {
	$self instvar network_
	$network_ loopback $enable
}
RTPAgent public app_loopback enable {
	$self instvar session_
	$session_ set loopback_ $enable
}
RTPAgent public set-bandwidth bps {
	[$self set session_] data-bandwidth $bps
}
Class RTP
Class RTP/Video -superclass RTP
Class RTP/Audio -superclass RTP
RTP private init {} {
	eval $self next
	$self instvar rtp_ptoa_
	set rtp_ptoa_(-1) ""
}
RTP/Audio set default_ptoa_(0) pcm
RTP/Audio set default_ptoa_(1) celp
RTP/Audio set default_ptoa_(2) g721
RTP/Audio set default_ptoa_(3) gsm
RTP/Audio set default_ptoa_(5) dvi
RTP/Audio set default_ptoa_(6) dvi
RTP/Audio set default_ptoa_(7) lpc
RTP/Audio set default_ptoa_(8) pcma
RTP/Audio set default_ptoa_(9) g722
RTP/Audio set default_ptoa_(10) lin16
RTP/Audio set default_ptoa_(11) lin16
RTP/Audio set default_ptoa_(14) mpa
RTP/Audio set default_ptoa_(15) g728
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(25) cellb
RTP/Video set default_ptoa_(26) jpeg
RTP/Video set default_ptoa_(27) cuseeme
RTP/Video set default_ptoa_(28) nv
RTP/Video set default_ptoa_(29) picw
RTP/Video set default_ptoa_(30) cpv
RTP/Video set default_ptoa_(31) h261
RTP/Video set default_ptoa_(32) mpeg
RTP/Video set default_ptoa_(33) mpegs
RTP/Video set default_ptoa_(42) h263+
RTP/Video set default_ptoa_(34) h263
RTP/Audio set default_ptoa_(126) mp3
RTP/Video set default_ptoa_(127) h261v1
RTP/Video set default_ptoa_(50) sc
RTP/Audio public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
	foreach p [array names default_ptoa_] {
		$self add_mapping $p $default_ptoa_($p)
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
}
RTP/Video public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
        set rtp_ptoa_(-1) ""
	foreach p [array names default_ptoa_] {
		set rtp_ptoa_($p) $default_ptoa_($p)
		set rtp_atop_($default_ptoa_($p)) $p
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
	$self instvar classmap_
	set classmap_(pvh) PVH
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
        set classmap_(h263+) H263+
        set classmap_(h263) H263
	set classmap_(sc) SC
}
RTP/Video public classmap type {
	$self instvar classmap_
	if [info exists classmap_($type)] {
		return $classmap_($type)
	}
	return "Null"
}
RTP public add_mapping {pt fmt} {
	$self instvar rtp_ptoa_ rtp_atop_
	set rtp_ptoa_($pt) $fmt
	set rtp_atop_($fmt) $pt
}
RTP public rtp_type pt {
	$self instvar rtp_ptoa_
	if [info exists rtp_ptoa_($pt)] {
		return $rtp_ptoa_($pt)
	} elseif { $pt < 0 }  {
		return ""
	} else {
		return fmt-$pt
	}
}
RTP public rtp_fmt_number fmt {
	$self instvar rtp_atop_
	if [info exists rtp_atop_($fmt)] {
		return $rtp_atop_($fmt)
	} else {
		return -1
	}
}
RTP public rtp_format src {
	$self instvar rtp_ptoa_
	return [$self rtp_type [$src format]]
}
RTP instproc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
RTP public rtp_representation src {
	set fmt [$self rtp_format $src]
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set srcname $addr
			set srcinfo $addr/$fmt
		} else {
			set srcname $cname
			set srcinfo $addr/$fmt
		}
	} elseif [$self cname_redundant $name $cname] {
		set srcname $name
		set srcinfo $addr/$fmt
	} else {
		set srcname $name
		set srcinfo $cname/$fmt
	}
	return "{$srcname} {$srcinfo}"
}
Class Timer
Class Timer/Periodic -superclass Timer
Class Timer/Adaptive -superclass Timer
Class Timer/Adaptive/ConstBW -superclass Timer/Adaptive
Timer public init {} {
	$self next
	$self randomize 0
	$self set randwt_ 1.0
}
Timer public destroy {} {
	$self cancel
	$self next
}
Timer public randomize { {yesno 1} {randwt {}} } {
	if { $randwt!={} } {
		$self set randwt_ $randwt
	}
	if {$yesno=="yes"} {set yesno 1} elseif {$yesno=="no"} {set yesno 0}
	$self set randomize_ $yesno
}
Timer private sched { t } {
	$self msched $t
}
Timer public msched { t } {
	$self instvar id_ randomize_ randwt_
	if [info exists id_] {
		puts stderr "warning: $self ([$self info class]):\
				overlapping timers"
	}
	if $randomize_ {
		set r [expr [random]/double(0x7fffffff)-0.5]
		set t [expr $t+$t*$r*$randwt_]
	}
	set t [expr int($t+0.5)]
	set id_ [after $t "$self do_timeout"]
}
Timer private do_timeout {} {
	$self instvar id_
	if ![info exists id_] {
		puts stderr "warning: $self ($class) no timer id_"
	} else {
		unset id_
	}
	$self timeout
}
Timer public is_sched { } {
	$self instvar id_
	return [info exists id_]
}
Timer public cancel {} {
	$self instvar id_
	if [info exists id_] {
		after cancel $id_
		unset id_
	}
}
Timer/Periodic public init { {period 5000} } {
	$self next
	$self set period_ $period
}
Timer/Periodic public start { {period {}} } {
	$self instvar period_
	if { $period!={} } { set period_ $period }
	if [$self is_sched] { $self cancel }
	$self msched $period_
}
Timer/Periodic instproc do_timeout {} {
	$self instvar period_
	$self next
	if { [info commands $self]=="" } return
	$self msched $period_
}
Timer/Adaptive public init { {interval 5000} } {
	$self next
	$self set interval_ $interval
}
Timer/Adaptive public start {} {
	$self instvar interval_
	if [$self is_sched] { $self cancel }
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive public do_timeout {} {
	$self next
	if { [info commands $self]=="" } return
	$self instvar interval_
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive private adapt {interval} {
	return $interval
}
Timer/Adaptive/ConstBW public init { bw {thresh {}} {size_gain {}} } {
	$self instvar size_gain_ avgsize_ nsrcs_ bw_ thresh_ interval_
	if { $size_gain!={} } {
		set size_gain_ $size_gain
	} else {
		set size_gain_ 0.125
	}
	set avgsize_ 28
	set nsrcs_ 0
	set bw_ $bw
	if { $thresh=={} } {
		set thresh_ 500
	} else {
		set thresh_ $thresh
	}
	$self next $thresh_
}
Timer/Adaptive/ConstBW public threshold { {thresh {}} } {
    $self instvar thresh_
    if {$thresh=={}} {
	return $thresh_
    } else {
	set thresh_ $thresh
    }
}
Timer/Adaptive/ConstBW public bandwidth { {bw {}} } {
    $self instvar bw_
    if {$bw=={}} {
	return $bw_
    } else {
	set bw_ $bw
    }
}
Timer/Adaptive/ConstBW public sample_size { size } {
	$self instvar avgsize_ size_gain_
	set avgsize_ [expr $avgsize_ + $size_gain_ * ($size + 28 - $avgsize_)]
}
Timer/Adaptive/ConstBW public update_nsrcs { nsrcs } {
	$self set nsrcs_ $nsrcs
}
Timer/Adaptive/ConstBW public nsrcs { nsrcs } {
	return [$self set nsrcs_]
}
Timer/Adaptive/ConstBW public incr_nsrcs { {incr 1} } {
        $self instvar nsrcs_
        incr nsrcs_ $incr
}
Timer/Adaptive/ConstBW private adapt {interval} {
	$self instvar avgsize_ bw_ nsrcs_ thresh_
	set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
	if { $t < $thresh_ } {
		return $thresh_
	} else {
		return $t
	}
}
AnnounceListenManager public init { spec {mtu 1500} } {
	$self next $mtu
	$self instvar data_ snet_ rnet_
	set data_ ""
	set snet_ ""
	set rnet_ ""
	if [regexp {^[0-9]*$} $spec] {
		set rnet_ [new Network]
		$rnet_ open $spec
	} else {
		set ab [new AddressBlock/Simple $spec]
		set addr  [$ab addr]
		set sport [$ab sport]
		set rport [$ab rport]
		set ttl   [$ab ttl]
		delete $ab
		set snet_ [new Network]
		if [in_multicast $addr] {
			$snet_ open $addr $sport $rport $ttl
			set rnet_ $snet_
		} else {
			if { $rport != 0 } {
				set rnet_ [new Network]
				$rnet_ open $rport
			}
			$snet_ open $addr $sport 0 1
		}
	}
	if { $snet_ != "" } {
		$snet_ loopback 1
		$self send_network $snet_
	}
	if { $rnet_ != "" } {
		$self recv_network $rnet_
	}
}
AnnounceListenManager public destroy {} {
	$self instvar snet_ rnet_ timers_
	if { $rnet_==$snet_ } {
		delete $snet_
	} else {
		if { $snet_ != "" } {
			delete $snet_
		}
		if { $rnet_ != "" } {
			delete $rnet_
		}
	}
	if [info exists timers_] {
		foreach t [array names timers_] {
			delete $timers_($t)
		}
	}
	$self next
}
AnnounceListenManager public timer {args} {
	$self instvar timers_
	if {[llength $args]==1} {
		set d __default_timer__
		set t [lindex $args 0]
		if {$t!={}} { $t proc timeout { } "$self send_announcement" }
	} else {
		set d [lindex $args 0]
		set t [lindex $args 1]
		if {$t!={}} { $t proc timeout { } \
				[list $self send_announcement $d] }
	}
	if [info exists timers_($d)] {
		set sched [$timers_($d) is_sched]
		delete $timers_($d)
	} else {
		set sched 0
	}
	if {$t!={}} {
		set timers_($d) $t
		if $sched {
			$t start
		}
	} else {
		catch {unset timers_($d)}
	}
	return $t
}
AnnounceListenManager public get_timer {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		set d __default_timer__
	} else {
		set d [lindex $args 0]
	}
	if [info exists timers_($d)] { return $timers_($d) } else { return "" }
}
AnnounceListenManager public start {args} {
	if { [llength $args]==0 } {
		set t [$self get_timer]
	} else {
		set d [lindex $args 0]
		set t [$self get_timer $d]
	}
	if { $t=={} } {
		set t [new Timer/Periodic]
		$t randomize 1
		if [info exists d] { $self timer $d $t } else { $self timer $t}
	}
	if [info exists d] {$self send_announcement $d} \
			else {$self send_announcement}
	$t start
}
AnnounceListenManager public stop {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		foreach d [array names timers_] {
			$timers_($d) cancel
		}
	} else {
		set d [lindex $args 0]
		$timers_($d) cancel
	}
}
AnnounceListenManager public recv_announcement { addr port data len } {
	puts "ALM::recv_announcement $addr/$port \[$len\]: $data"
}
AnnounceListenManager public send_announcement {args} {
	$self instvar data_
	if {[llength $args]==0} {
		if { $data_!={} } { $self announce $data_ }
	} else {
		$self announce [lindex $args 0]
	}
}
AnnounceListenManager public set_announcement { data } {
	$self set data_ $data
}
AnnounceListenManager public get_announcement { } {
	return [$self set data_]
}
AnnounceListenManager public ttl {num} {
	$self instvar snet_
	$snet_ ttl $num
}
Class AnnounceListenManager/AS -superclass AnnounceListenManager
AnnounceListenManager/AS instproc init { netspec bw atype } {
	random 0
	$self next $netspec 1024
	$self instvar atype_
	set atype_ $atype
	$self instvar agentbytype_
	set agentbytype_(srv) ""
	set agentbytype_(client) ""
	set agentbytype_(hm) ""
	set t [new Timer/Adaptive/ConstBW $bw 3000]
	$t randomize
        $self timer $t
	set o [$self options]
	$o add_default startupWait 60
	$self instvar aliveid_
	set aliveid_ [after [expr [$self get_option startupWait]*1000] "$self check_alive 1"]
}
AnnounceListenManager/AS proc version {} {
	return 2.0
}
AnnounceListenManager/AS public send_announcement {} {
	$self instvar atype_
	set o "ASCP v[$class version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n [$self service_name]
	set o $o\n$n
	set n [$self service_location]
	set o $o\n$n
	set n [$self service_instance]
	set o $o\n$n
	set n [$self ssg_port]
	set o $o\n$n
	set n [$self agent_data]
	set o $o\n$n
	$self announce $o
	$self check_alive 0
}
AnnounceListenManager/AS instproc announce_death {} {
	$self instvar id1_ id2_ atype_
	set o "ASCP v[AnnounceListenManager/AS version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n bye
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	$self announce $o
}
AnnounceListenManager/AS public agent_instance {} {
	return "[pid]@[lookup_host_name [localaddr]]"
}
AnnounceListenManager/AS public agent_data {} {
	return ""
}
AnnounceListenManager/AS public ssg_port {} {
	return "-"
}
AnnounceListenManager/AS instproc service_location {} {
	return "-"
}
AnnounceListenManager/AS instproc destroy {} {
	$self instvar aliveid_
	after cancel $aliveid_
	$self next
}
AnnounceListenManager/AS instproc recv_announcement { addr port data size } {
	$self instvar lastann_ sdp_ agentbytype_ agenttab_ atype_
        set t [$self get_timer]
	$t sample_size $size
	set o [split $data \n]
	if { [lindex $o 0] != "ASCP v[$class version]" } {
		set msg "$self ($class): received non-ASCP v[$class version] announcement from $addr."
		if { $atype_ == "hm" } {
			$self instvar agent_
			$agent_ log $msg
		} else {
			puts stderr $msg
		}
 		return
	}
	set atype [lindex $o 1]
	set aspec [lindex $o 2]
	set srv_name [lindex $o 3]
	set srv_loc [lindex $o 4]
	set srv_inst [lindex $o 5]
	set ssg_port [lindex $o 6]
	set ad [join [lrange $o 7 end] \n]
	if { $srv_name == "DEATH" } {
		set msg "Received death packet from $aspec at $addr - exiting."
		if { $srv_loc == $atype_ } {
			if { $atype_ == "hm" } {
				$self instvar agent_
				$agent_ log $msg
			} else {
				puts stderr $msg
			}
			$self announce_death
			exit 0
		}
		$self recv_msg $atype $aspec $addr DEATH $srv_loc \
			$srv_inst $ssg_port "$ad"
		return
	}
	if { $srv_name == "bye" } {
		$self delete_agent $aspec
		return
	}
	if ![info exists agenttab_($aspec)] {
		$self instvar avgdelta_
		$self register $atype $aspec $addr $srv_name $srv_inst "$ad"
	        $t incr_nsrcs
		set timeout [$self get_option startupWait]
		set avgdelta_($aspec) [expr $timeout / 8]
		lappend agentbytype_($atype) $aspec
	} else {
		set now [gettimeofday]
		set delta [expr $now - $lastann_($aspec,abs)]
		$self instvar avgdelta_
		set avgdelta_($aspec) \
				[expr 0.875*$avgdelta_($aspec)+0.125*$delta]
	}
	set agenttab_($aspec) "$addr {$ad} $atype $srv_name $srv_inst"
	set lastann_($aspec,abs) [gettimeofday]
	set lastann_($aspec,ascii) [gettimeofday ascii]
	$self recv_msg $atype $aspec $addr $srv_name $srv_loc $srv_inst \
			$ssg_port "$ad"
}
AnnounceListenManager/AS instproc advance_timers { delta } {
	$self instvar lastann_ agenttab_ avgdelta_
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann_($aspec,abs) [expr $lastann_($aspec,abs)+$delta]
	}
}
AnnounceListenManager/AS instproc check_alive { timer } {
	$self instvar lastann_ agenttab_ avgdelta_
	set now [gettimeofday]
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann $lastann_($aspec,abs)
		set avgdelta $avgdelta_($aspec)
		set delta [expr $now - $lastann]
		if { $delta > 8 * $avgdelta } {
			$self delete_agent $aspec
		}
	}
	$self instvar aliveid_
	if { $timer } {
		set t [expr [$self get_option startupWait]*1000]
		set aliveid_ [after $t "$self check_alive 1"]
	}
}
AnnounceListenManager/AS instproc delete_agent { aspec } {
 	$self instvar agentbytype_ agenttab_ lastann_ avgdelta_
	if ![info exists agenttab_($aspec)] {
		return
	}
	set a $agenttab_($aspec)
	set addr [lindex $a 0]
	set ad [lindex $a 1]
	set atype [lindex $a 2]
	set srv_name [lindex $a 3]
	set srv_inst [lindex $a 4]
	unset agenttab_($aspec)
	unset lastann_($aspec,abs)
	unset lastann_($aspec,ascii)
	unset avgdelta_($aspec)
	set t $agentbytype_($atype)
	set i [lsearch -exact $t $aspec]
	set agentbytype_($atype) [lreplace $t $i $i]
	[$self get_timer] incr_nsrcs -1
	$self unregister $atype $aspec $addr $srv_name $srv_inst "$ad"
}
AnnounceListenManager/AS instproc agenttab aspec {
	$self instvar agenttab_
	if [info exists agenttab_($aspec)] {
		return $agenttab_($aspec)
	}
	return ""
}
Class AnnounceListenManager/AS/Client -superclass AnnounceListenManager/AS
AnnounceListenManager/AS/Client public init { spec bw srv_loc } {
	$self next $spec $bw client
	$self instvar srv_inst_ srv_loc_
	set srv_loc_ $srv_loc
}
AnnounceListenManager/AS/Client public service_location { } {
	$self instvar srv_loc_
	return $srv_loc_
}
AnnounceListenManager/AS/Client private recv_msg { atype aspec addr srv_name \
	        srv_loc srv_inst ssg_port msg } {
}
Class SDPParser
Class SDPMedia
Class SDPTime
Class SDPMessage
SDPParser instproc init { {ordered_syntax 1} } {
	$self next
	$self instvar nextsym_ ordered_syntax_ parse_error_
	set nextsym_(start) "v"
	set nextsym_(v) "o"
	set nextsym_(o) "s"
	set nextsym_(s) "i u e p c b t"
	set nextsym_(i) "u e p c b t"
	set nextsym_(u) "e p c b t"
	set nextsym_(e) "e p c b t"
	set nextsym_(p) "e p c b t"
	set nextsym_(c) "b t "
	set nextsym_(b) "t"
	set nextsym_(t) "t r z k a m"
	set nextsym_(r) "t z k a m"
	set nextsym_(z) "k a m"
	set nextsym_(k) "a m"
	set nextsym_(a) "a m"
	set nextsym_(m) "m i:m c:m b:m k:m a:m v"
	set nextsym_(i:m) "m c:m b:m k:m a:m v"
	set nextsym_(c:m) "m b:m k:m a:m v"
	set nextsym_(b:m) "m k:m a:m v"
	set nextsym_(k:m) "m a:m v"
	set nextsym_(a:m) "m a:m v"
	set ordered_syntax_ $ordered_syntax
	set parse_error_ ""
}
SDPParser instproc check_syntax { last cur media } {
	$self instvar nextsym_
	if ![info exists nextsym_($last)] {
		return ""
	}
	foreach s $nextsym_($last) {
		set t [split $s :]
		if { [lindex $t 0] == $cur } {
			return $s
		}
	}
	return ""
}
SDPParser instproc parse { announcement } {
	$self instvar parse_error_ ordered_syntax_
	set media ""
	set allmsgs ""
	set lasttag "start"
	set lines [split $announcement "\n"]
	set parse_error_ ""
	set lnum 0
	foreach line $lines {
		incr lnum
		set line [string trimright $line]
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v {
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			if {![info exists msg]} {
				set media ""
				set msg [new SDPMessage]
				lappend allmsgs $msg
				$msg set version_ 0
				set tmp [$msg set msgtext_]
				lappend tmp "v=0"
				$msg set msgtext_ $tmp
			}
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {
			$msg set session_name_ $value
		}
		i {
			if { $media != "" } {
				$media set session_info_ $value
			} else {
				$msg set session_info_ $value
			}
		}
		p {
			set tmp ""
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e {
			set tmp ""
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u {
			$msg set uri_ $value
		}
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $attval]]
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" && [regexp {[icbka]} $tag] } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append tmp \n
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { {single_line 0} } {
    set html {}
    if $single_line { set t time1 } else { set t time }
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
			    [DynamicHTMLifier set html_(${t}_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } elseif { $varname == "spec_" } {
	    set caddr [split [$self get caddr_] /]
	    set port [$self get port_]
	    set spec [lindex $caddr 0]/$port
	    set ttl [lindex $caddr 1]
	    if { $ttl != {} } { append spec /$ttl }
	    return $spec
    } else {
	return ""
    }
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type {numonly 0} } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } elseif $numonly {
	return [clock format $sec -format {%m/%d/%y}]
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
Class MeGa
MeGa instproc init args {
	eval $self next $args
	$self set sdp_ [new SDPParser]
}
MeGa instproc destroy {} {
	$self instvar sdp_
	delete $sdp_
	$self next
}
MeGa proc ctrlchan { media spec } {
	set tmp [split $spec /]
	set addr [lindex $tmp 0]
	if ![in_multicast $addr] {
		return $spec
	}
	set port [lindex $tmp 1]
	switch $media {
	video {
		incr port 2
	}
	audio {
		incr port 4
	}
	mb {
		incr port 6
	}
	sdp {
		incr port 8
	}
	hm {
		incr port 10
	}
	}
	set ttl [lindex $tmp 2]
	return $addr/$port/$ttl
}
Class AnnounceListenManager/AS/Client/MeGa \
		-superclass { AnnounceListenManager/AS/Client MeGa }
Class AnnounceListenManager/AS/Client/MeGa/Audio \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Audio }
Class AnnounceListenManager/AS/Client/MeGa/Video \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Video }
AnnounceListenManager/AS/Client/MeGa instproc init { agent spec bw toolname media sname sspec rportspec ofmt srv_loc } {
	set spec [MeGa ctrlchan $media $spec]
	$self next $spec $bw $srv_loc
	$self instvar agent_ toolname_ sname_ sspec_ media_ rportspec_ ofmt_
	set toolname_ $toolname
	set media_ $media
	set sname_ $sname
	set sspec_ $sspec
	set rportspec_ $rportspec
	set ofmt_ $ofmt
	set agent_ $agent
	$self instvar srv_inst_
	[$self get_timer] threshold 15000
	set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc reset_spec {sspec} {
    $self instvar sspec_ srv_inst_ index_
    set sspec_ $sspec
    set rand [random]
    set index_ $rand
    set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc recv_msg { atype aspec addr srv_name srv_loc srv_inst ssg_port msg } {
	if { $atype != "srv" } {
		return
	}
	$self instvar agent_ srv_inst_
	if { $srv_inst_ != $srv_inst } {
		return
	}
	$self instvar sdp_
	set msg [$sdp_ parse $msg]
	if { $msg == "" } {
		return
	}
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set curspec $addr/$sport:$rport/$ttl
	} else {
		set curspec ""
		set ttl -1
	}
	set media [$msg set allmedia_]
	$self instvar media_ rportspec_
	foreach mrec [$msg set allmedia_] {
		if [$mrec have_attr global] {
			continue
		}
		set tmp [split [$mrec set caddr_] /]
		set laddr [lindex $tmp 0]
		set lttl [lindex $tmp 1]
		set pspec [split [$mrec set port_] :]
		set sport [lindex $pspec 0]
		set rport [lindex $pspec 1]
		set myrport [lindex [split $rportspec_ :] 0]
		if { ([in_multicast $laddr] && $myrport == 0) || \
		     ($laddr == [localaddr] && $sport == $myrport) } {
	     		if { ![in_multicast $laddr] } {
				set laddr [$msg set createaddr_]
			}
	     		set newspec $laddr/$rport:$sport/$lttl
			if { $newspec != $curspec } {
				set fmt [$mrec set fmt_]
				set fmt [$self format_name $fmt]
				if { $fmt == "" } {
					set fmt null
				}
				$agent_ reset_spec \
						$laddr/$rport:$sport/$fmt/$lttl
				$self send_announcement
			}
			delete $msg
	     		return
		}
	}
	delete $msg
}
AnnounceListenManager/AS/Client/MeGa private format_name { fmt } {
	return ""
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Video private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc register { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa instproc unregister { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa public agent_data {} {
	$self instvar id1_ id2_ agent_ media_ agent_ sname_ sspec_ \
		toolname_ rportspec_ ofmt_
	set o "v=0"
	set n "o=client [pid] 0 IN IP4 [localaddr]"
	set o $o\n$n
	set n "s=$sname_"
	set o $o\n$n
	set n "c=IN IP4 $sspec_"
	set o $o\n$n
	if { $media_ == "video" } {
		set n "b=AS:[$agent_ set sessionbw_]"
		puts "!!SESSIONBW $n"
		set o $o\n$n
		set n "t=0 0"
		set o $o\n$n
		if { [$self get_option localScubaScope] != "" } {
			set n "a=localscuba"
			set o $o\n$n
		}
	} else  {
		set n "t=0 0"
		set o $o\n$n
	}
	set n "a=tool:$toolname_"
	set o $o\n$n
	set fmt [$self format_num $ofmt_]
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	set n "m=$media_ $rport RTP/AVP $fmt"
	set o $o\n$n
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set n "c=IN IP4 $addr/$sport:$rport/$ttl"
	} else {
		set n "c=IN IP4 none"
	}
	set o $o\n$n
	return $o
}
AnnounceListenManager/AS/Client/MeGa private format_num { fmt } {
	return -1
}
AnnounceListenManager/AS/Client/MeGa/Video private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc service_name {} {
	return MeGa
}
AnnounceListenManager/AS/Client/MeGa instproc service_instance {} {
	$self instvar sname_ rportspec_ media_ index_
	set o $sname_:$media_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		set o $o:[localaddr]/$rport
	    if {[info exists index_]} {
		set o $o:$index_
	    }
	}
	return $o
}
AnnounceListenManager/AS/Client/MeGa instproc agent_instance {} {
    $self instvar index_
    if {[info exists index_]} {
	return "[pid]@[lookup_host_name [localaddr]]:$index_"
    } else {
	return "[pid]@[lookup_host_name [localaddr]]"
    }
}
AnnounceListenManager/AS/Client/MeGa instproc ssg_port {} {
	$self instvar rportspec_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		return [lindex $rportspec 1]
	} else {
		return "-"
	}
}
Module/VideoDecoder/PVH set maxChannel_ 0
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 {}}} {
	$self set myhandler_ $app
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
		set fmt [$ab fmt]
		if { $fmt != {} } { $self add_option videoFormat $fmt }
	} else {
		set ab ""
	}
	$self next $ab $callback
	if { $ab != "" } {
		delete $ab
	}
	$self site-drop-time [$self get_option siteDropTime]
	$self instvar decoders_
	set decoders_ ""
	set localbw [$app get_option videoSessionBW]
	if { $localbw == "" } {
		set localbw [$app get_option maxVideoSessionBW]
	}
	$self sessionbw $localbw
	$self start_mega
}
VideoAgent public destroy { } {
	$self instvar al_
	if [info exists al_] { delete $al_ }
	$self next
}
VideoAgent public start_mega { } {
	$self instvar al_ myhandler_
	if [info exists al_] { delete $al_ }
	if { [$myhandler_ get_option megaVideoSession] != "" } {
		set sname [$myhandler_ get_option megaVideoSession]
		set sspec [$self get_option videoSessionSpec]
		set rportspec [$self get_option megaRecvVideoPort]
		set ofmt [$self get_option megaVideoFormat]
		set localbw [$myhandler_ get_option videoSessionBW]
		if { $localbw == "" } {
			set localbw [$myhandler_ get_option maxVideoSessionBW]
		}
		set bw [expr 0.02*$localbw]
		set megaspec [$self get_option megaVideoCtrl]
		set loc [$self get_option videoServiceLocation]
		set ab [new AddressBlock $sspec]
		set sspec [$ab addr]/[$ab sport]:[$ab rport]/[$ab ttl]
		delete $ab
		set al_ [new AnnounceListenManager/AS/Client/MeGa/Video \
				$self $megaspec $bw [Application name] video \
				$sname $sspec $rportspec $ofmt $loc]
	        $al_ start
	}
}
VideoAgent public video_handler {} { return [$self set myhandler_] }
VideoAgent public reset_mega {} {
	$self instvar al_
	if ![info exists al_] {
		$self start_mega
	} else {
		$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 data-handler $d
	$self next $src
}
VideoAgent public deactivate src {
	$self instvar decoders_
	set d [$src data-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_ notify_observers 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/VideoEncoder/Pixel/PVH set pt_ 0
Module/VideoEncoder set nb_ 0
Module/Framer/JPEG 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
	}
	$self instvar norm_
	if [info exists norm_] {
		unset norm_
	}
}
VideoTap public close {} {
	$self instvar grabber_ capwin_
	$self stop
	if [info exists grabber_] {
		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_] {
			return "VideoTap::start: device is not openned"
		}
		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_
	}
	$self instvar norm_
	if [info exists norm_] {
		$grabber_ norm $norm_
	}
	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
	}
}
VideoTap instproc set_norm n {
	$self instvar grabber_ norm_
	set norm_ $n
	if [info exists grabber_] {
		$grabber_ norm $n
	}
}
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 destroy {} {
	$self instvar tap_ bufferPool_
	$self release_device
	if [info exists bufferPool_] {
		$bufferPool_ destroy
	}
	$tap_ destroy
	$self next
}
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 {}}} {
	$self instvar tap_
	if {[llength $args] == 0} {
		return [$tap_ set bps_]
	}
	return [eval $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_} {
		if { 0 } {
			set err [$self hwopen $device_ $format_]
		} else {
			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 set_norm args {
	return [eval [$self set tap_] set_norm $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 device {
	set sizes [$device get_attribute size]
	set formats [$device 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 h263+ h263"
	}
	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 public 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_ device_ format_ initialized_
	set running [$tap_ running]
	set err ""
	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 public 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 public switch_session session {
	$self instvar tap_ encoder_ bufferPool_ session_ running_
	if [$tap_ set running_] {
		set restart 1
		$self stop
	} else {
		set restart 0
	}
	set session_ $session
	if ![info exists bufferPool_] {
		set bufferPool_ [new BufferPool/RTP]
	}
	$bufferPool_ srcid [$session_ get_local_srcid]
	$encoder_ target [$session_ get_transmitter]
	if {$restart == 1} {
		$self start
	}
}
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 private 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 private setq_h263+ value {
	set value [expr int((1 - $value / 100.) * 29) + 1]
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
VideoPipeline private setq_h263 value {
	set value [expr int((1 - $value / 100.) * 29) + 1]
	$self instvar encoder_
	if [info exists encoder_] {
		$encoder_ q $value
	}
	return $value
}
VideoPipeline private 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 private 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
}
VideoPipeline private send_full_intra_frame { } {
	$self instvar tap_
	$tap_ send_full_intra_frame
}
VideoTap private send_full_intra_frame { } {
	$self instvar grabber_
	$grabber_ send_full_intra_frame
}
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 {
	megaAudioFormat gsm
	megaRecvAudioPort 0
	audioSessionBW 20
	megaAudioCtrl 224.4.5.24/50000/31
	audioServiceLocation urn:agw
}
AudioAgent public init { app spec {callback {}} } {
        if { $spec != "" } {
		set ab [new AddressBlock $spec]
		set fmt [$ab fmt]
		if { $fmt != {} } { $self add_option audioFormat $fmt }
	} else {
		set ab ""
	}
	$self next $ab $callback
	if { $ab != "" } {
		delete $ab
	}
	$self set-bandwidth 1280000
	$self site-drop-time [$self get_option siteDropTime]
	$self instvar decoders_ audioDevice_ sampRate use16bit useStereo deviceName
	set decoders_ ""
	$self instvar classmap_
	set classmap_(pcm) PCM
	set classmap_(lpc) LPC
	set classmap_(gsm) GSM
	set classmap_(dvi) ADPCM
	set classmap_(mp3) MP3
	set classmap_(lin16) PCM
	$self instvar session_
	if ![info exists sampRate] {
	    set sampRate 8000
	}
	if ![info exists use16bit] {
	    set use16bit 0
	}
	if ![info exists useStereo] {
	    set useStereo 0
	}
	if ![info exists deviceName] {
	    set audioDevice_ [new AudioStream $session_ $sampRate $use16bit $useStereo]
	} else {
	    set audioDevice_ [new AudioStream $session_ $sampRate $use16bit $useStereo $deviceName]
	}
}
AudioAgent public start_mega { } {
	$self instvar al_
	if [info exists al_] { delete $al_ }
	if { [$self get_option megaAudioSession] != "" } {
		set sname [$self get_option megaAudioSession]
		set sspec [$self get_option audioSessionSpec]
		set rportspec [$self get_option megaRecvAudioPort]
	        set ofmt [$self get_option megaAudioFormat]
		set sbw [$self get_option audioSessionBW]
		set bw [expr 0.02*$sbw*1000]
		set megaspec [$self get_option megaAudioCtrl]
	        set loc [$self get_option audioServiceLocation]
		set ab [new AddressBlock $sspec]
		set sspec [$ab addr]/[$ab sport]:[$ab rport]/[$ab ttl]
		delete $ab
		set al_ [new AnnounceListenManager/AS/Client/MeGa/Audio \
				$self $megaspec $bw [Application name] audio \
				$sname $sspec $rportspec $ofmt $loc]
		$al_ start
	}
}
AudioAgent public destroy {} {
    $self instvar al_ audioDevice_
    if [info exists audioDevice_] { delete $audioDevice_ }
    if [info exists al_] { delete $al_ }
    $self next
}
AudioAgent public reset_mega {} {
	$self instvar al_
	if ![info exists al_] {
		$self start_mega
	} else {
		$al_ reset_spec [$self get_option audioSessionSpec]
	}
}
AudioAgent private activate src {
	$self instvar decoders_
	set d [$self create_decoder $src]
	lappend decoders_ $d
	$src handler $d
	$self next $src
}
AudioAgent private deactivate src {
	$self instvar decoders_
	set d [$src handler]
	set k [lsearch -exact $decoders_ $d]
	set decoders_ [lreplace $decoders_ $k $k]
	$self next $src
	delete $d
}
AudioAgent instproc trigger_media src {
	$self instvar local_chan_
	if [info exists local_chan_] {
		set cname [$src sdes cname]
		if { "$cname" != "" } {
			$local_chan_ send FOCUS_SPEAKER $cname
		}
	}
	$self next $src
}
AudioAgent instproc attach_local_channel lc {
        $self set local_chan_ $lc
}
AudioAgent instproc attach_global_channel gc {
        $self set glob_chan_ $gc
}
AudioAgent private set_maxchannel n {
	global active
	foreach s [array names active] {
		set d [$s handler]
		$d set maxChannel_ $n
	}
}
AudioAgent public create_decoder src {
    $self instvar classmap_ audioDevice_
    if ![info exists classmap_([$src format_name])] {
	set decoder [new Module/AudioDecoder/Null]
    } else {
	set decoder [new Module/AudioDecoder/$classmap_([$src format_name])]
    }
    if { $decoder == "" } {
	set decoder [new Module/AudioDecoder/Null]
    }
    set controller [$audioDevice_ get_controller]
    if { $controller == 0 } {
	puts stderr "AudioAgent: no audio controller."
	exit 0
    }
    $decoder set agent_ $self
    $decoder set src_ $src
    $decoder controller $controller
    $src handler $decoder
    return $decoder
}
AudioAgent private create_session {} {
	return [new Session/RTP/Audio]
}
AudioAgent public reset ab {
	$self next $ab
	$self app_loopback 0
	$self net_loopback [$self get_option loopback]
	$self set-bandwidth 128000
	$self instvar set_pool_srcid_
	if ![info exists set_pool_srcid_] {
	    set set_pool_srcid_ 1
	}
}
AudioAgent instproc reset_source_offsets {} {
	$self instvar decoders_
	foreach d $decoders_ {
		$d reset-offset
	}
}
AudioAgent public bind_transducer { which o } {
    $self instvar audioDevice_
    $audioDevice_ bind_transducer $which $o
}
AudioAgent public have_audio {} {
	$self instvar audioDevice_
	if [info exists audioDevice_] {
		return [$audioDevice_ have_audio]
	}
	return 0
}
AudioAgent public set_input_mute val {
    $self instvar audioDevice_
    $audioDevice_ set_input_mute $val
}
AudioAgent public set_output_mute val {
    $self instvar audioDevice_
    $audioDevice_ set_output_mute $val
}
AudioAgent public get_input_ports {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_input_ports]
}
AudioAgent public get_output_ports {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_output_ports]
}
AudioAgent public is_halfduplex {} {
    $self instvar audioDevice_
    return [$audioDevice_ is_halfduplex]
}
AudioAgent public get_input_portno { } {
    $self instvar audioDevice_
    return [$audioDevice_ get_input_portno]
}
AudioAgent public get_output_portno { } {
    $self instvar audioDevice_
    return [$audioDevice_ get_output_portno]
}
AudioAgent public set_speakerphone { port mode } {
    $self instvar audioDevice_
    $audioDevice_ set_speakerphone $port $mode
}
AudioAgent public audio_test type {
    $self instvar audioDevice_
    $audioDevice_ audio_test $type
}
AudioAgent public port_name_to_num { which name } {
    $self instvar audioDevice_
    return [$audioDevice_ port_name_to_num $which $name]
}
AudioAgent public set_input_port port {
    $self instvar audioDevice_
    $audioDevice_ set_input_port $port
}
AudioAgent public set_output_port port {
    $self instvar audioDevice_
    $audioDevice_ set_output_port $port
}
AudioAgent public set_input_gain gain {
    $self instvar audioDevice_
    return [$audioDevice_ set_input_gain $gain]
}
AudioAgent public set_output_gain gain {
    $self instvar audioDevice_
    return [$audioDevice_ set_output_gain $gain]
}
AudioAgent public get_input_gain {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_input_gain]
}
AudioAgent public get_output_gain {} {
    $self instvar audioDevice_
    return [$audioDevice_ get_output_gain]
}
AudioAgent public is_active {} {
    $self instvar audioDevice_
    return [$audioDevice_ is_active]
}
AudioAgent public clear_active {} {
    $self instvar audioDevice_
    $audioDevice_ clear_active
}
AudioAgent public select_format { fmt BlksPerPkt } {
    $self instvar audioDevice_
    $audioDevice_ select_format $fmt $BlksPerPkt
}
AudioAgent public set_silence_thresh thresh {
    $self instvar audioDevice_
    $audioDevice_ set_silence_thresh $thresh
}
AudioAgent public release {} {
    $self instvar audioDevice_
    $audioDevice_ release
}
AudioAgent public obtain {} {
    $self instvar audioDevice_
    $audioDevice_ obtain
}
AudioAgent instproc unix_time {} {
    $self instvar audioDevice_
    set controller [$audioDevice_ get_controller]
    if { $controller == 0 } {
	return 0
    }
    return [$controller unix_time]
}
AudioAgent instproc ntp_time {} {
    $self instvar audioDevice_
    set controller [$audioDevice_ get_controller]
    if { $controller == 0 } {
	return 0
    }
    return [$controller ntp_time]
}
Class AudioStream -configuration {
    inputGain 32
    outputGain 180
    maxPlayout 6
    mikeAGCLevel 0
    speakerAGCLevel 0
    echoSuppressTime 400
}
AudioStream public init { session sampRate use16bitPCM useStereo {deviceName {}} } {
    $self instvar bufferPool_ session_ silenceThresh_ audioTest_ sampleRate_ use16bitPCM_ useStereo_
    set silenceThresh_ 20
    set audioTest_ none
    set session_ $session
    set sampleRate_ $sampRate
    set use16bitPCM_ $use16bitPCM
    set useStereo_ $useStereo
    $self compute_controller_defaults
    if ![info exists bufferPool_] {
	set bufferPool_ [new BufferPool/RTP]
    }
    set devList [$self device_list]
    if { $devList == "" } {
	$self fatal "no suitable audio device found."
    }
    if { $deviceName != "" } {
	set d $deviceName
    } else {
	foreach d $devList {
	    if { "$d" != "AF" } {
		break
	    } elseif [$self yesno useAF] {
		break
	    }
	}
    }
    $self open_device $d
    $self select_format PCM 2
    $self set_input_mute 1
    $self set_output_mute 0
    $self set_output_gain 5
    if ![$self have_audio] {
	$self obtain
    }
}
AudioStream public get_controller { } {
    $self instvar controller_
    if [info exists controller_] {
	return $controller_
    }
    return 0
}
AudioStream public destroy {} {
    $self instvar bufferPool_
    if [info exists bufferPool_] {
	delete $bufferPool_
    }
    $self close_device
}
AudioStream private compute_controller_defaults {} {
    $self instvar sampleRate_ use16bitPCM_ useStereo_
	set AUDIO_SPS [expr $sampleRate_ * [expr 1 + $useStereo_]]
	set TALK_LEAD 4
	set TALK_TAIL 32
	set AUDIO_FRAMESIZE 160
	set SS_GRANULARITY 1440
	set v [expr [$self get_option maxPlayout] * $AUDIO_SPS]
	if [expr $v < ($TALK_LEAD + $TALK_TAIL + 2) * $AUDIO_FRAMESIZE] {
		set w [expr (($TALK_LEAD + $TALK_TAIL + 2) * \
			$AUDIO_FRAMESIZE + $AUDIO_SPS - 1) / $AUDIO_SPS]
		puts stderr "max playout delay $v too short - using $w sec"
		set v [expr ($TALK_LEAD + $TALK_TAIL + 2) * $AUDIO_FRAMESIZE]
	}
	set v [expr ($v + ($SS_GRANULARITY - 1)) / $SS_GRANULARITY]
	set v [expr $v * $SS_GRANULARITY / $AUDIO_FRAMESIZE]
	AudioController set max_playout_ $v
	AudioController set echo_suppress_time_ [expr \
		[$self get_option echoSuppressTime] / 20 * $AUDIO_FRAMESIZE]
}
AudioStream public select_format { fmt blksPerPkt } {
	$self instvar encoder_ bufferPool_ session_ \
			controller_ blksPerPkt_
	if [info exists encoder_] {
		delete $encoder_
	}
	set encoder_ [new Module/AudioEncoder/$fmt]
	set blksPerPkt_ $blksPerPkt
	if [info exists controller_] {
		$controller_ encoder $encoder_
		$controller_ blocks-per-packet $blksPerPkt
	}
	if { "$encoder_" == "" } {
		return -1
	}
	$encoder_ target $session_
	$encoder_ buffer-pool $bufferPool_
	return 0
}
AudioStream public device_list {} {
    if ![TclObject is-class Audio] {
	return ""
    }
    set temp [Audio info subclass]
    set ix [lsearch -exact $temp Audio/RealAudioVirtualDevice]
    if {$ix >= 0} {
	return [lreplace $temp $ix $ix]
    } else {
	return $temp
    }
}
AudioStream public bind_transducer { which o } {
    $self instvar meter_ controller_
    set meter_($which) $o
    if [info exists controller_] {
	$controller_ $which-meter $o
    }
}
AudioStream private open_device dev {
	$self instvar audio_ meter_ controller_ silenceThresh_ sampleRate_ use16bitPCM_ useStereo_
	if [info exists audio_] {
		delete $audio_
		unset audio_
	}
	if [info exists controller_] {
		delete $controller_
		unset controller_
	}
	set audio_ [new $dev]
	if { $dev == "Audio/OSS" } {
	    $audio_ set_sample_rate $sampleRate_
	    if { $use16bitPCM_ == 1 } {
		$audio_ useRaw16PCM
	    }
	    if { $useStereo_ == 1 } {
		puts "setting card to do stereo sound"
		$audio_ useStereo
	    }
	}
	$self instvar gain_
	set names [$self get_input_ports]
	foreach port $names {
		if {[$self get_option $port\Gain]!={}} {
			set gain_($port) [$self get_option $port\Gain]
		} else {
			set gain_($port) [$self get_option inputGain]
		}
	}
	set names [$self get_output_ports]
	foreach port $names {
		if {[$self get_option $port\Gain]!={}} {
			set gain_($port) [$self get_option $port\Gain]
		} else {
			set gain_($port) [$self get_option outputGain]
		}
		$self set_speakerphone $port [$self get_option $port\Mode]
	}
	$self instvar port_
	set port_(input) ""
	set port_(output) ""
}
AudioStream private install_controller {} {
	$self instvar audio_ encoder_ blksPerPkt_ silenceThresh_ meter_ \
		controller_
	if [$audio_ set duplex_] {
		set duplex FullDuplex
	} else {
		set duplex HalfDuplex
		if ![$self have_audio] {
			$self obtain 0
		}
		if { [$self yesno forceFullDuplex] || [$audio_ set duplex_] } {
			set duplex FullDuplex
		}
	}
	set controller_ [new AudioController/$duplex]
	$controller_ audio $audio_
	if [info exists meter_(input)] {
		$controller_ input-meter $meter_(input)
	}
	if [info exists meter_(output)] {
		$controller_ output-meter $meter_(output)
	}
	$controller_ silence-thresh $silenceThresh_
	if [info exists encoder_] {
		$controller_ encoder $encoder_
		$controller_ blocks-per-packet $blksPerPkt_
	}
	$controller_ agc-input [$self get_option mikeAGCLevel]
	$controller_ agc-output [$self get_option speakerAGCLevel]
	$controller_ silence-thresh [$self get_option silenceThresh]
}
AudioStream public obtain { {should_install_controller 1} } {
	$self instvar audio_ controller_
	$audio_ obtain
	if [info exists controller_] {
		set cl [$controller_ info class]
		if [string match *FullDuplex* $cl] {
			set duplex 1
		} else {
			set duplex 0
		}
		if { [$audio_ set duplex_] != $duplex } {
			delete $controller_
			unset controller_
		}
	}
	if { ![info exists controller_] && $should_install_controller } {
		$self install_controller
	}
}
AudioStream public release {} {
	[$self set audio_] release
}
AudioStream public set_silence_thresh thresh {
	$self instvar silenceThresh_ controller_
	set silenceThresh_ $thresh
	if [info exists controller_] {
		$controller_ silence-thresh $silenceThresh_
	}
}
AudioStream public have_audio {} {
	$self instvar audio_
	if [info exists audio_] {
		return [$audio_ have]
	}
	return 0
}
AudioStream public set_input_mute val {
	$self instvar audio_
	$audio_ set_input_mute $val
}
AudioStream public set_output_mute val {
	$self instvar audio_
	$audio_ set_output_mute $val
}
AudioStream public get_input_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_input_ports]]
}
AudioStream public get_output_ports {} {
	$self instvar audio_
	return [string tolower [$audio_ get_output_ports]]
}
AudioStream public is_halfduplex {} {
	$self instvar audio_
	return [expr ![$audio_ set duplex_]]
}
AudioStream public get_input_portno { } {
	$self instvar audio_
	return [$audio_ get_input_port]
}
AudioStream public get_output_portno { } {
	$self instvar audio_
	return [$audio_ get_output_port]
}
AudioStream public set_speakerphone { port mode } {
	$self instvar speakerphone_ port_
	set speakerphone_($port) $mode
	if { [info exists port_(output)] && $port == $port_(output) } {
		$self instvar audio_
		$audio_ set_speakerphone $mode
	}
}
AudioStream public audio_test type {
	$self instvar audioTest_ controller_
	$self set audioTest_ $type
	if [info exists controller_] {
		if { $type == "loopback" } {
			$controller_ test_tone none
			$controller_ loopback 1
		} else {
			$controller_ test_tone $type
			$controller_ loopback 0
		}
	}
}
AudioStream private port_name_to_num { which name } {
	set L [$self get_$which\_ports]
	return [lsearch -exact $L $name]
}
AudioStream public set_input_port port {
	$self instvar audio_ port_ gain_ speakerphone_
	set port_(input) $port
	$audio_ set_input_port [$self port_name_to_num input $port]
	$self set_input_gain $gain_($port)
}
AudioStream public set_output_port port {
	$self instvar audio_ port_ gain_ speakerphone_
	set port_(output) $port
	$audio_ set_output_port [$self port_name_to_num output $port]
	$self set_output_gain $gain_($port)
	$self set_speakerphone $port $speakerphone_($port)
}
AudioStream public set_input_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(input)) $gain
	return [$audio_ set_input_gain $gain]
}
AudioStream public set_output_gain gain {
	$self instvar audio_ port_ gain_
	set gain_($port_(output)) $gain
	return [$audio_ set_output_gain $gain]
}
AudioStream public get_input_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(input))
}
AudioStream public get_output_gain {} {
	$self instvar port_ gain_
	return $gain_($port_(output))
}
AudioStream private close_device {} {
    $self instvar audio_ controller_
	if [info exists audio_] {
		delete $audio_
		unset audio_
		delete $controller_
		unset controller_
	}
}
AudioStream public is_active {} {
	$self instvar controller_ audioTest_
	if [info exists controller_] {
		if { $audioTest_ != "none" } {
			return 1
		}
		return [$controller_ active]
	}
	return 0
}
AudioStream public clear_active {} {
	$self instvar controller_
	if [info exists controller_] {
		$controller_ active 0
	}
}
AudioStream public set_sample_rate { sr } {
    $self instvar sampleRate_
    set sampleRate_ $sr
}
AudioStream public use_16_bit_raw_PCM {} {
    $self instvar use16bitPCM_
    set use16bitPCM_ 1
}
Class AudioAgent16 -superclass AudioAgent
AudioAgent16 public init { app spec sampleRate use16 isStereo devName {callback {}} } {
    $self instvar sampRate use16bit useStereo
    set sampRate $sampleRate
    set use16bit $use16
    set useStereo $isStereo
    set deviceName $devName
    $self next $app $spec $callback
}
bind Entry <Enter> {
	catch {
		global entryTab
		if $entryTab(%W:focus) {
			focus %W
		}
	}
}
bind Entry <Return> {
    set validateMode [%W cget -validate]
    %W validate
    %W configure -validate $validateMode
}
bind Entry <Escape> {
	focus .
	%W select clear
	%W delete 0 end
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		%W insert 0 $entryTab(%W:value)
	}
}
bind Entry <Control-g> [bind Entry <Escape>]
bind Entry <Control-u> {
    tkEntrySetCursor %W 0
    %W delete insert end
}
proc mk.entry { w action text } {
	puts stderr "Use the new Entry class"
	exit 1
}
Class Entry
Entry instproc init { w value {obj {}} } {
	$self instvar win_
	set win_ $w
	entry $w -relief raised -borderwidth 1 -exportselection 1 \
		-font [$self get_option entryFont] \
                -validate focusout -validatecommand "$self validate %W %P"
	global entryTab
	if {$obj == {}} {
		set entryTab($w:object) $self
	} else {
		set entryTab($w:object) $obj
	}
	set entryTab($w:value) $value
	$w insert 0 $value
}
Entry instproc entry-value { } {
	global entryTab
	$self instvar win_
	$win_ validate
	return $entryTab($win_:value)
}
Entry instproc set-value {v} {
	global entryTab
	$self instvar win_
	$win_ delete 0 end
	$win_ insert 0 $v
	set entryTab($win_:value) $v
}
Entry instproc clear { } {
	global entryTab
	$self instvar win_
	set entryTab($win_:value) 0
	$win_ insert 0 ""
}
Entry instproc validate {entryName newValue} {
    global entryTab
    $self instvar win_
    set validateResult 1
    set oldValue $entryTab($entryName:value)
    if {[catch {set reject [$entryTab($entryName:object) update $newValue]}]} {
        set reject 0
    }
    if {$reject} {
        $win_ delete 0 end
        $win_ insert 0 $oldValue
        bell
        set validateResult 0
    } else {
        set entryTab($entryName:value) $newValue
        set validateResult 1
    }
    return $validateResult
}
set nids 0
proc uniqueID { } {
	global nids
	incr nids
	return $nids
}
proc isCIF fmt {
	if { $fmt == "h261" } {
		return 1
	}
	return 0
}
proc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
set current_icon_mark "FIXME"
proc mk.key w {
	puts stderr "Use the new KeyEditor class"
	exit 1
}
Class KeyEditor
KeyEditor instproc init { w crypt } {
	$self instvar crypt_ entry_ win_
	set crypt_ $crypt
	set win_ $w
	frame $w.key
	checkbutton $w.key.button -text "Encryption Key:" -relief flat \
		-font [$self get_option smallfont] \
		-command "$self toggle" -variable [$self tkvarname encryptOn_]\
		-disabledforeground gray40
	set key [$self get_option sessionKey]
	set entry_ [new Entry $w.key.entry $key $self]
	$self set-key $key
	pack $w.key.button -side left
	pack $w.key.entry -side left -fill x -expand 1
}
KeyEditor instproc disable {} {
	$self instvar win_
	$win_.key.button configure -state disabled
}
KeyEditor instproc enable {} {
	$self instvar win_
	$win_.key.button configure -state normal
}
KeyEditor instproc set-key key {
	$self tkvar encryptOn_
	$self instvar crypt_
	if { $key == "" } {
		$crypt_ crypt_clear
		set encryptOn_ 0
		$self disable
	} elseif { [$crypt_ install-key $key] != "" } {
		$self disable
		set encryptOn_ 0
		$self clear
	} else {
		$self enable
		set encryptOn_ 1
	}
}
KeyEditor instproc toggle {} {
	$self instvar crypt_ entry_
        $self tkvar encryptOn_
	if $encryptOn_ {
		$crypt_ install-key [$entry_ entry-value]
	} else {
		$crypt_ install-key ""
	}
}
KeyEditor instproc update key {
	set key [string trim $key]
	$self set-key $key
	return 0
}
Class TextEntry -superclass Entry
TextEntry instproc init { target w text } {
	$self next $w $text
	$self set target_ $target
}
TextEntry instproc update s {
	$self instvar target_
	if { $s != "" } {
		set s [string trim $s]
	}
	if {$target_ == {}} {
		return 0
	} else {
		return [eval $target_ \"$s"]
	}
}
Class QuitWindow -superclass TopLevelWindow
Class InfoWindow -superclass {QuitWindow Timer} -configuration {
	infoHighlightColor LightYellow2
	sdesList "cname tool email note"
}
Class ScubaInfoWindow -superclass {QuitWindow Timer Observer}
Class StatWindow -superclass {QuitWindow Timer} -configuration {
	statsFilter 0.0625
}
Class RtpStatWindow -superclass StatWindow
Class GlobalStatWindow -superclass StatWindow
Class MtraceWindow -superclass TopLevelWindow
QuitWindow public init { path quitMethod } {
	$self next $path
	$self instvar quitMethod_
	set quitMethod_ $quitMethod
}
QuitWindow instproc quit {} {
	$self instvar quitMethod_
	eval $quitMethod_
}
proc get-playout src {
	set d [$src handler]
	if { "$d" != "" } {
		return [expr [$d playout] >> 3]
	}
	return 0
}
StatWindow instproc create-row { r name width cmd relief } {
	set f [$self get_option smallfont]
	button $r.name -text $name -font $f -anchor w -width $width \
		-command $cmd -pady 2 -padx 2 -borderwidth 2 \
		-highlightthickness 0 -relief raised
	label $r.smooth -font $f -anchor e -width 8 \
		-relief $relief -borderwidth 1 -pady 1
	label $r.diff -font $f -anchor e -width 8 \
		-relief $relief -borderwidth 1 -pady 1
	label $r.total -font $f -anchor e -width 8 \
		-relief ridge -borderwidth 1 -pady 1
	pack $r.name -anchor w -fill x -side left -pady 1 -padx 4
	pack $r.smooth $r.diff $r.total \
		-expand 1 -fill both -anchor e -side left
}
StatWindow instproc create-panel { w stats } {
	set f [$self get_option smallfont]
	set p $w.f
	frame $p
	set top [winfo toplevel $w]
	set gain [$self get_option statsFilter]
	set r $p.legend
	frame $r
	label $r.smooth -font $f -anchor c -width 8 -text EWA \
		-relief ridge -borderwidth 1
	label $r.diff -font $f -anchor c -width 8 -text Delta \
		-relief ridge -borderwidth 1
	label $r.total -font $f -anchor c -width 8 -text Total \
		-relief ridge -borderwidth 1
	pack $r.total $r.diff $r.smooth -side right
	pack $r -anchor e
	$self instvar statCache_
	set statCache_ $stats
	set n [llength $stats]
	$self instvar width_
	set width_ 10
	set i 0
	while { $i < $n } {
		set v [string len [lindex $stats $i]]
		if { $v > $width_ } {
			set width_ $v
		}
		incr i 2
	}
	$self instvar rv_diff_ rv_smooth_
	set i 0
	while { $i < $n } {
		set name [lindex $stats $i]
		incr i
		set value [lindex $stats $i]
		incr i
		set id [string tolower $name]
		set r $p.$id
		frame $r
		set cmd "$self create-plot-window $name"
		$self create-row $r $name $width_ $cmd ridge
		pack $r -pady 0
		set rv_diff_($id) $value
		set rv_smooth_($id) $value
		rate_variable rv_diff_($id) 1.0 "%.1f"
		rate_variable rv_smooth_($id) $gain "%.1f"
	}
	$self instvar statWindow_
	set statWindow_ $p
	pack $w.f -anchor c
}
StatWindow instproc stats-changed { s1 s2 } {
	set n [llength $s1]
	if { $n != [llength $s2] } {
		return 1
	}
	set i 0
	while { $i < $n } {
		if { [lindex $s1 $i] != [lindex $s2 $i] } {
			return 1
		}
		incr i 2
	}
	return 0
}
StatWindow instproc stat-update {} {
	$self instvar rv_diff_ rv_smooth_ statCache_
	$self instvar method_ statWindow_
	set stats [eval $method_]
	if [$self stats-changed $stats $statCache_] {
		$self unset_rvs
		pack forget $w.frame
		destroy $w.frame
		frame $w.frame -borderwidth 2 -relief groove
		$self create-panel $w.frame $stats
		pack $w.frame -after $w.title -expand 1 -fill x -anchor center
	}
	set p $statWindow_
	set i 0
	set n [llength $stats]
	while { $i < $n } {
		set id [string tolower [lindex $stats $i]]
		incr i
		set cntr [lindex $stats $i]
		incr i
		set rv_diff_($id) $cntr
		set rv_smooth_($id) $cntr
		$p.$id.total configure -text $cntr
		$p.$id.diff configure -text $rv_diff_($id)
		$p.$id.smooth configure -text $rv_smooth_($id)
	}
	$self instvar src_
	if [winfo exists $p.playout.total] {
		$p.playout.total configure -text [get-playout $src_]ms
	}
}
StatWindow instproc unset_rvs {} {
	$self instvar statCache_ rv_diff_ rv_smooth_
	if [info exists statCache_] {
		set n [llength $statCache_]
		for { set i 0 } { $i < $n } { incr i 2 } {
			set id [string tolower [lindex $statCache_ $i]]
			unset rv_diff_($id) rv_smooth_($id)
		}
		unset statCache_
	}
}
proc stat_destroy src {
	destroy $src
	global stat_method win_src
	if [info exists stat_method($src)] {
		unset stat_method($src)
	}
	if [info exists win_src($src)] {
		unset win_src($src)
	}
}
InfoWindow instproc info_destroy { w src } {
	global info_x info_y
	set info_x($src) [winfo rootx $w]
	set info_y($src) [winfo rooty $w]
	destroy $w
}
ScubaInfoWindow instproc info_destroy { w src } {
	global info_x info_y
	set info_x($src) [winfo rootx $w]
	set info_y($src) [winfo rooty $w]
	destroy $w
}
StatWindow private timeout {} {
	$self stat-update
	$self sched 1000
}
StatWindow public init { w windowName titleText method quitCmd } {
	$self next $w $quitCmd
	$self create-window $w $windowName
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.main -borderwidth 0 -anchor w -text $titleText
	label $w.title.name -borderwidth 0 -anchor w
	frame $w.frame -borderwidth 2 -relief groove
	$self instvar method_
	set method_ $method
	$self create-panel $w.frame [eval $method]
	pack $w.title.name -anchor w
	pack $w.title.main -anchor w
	pack $w.title -fill x
	pack $w.frame -expand 1 -fill x -anchor center
	wm geometry $w +[winfo pointerx .]+[winfo pointery .]
	wm deiconify $w
	$self sched 1000
	button $w.dismiss -relief raised -font $f \
		-command "$self quit" -text Dismiss
	pack $w.dismiss -anchor c -pady 4
        wm protocol $w WM_DELETE_WINDOW "$self quit"
}
StatWindow instproc destroy {} {
	$self instvar plot_win_
	foreach w [array names plot_win_] {
		$self delete-plot-window $w
	}
	$self next
}
RtpStatWindow public init { w src titleText method quitCmd } {
	$self next $w [$src getid] $titleText $method $quitCmd
	$w.title.name configure -textvariable src_nickname($src)
	$self instvar src_
	set src_ $src
	$self instvar statWindow_ width_
	set r $statWindow_.playout
	frame $r
	set cmd ""
	$self create-row $r Playout $width_ $cmd flat
	pack $r -pady 0
}
RtpStatWindow instproc stat-get id {
	$self instvar method_
	set stats [eval $method_]
	set k [lsearch -exact $stats $id]
	return [lindex $stats [expr $k + 1]]
}
RtpStatWindow instproc create-plot-window name {
	$self instvar plot_win_ src_
	set id [string tolower $name]
	set w .plot$src_$id
	if [info exists plot_win_($w)] {
		$self delete-plot-window $w
	} else {
		set plot_win_($w) [new PlotWindow $w $src_ $name \
					"$self stat-get $name" \
					"$self delete-plot-window $w"]
	}
}
RtpStatWindow instproc delete-plot-window w {
	$self instvar plot_win_
	delete $plot_win_($w)
	unset plot_win_($w)
}
Class GlobalWindow -superclass StatWindow
GlobalWindow public init { w titleText method quitCmd } {
	$self next $w "RTP Stats" $titleText $method $quitCmd
}
proc has_src w {
	global win_src
	if [string compare $win_src($w) GLOBAL] {
		return 1
	} else {
		return 0
	}
}
Class PlotWindow -superclass {QuitWindow Timer}
PlotWindow private timeout {} {
	$self instvar rv_plot_ generator_ path_
	set rv_plot_ [eval $generator_]
	$path_.frame.sc set $rv_plot_
	$self sched 1000
}
proc relabel_stripchart {w min max perDiv} {
	$w configure -text " range $min to $max,  $perDiv/div"
}
PlotWindow public init { w src name generator quitCmd } {
	$self next $w $quitCmd
	$self create-window $w "plot window"
	catch "wm resizable $w true false"
	$self instvar generator_
	set generator_ $generator
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.main -borderwidth 0 -anchor w -text $name
	frame $w.frame -borderwidth 2 -relief groove
	stripchart $w.frame.sc -max 200 -min 1 -stripwidth 1 -width 1 \
		-autoscale 2 -rescale_command "relabel_stripchart $w.bf.lab" \
		-relief groove -striprelief flat -tickcolor gray95 -hticks 30
	pack $w.frame.sc -expand 1 -fill both
	frame $w.brace -width 250
	pack $w.brace
	if [string match Source/* [$src info class]] {
		label $w.title.name -borderwidth 0 -anchor w \
			-textvariable src_nickname($src)
		pack $w.title.name -anchor w
	}
	pack $w.title.main -anchor w
	pack $w.title -fill x
	pack $w.frame -expand 1 -fill both -anchor center
	$self instvar rv_plot_
	if { "$name" != "Playout" } {
		rate_variable rv_plot_ 1.0 "%.1f"
	}
	wm geometry $w +[winfo pointerx .]+[winfo pointery .]
	wm deiconify $w
	$self sched 1000
	frame $w.bf
	label $w.bf.lab -borderwidth 0 -font $f -anchor w -text "No data"
	pack $w.bf.lab -side left -expand 1 -fill x
	button $w.bf.dismiss -relief raised -font $f -anchor e \
		-command "$self quit" -text Dismiss
	pack $w.bf.dismiss -side right -pady 4 -padx 4
	pack $w.bf -expand 1 -fill x
        wm protocol $w WM_DELETE_WINDOW "$self quit"
}
proc info_text src {
	set d [$src handler]
	set fmt [$src format_name]
	if {[[$src set sm_] info class] == "VideoAgent"} {
		if { "$d" != "" } {
			set fmt "$fmt [$d cmd info] ([$d width]x[$d height])"
		}
	} elseif {[[$src set sm_] info class] == "AudioAgent"} {
		if { "$d" != "" } {
			set n [expr [$d block-size] / 160]
			if { $n > 1 } {
				set fmt $fmt/$n
			}
		}
		if { $fmt == "" } {
			set fmt none
		}
	}
	return "format: $fmt"
}
InfoWindow public init { w src parent } {
	$self instvar src_
	set src_ $src
	$self next $w "$parent delete-info-window"
	$self create-window $w [$src getid]
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.name -borderwidth 0 -font $f -anchor w \
		-textvariable src_nickname($src)
	label $w.title.info -borderwidth 0 -font $f -anchor w \
		-text [$src addr]
	label $w.title.timeData -borderwidth 0 -font $f -anchor w
	label $w.title.timeCtrl -borderwidth 0 -font $f -anchor w
	frame $w.frame -borderwidth 2 -relief groove
	pack $w.title.name $w.title.info -fill x
        foreach sdes [$self get_option sdesList] {
		label $w.title.$sdes -borderwidth 0 -font $f -anchor w
		pack $w.title.$sdes -fill x
	}
	label $w.title.srcid -borderwidth 0 -font $f -anchor w
	pack $w.title.srcid -fill x
	pack $w.title.timeData $w.title.timeCtrl -fill x
	pack $w.title -fill x
	set p $w.bot
	frame $p
	set m $p.mb.menu
	menubutton $p.mb -text Stats... -menu $m -relief raised -width 8 \
		-font $f
	menu $m
	$m add command -label RTP -command "$parent create-rtp-window" -font $f
	$m add command -label Decoder \
		-command "$parent create-decoder-window" -font $f
	button $p.dismiss -relief raised -font $f \
		-command "$self quit" -text Dismiss
	pack $p.mb -side left -padx 8
	pack $p.dismiss -side right -padx 8
	pack $p -anchor c -pady 4 -fill x
        wm protocol $w WM_DELETE_WINDOW "$self quit"
	$self info_update
	global info_x info_y
	if [info exists info_x($src) ] {
		set x $info_x($src)
		set y $info_y($src)
	} else {
		set x [winfo pointerx .]
		set y [winfo pointery .]
	}
	update idletasks
	if ![winfo exists $w] { return }
	set right [expr [winfo screenwidth .] - [winfo reqwidth $w] - 5]
	if { $x > $right } {
		set x $right
	}
	set bot [expr [winfo screenheight .] - [winfo reqheight $w] - 5]
	if { $y > $bot } {
		set y $bot
	}
	wm geometry $w +$x+$y
	wm deiconify $w
	$self sched 3000
}
InfoWindow instproc info_update {} {
	$self instvar path_ src_
	set w $path_
	set src $src_
	set decoder [$src handler]
	set fmt [$src format_name]
	if { $fmt == "" } { set fmt "?" }
	$w.title.info configure -text [info_text $src]
	set t [$src lastdata]
	if { $t == "" } { set t "never" }
	$w.title.timeData configure -text "last data $t"
	set t [$src lastctrl]
	if { $t == "" } { set t "never" }
	$w.title.timeCtrl configure -text "last control $t"
	foreach sdes [$self get_option sdesList] {
		$w.title.$sdes configure -text "$sdes: [$src sdes $sdes]"
	}
	$w.title.srcid configure -text "srcid: [$src srcid]/[$src addr]"
	if { [$src srcid] != [$src ssrc] } {
		if ![winfo exists $w.title.mixer] {
			label $w.title.mixer -borderwidth 0 \
				-font [$self get_option smallfont] -anchor w
			pack $w.title.mixer -after $w.title.srcid -fill x
		}
		$w.title.mixer configure -text "mixer: [$src ssrc]/[$src addr]"
	} elseif [winfo exists $w.title.mixer] {
		pack forget $w.title.mixer
		destroy $w.title.mixer
	}
	set note [$src sdes note]
	if { $note != "" } {
		set bg [$self get_option infoHighlightColor]
	} else {
		set bg [$self get_option background]
	}
	$w.title.note configure -background $bg
}
InfoWindow private timeout {} {
	$self info_update
	$self sched 3000
}
ScubaInfoWindow private timeout {} {
	$self info_update
	$self sched 1000
}
ScubaInfoWindow public init { w src parent scuba_sess } {
	$self instvar src_ parent_ scuba_sess_
	set src_ $src
	set scuba_sess_ $scuba_sess
	$self next $w "$parent delete-scuba-window"
	$self create-window $w [$src getid]
	set f [$self get_option smallfont]
	frame $w.title -borderwidth 2 -relief groove
	label $w.title.name -borderwidth 0 -anchor w \
		-textvariable src_nickname($src)
	label $w.title.info -borderwidth 0 -anchor w -text "SCUBA Votes"
	frame $w.frame -borderwidth 2 -relief groove
	pack $w.title.name $w.title.info -fill x
	pack $w.title -fill x
	frame $w.frame.total -relief ridge -borderwidth 1
	label $w.frame.total.t -text "Aggregate Vote:" -font $f
	label $w.frame.total.val -text 0 -font $f
	pack $w.frame.total.t $w.frame.total.val -side left -anchor w
	pack $w.frame.total -fill x -expand 1 -side bottom
	pack $w.frame -fill both -expand 1 -side top
	set p $w.bot
	frame $p
	button $p.dismiss -relief raised -font $f \
		-command "$self quit" -text Dismiss
	pack $p.dismiss
	pack $p -anchor c -pady 4 -fill x
        wm protocol $w WM_DELETE_WINDOW "$self quit"
	global scubainfo_x scubainfo_y
	if [info exists scubainfo_x($src) ] {
		set x $scubainfo_x($src)
		set y $scubainfo_y($src)
	} else {
		set x [winfo pointerx .]
		set y [winfo pointery .]
	}
	update idletasks
	if ![winfo exists $w] { return }
	set right [expr [winfo screenwidth .] - [winfo reqwidth $w] - 5]
	if { $x > $right } {
		set x $right
	}
	set bot [expr [winfo screenheight .] - [winfo reqheight $w] - 5]
	if { $y > $bot } {
		set y $bot
	}
	wm geometry $w +$x+$y
	wm deiconify $w
}
ScubaInfoWindow instproc info_update {} {
	$self instvar path_ src_ scuba_sess_
	set w $path_.frame
	set sm [$scuba_sess_ source-manager]
	if { [$sm info vars local_] == "" } {
		return
	}
	set localsrc [$sm set local_]
	set total 0
	set al [$sm active_list]
	foreach src $al {
		set srcid [$src srcid]
		set voters [$scuba_sess_ array names scoretab_ *:$srcid]
		set subtotal 0
		foreach v $voters {
			set subtotal \
			    [expr $subtotal+[$scuba_sess_ set scoretab_($v)]]
		}
		set tot($src) $subtotal
		set total [expr $total+$subtotal]
	}
	if { $total > 0 } {
		set avg [expr $tot($src_)/$total]
	} else {
		set avg 0
	}
	set srcid [$src_ srcid]
	set voters [$scuba_sess_ array names scoretab_ *:$srcid]
	set sm [$scuba_sess_ source-manager]
	foreach s [$sm set sources_] {
		if { $s == $src_ } {
			continue
		}
		$w.s$s.v configure -text "= 0.0"
	}
	foreach v $voters {
		set sender [lindex [split $v :] 0]
		$w.s$sender.v configure \
				-text "= [$scuba_sess_ set scoretab_($v)]"
	}
	$w.total.val configure -text $avg
}
ScubaInfoWindow instproc register { src } {
	$self instvar path_ scuba_sess_ src_
	if { $src == $src_ } {
		return
	}
	set f [$self get_option smallfont]
	set w $path_.frame
	global src_nickname
	frame $w.s$src
	set sm [$scuba_sess_ source-manager]
	if { [$sm set local_] == $src } {
		label $w.s$src.t -text "Local Receiver" -font $f
	} else {
		label $w.s$src.t -textvariable src_nickname($src) -font $f
	}
	label $w.s$src.v -text  "= 0.0" -font $f
	pack $w.s$src.t -side left  -anchor w
	pack $w.s$src.v -side right -anchor e
	pack $w.s$src -fill both -expand 1
}
ScubaInfoWindow instproc unregister { src } {
	$self instvar path_ src_
	if { $src == $src_ } {
		return
	}
	set w $path_.frame
	destroy $w.s$src
}
ScubaInfoWindow instproc deactivate { src } {
	$self instvar src_ path_
	if { $src == $src_ } {
		destroy $path_
	}
}
MtraceWindow public init {w src dir} {
        $self instvar w_ src_ dir_
	set w_ $w
	set src_ $src
	set dir_ $dir
	if ![winfo exists $w] {
                $self create-window $w [$src getid]
		set f [$self get_option smallfont]
		frame $w.t
		scrollbar $w.t.yscroll -command "$w.t.text yview" -relief sunken
		scrollbar $w.t.xscroll -command "$w.t.text xview" -relief sunken \
			-orient horiz
		text $w.t.text -height 24 -width 80 -setgrid true -wrap none \
			-font fixed -relief sunken -borderwidth 2 \
			-xscrollcommand "$w.t.xscroll set" \
			-yscrollcommand "$w.t.yscroll set"
		pack $w.t.yscroll -side right -fill y
		pack $w.t.xscroll -side bottom -fill x
		pack $w.t.text -side left -padx 0 -pady 0 -fill both -expand yes
		set p $w.b
		frame $p
		button $p.dismiss -relief raised -font $f \
			-command "destroy $w" -text Dismiss
		pack $p.dismiss -side right -padx 8
		pack $w.t -side top -fill both -expand yes
		pack $p -side bottom -pady 2 -fill x
		wm geometry $w +[winfo pointerx .]+[winfo pointery .]
		wm deiconify $w
                wm protocol $w WM_DELETE_WINDOW "destroy $w"
		update idletasks
		if ![winfo exists $w] { return }
	}
}
MtraceWindow instproc do_mtrace {} {
        $self instvar w_ src_ dir_
	global V
	set rtpagent $V(sm)
	set net [$rtpagent network]
	if {$dir_=="to"} {
		set cmd "|mtrace [$net interface] [$net addr] [$src_ addr]"
	} else {
		set cmd "|mtrace [$src_ addr] [$net addr]"
	}
	if [catch "open {$cmd} r" fd] {
		$w_.t.text insert end "mtrace error: $fd"
		return
	}
	fconfigure $fd -blocking 0
	fileevent $fd readable "$self read_mtrace $fd"
}
MtraceWindow instproc read_mtrace {fd} {
        $self instvar w_
	if [winfo exists $w_] {
		$w_.t.text insert end [read $fd 1]
		$w_.t.text yview end
		if [eof $fd] {
			fileevent $fd readable {}
			catch "close $fd"
		}
	} else {
		fileevent $fd readable {}
		catch "close $fd"
	}
}
proc destroy_rtp_stats src {
	if [winfo exists .rtp$src] {
		foreach statwin [StatWindow info instances] {
		    if [$src == [$statwin set src_]] {
			$statwin unset_rvs
		    }
		}
		stat_destroy $src
	}
}
Class 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
	$self instvar path_
	$path_ configure -cursor watch
}
ControlMenu proc finish_histtolut { pipe infile outfile } {
	$self instvar path_
	$path_ 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_(h263+) 68
	set qval_(h263) 68
	set qval_(nv) 80
	set qval_(nvdct) 80
	set qval_(pvh) 60
	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 Settings"
	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
	}
        wm protocol $w WM_DELETE_WINDOW "$self toggle"
}
ControlMenu instproc selectInitialDevice {} {
	$self instvar vpipe_ device_ transmitButton_
	$self tkvar transmitButtonState_
	set L [$vpipe_ input_devices]
	set d [$self get_option defaultDevice]
	set selected 0
	foreach v $L {
		if { [$v nickname] == "$d" && \
				[$v attributes] != "disabled" } {
			set device_ $v
			$self select_device $v
			set selected 1
			break
		}
	}
	if !$selected {
		foreach v $L {
			if { "[$v attributes]" != "disabled" && \
					"[$v nickname]" != "still" } {
				set device_ $v
				$self select_device $v
				set selected 1
				break
			}
		}
	}
	if { $selected && [$self get_option xmitVideoOnStartup]!={} && \
			[$transmitButton_ cget -state] != "disabled" && \
			!$transmitButtonState_} {
		set transmitButtonState_ 1
		$self transmit
	}
}
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 switch-agent {new_agent} {
	$self instvar videoAgent_
	$self instvar addrspec_ namespec_
	set videoAgent_ $new_agent
	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_ sessionspec_ 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.session
	label $w.nb.frame.session.label -text "Switch session: " -font $f\
			-anchor e -width 20
	new TextEntry "$self update_session" $w.nb.frame.session.entry ""
	pack $w.nb.frame.session.label -side left
	pack $w.nb.frame.session.entry -side left -expand 0 -fill x -pady 2
	set sessionspec_ $w.nb.frame.session
	frame $w.nb.frame.name
	label $w.nb.frame.name.label -text "Name: " -font $f -anchor e -width 7
	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 7
	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.session $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_session spec {
	$self instvar sessionspec_
	$self instvar ui_
	$sessionspec_.entry delete 0 end
	set err "You must type a correct specification"
	if {$spec != ""} {
		set ab [new AddressBlock 224.1.1.1/11111]
		set err [$ab parse $spec]
		delete $ab
	}
	if {$err != ""} {
		Log warn $err
		return 0
	}
	$ui_ switch-agent $spec
	return 0
}
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 10 -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 10 -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]
	if {[string range $devname end end] == ":"} {
		set devname [string range $devname 0 [expr [string length $devname] - 2]]
	}
	$self instvar path_
	set w $path_.$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
			$self build.$devname $w
			pack $w -side top -fill x -expand 1
		}
		pack $w -before $path_.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 configure_norm $device
	$self insert_grabber_panel [$device nickname]
	set videoFormat $defaultFormat($device)
	$self select_format $videoFormat
        $vpipe_ set device_ $device
        $self set device_ $device
	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_norm { device } {
	$self instvar normButton_
	if [$device supports norm *] {
		$normButton_ configure -state normal
		$self attach_norms $device
	} else {
		$normButton_ 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
	}
	if { $videoFormat == "h.263+" } {
		set videoFormat h263+
	}
	if { $videoFormat == "h.263" } {
		set videoFormat h263
	}
	$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 -fill x
	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
	} else {
		label $w.b1 -text "" -padx 0 -pady 0
		pack $w.b1 -fill x
	}
	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 -anchor n
		lappend formatButtons $w.b2
	} else {
		label $w.b2 -text "" -padx 0 -pady 0
		pack $w.b2 -fill x
	}
}
ControlMenu instproc build.format w {
	$self format_col $w.p0 nv nvdct cellb
	$self format_col $w.p1 jpeg pvh
	$self format_col $w.p2 h261
	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-norm n {
	$self instvar vpipe_
	$vpipe_ set_norm $n
}
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.norm w {
	set f [$self get_option smallfont]
	menubutton $w -menu $w.menu -text Signal... \
		-relief raised -width 10 -font $f -state disabled
	global inputNorm
	$self instvar normButton_
	set normButton_ $w
	set inputNorm undefined
}
ControlMenu instproc attach_norms device {
	$self instvar normButton_
	catch "destroy $normButton_.menu"
	set m $normButton_.menu
	$self build.norm_menu $device $m
}
ControlMenu instproc build.norm_menu { device m } {
	global inputNorm defaultNorm
	set normnames [$device get_attribute norm]
	set f [$self get_option smallfont]
	menu $m
	foreach norm $normnames {
		$m add radiobutton -label $norm -command "$self set-norm $norm" \
			-value $norm -variable inputNorm -font $f
	}
	if ![info exists defaultNorm($device)] {
		set nn [$device nickname]
		if [info exists defaultNorm($nn)] {
			set defaultNorm($device) $defaultNorm($nn)
		} else {
			set s [$self get_option defaultNorm($nn)]
			if { $s != "" } {
				set defaultNorm($device) $s
			} else {
				set defaultNorm($device) [lindex $normnames 0]
			}
		}
	}
	set inputNorm $defaultNorm($device)
}
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
	$self build.norm $w.norm
	pack $w.device $w.port $w.norm $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_ ui_ layout_menu_
	set f [$self get_option smallfont]
	set layout_menu_ $w.menu
	menubutton $w -text Layout... -menu $layout_menu_ -relief raised \
		-width 10 -font $f
	menu $layout_menu_
	set v [$self tkvarname ncol]
	$layout_menu_ add radiobutton -label Single \
		-command "$asm_ redecorate 1" \
		-value 1 -variable $v -font $f
	$layout_menu_ add radiobutton -label Double \
		-command "$asm_ redecorate 2" \
		-value 2 -variable $v -font $f
	$layout_menu_ add radiobutton -label Triple \
		-command "$asm_ redecorate 3" \
		-value 3 -variable $v -font $f
	$layout_menu_ add radiobutton -label Quadruple \
		-command "$asm_ redecorate 4" \
		-value 4 -variable $v -font $f
	$layout_menu_ add radiobutton -label Quintuple \
		-command "$asm_ redecorate 5" \
		-value 5 -variable $v -font $f
	$layout_menu_ add radiobutton -label Sextuple \
		-command "$asm_ redecorate 6" \
		-value 6 -variable $v -font $f
	$layout_menu_ add radiobutton -label Septuple \
		-command "$asm_ redecorate 7" \
		-value 7 -variable $v -font $f
	$layout_menu_ add radiobutton -label Octuple \
		-command "$asm_ redecorate 8" \
		-value 8 -variable $v -font $f
	$layout_menu_ add separator
	$layout_menu_ add checkbutton -label Scrollbars \
		-command "$ui_ set_scrollbars" \
		-font $f -variable [$ui_ tkvarname useScrollbars_]
	$asm_ instvar ncol_ nrow_ list_direction_
	if {$list_direction_ == "vertical"} {
		$layout_menu_ invoke [expr $ncol_ - 1]
	} else {
		$layout_menu_ invoke [expr $nrow_ - 1]
	}
	$ui_ instvar scrollbars_on_
    	if {$scrollbars_on_} {
	    	$layout_menu_ invoke [$layout_menu_ index Scrollbars]
    	}
}
ControlMenu instproc toggle_scrollcheck {} {
    $self instvar layout_menu_
    if [info exists layout_menu_] {
	$layout_menu_ invoke [$layout_menu_ index Scrollbars]
    }
}
ControlMenu instproc update_layout {n} {
    $self instvar layout_menu_
    if [info exists layout_menu_] {
	$layout_menu_ invoke [expr $n - 1]
    }
}
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 {
	$self instvar asm_
	$asm_ instvar autoplace_
	set f [$self get_option smallfont]
	set m $w.menu
	menubutton $w -text Options... -menu $m -relief raised -width 10 \
		-font $f
	menu $m
	if {[info exists autoplace_]} {
    		$m add checkbutton -label "Auto-Place New Sources" \
			-command "$asm_ set_autoplace" \
    	    		-variable [$asm_ tkvarname autoplaceNewSources] -font $f
	}
    	$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
	}
	if {[info exists autoplace_] && $autoplace_} {
	    $m invoke [$m index {Auto-Place New Sources}]
	}
}
ControlMenu instproc toggle_autocheck {} {
    $self instvar optionsMenu_
    if [info exists optionsMenu_] {
	$optionsMenu_ invoke [$optionsMenu_ index {Auto-Place New Sources}]
    }
}
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
	if [winfo exists $v.options] { pack $v.options -fill x -expand 1 }
	if [winfo exists $v.tile   ] { pack $v.tile    -fill x -expand 1 }
	if [winfo exists $v.ext    ] { pack $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_
	if { $ui_srclist_ != {} } {
		set top [$ui_srclist_ widget_path]
	} else { set top $w }
	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_ qvalue_ lastFmt_
	$self instvar vpipe_ device_
	set qval_($lastFmt_) [$qscale_ get]
	set lastFmt_ $videoFormat
	if [info exists qval_($fmt)] {
		$qscale_ set $qval_($fmt)
	}
	$vpipe_ select $device_ $fmt
	if { ([info exists qval_($fmt)]) && \
			([$vpipe_ set_quality $qval_($fmt)] >= 0) } {
		$qscale_ configure -state normal -command "$self setq"
	}
	$qlabel_ configure -foreground [$self get_option foreground]
}
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_
	$self instvar normButton_
	global inputPort inputNorm
	if { [$portButton_ cget -state] == "normal" } {
		$self set-port $inputPort
	}
	if { [$normButton_ cget -state] == "normal" } {
		$self set-norm $inputNorm
	}
	$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_ scuba_session]
	$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.lml33 { 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.ll -relief flat
	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.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 65500 \
                              -command "$vpipe_ hardware contrast"
	scale $w.f.l.bscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 65500 \
                            -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.glabel -font $f -text "Hue" -anchor n
	label $w.f.cl.slabel -font $f -text "Color" -anchor n
	pack  $w.f.cl.glabel $w.f.cl.slabel \
			     -side left -fill x -expand 1
	frame $w.f.c -relief flat
	scale $w.f.c.hscale -orient horizontal -width 12 -relief groove \
                             -showvalue 0 -from 0 -to 65500 \
                             -command "$vpipe_ hardware hue"
	scale $w.f.c.cscale -orient horizontal -width 12 -relief groove \
                            -showvalue 0 -from 0 -to 65500 \
                            -command "$vpipe_ hardware color"
	pack  $w.f.c.hscale $w.f.c.cscale -side left -fill x -expand 1
	pack  $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.l.cscale set 27648
	$w.f.l.bscale set 32768
	$w.f.c.hscale set 32768
	$w.f.c.cscale set 32512
}
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
}
ControlMenu instproc x11grabUpdatePos {x y w h} {
    global x11grabcontrols
    set w $x11grabcontrols
    if {[string compare $x [$w.x11grab.row1.pos.x.e get]] != 0} {
	$w.x11grab.row1.pos.x.e delete 0 end
	$w.x11grab.row1.pos.x.e insert 0 $x
    }
    if {[string compare $y [$w.x11grab.row1.pos.y.e get]] != 0} {
	$w.x11grab.row1.pos.y.e delete 0 end
	$w.x11grab.row1.pos.y.e insert 0 $y
    }
    if {[string compare $w [$w.x11grab.row1.pos.w.e get]] != 0} {
	$w.x11grab.row1.pos.w.e delete 0 end
	$w.x11grab.row1.pos.w.e insert 0 $w
    }
    if {[string compare $h [$w.x11grab.row1.pos.h.e get]] != 0} {
	$w.x11grab.row1.pos.h.e delete 0 end
	$w.x11grab.row1.pos.h.e insert 0 $h
    }
}
ControlMenu instproc x11cmd.update.geo w {
    $self instvar vpipe_
    $vpipe_ hardware fixed [$w.row.x get] [$w.row.y get]
}
ControlMenu instproc x11cmd.fixed {} {
    global x11Source x11grabcontrols
    set w $x11grabcontrols
    $w.label configure -text "$x11Source"
    if [winfo exists $w.row] {
	destroy $w.row
    }
    frame $w.row
    pack append $w.row \
	[label $w.row.xl -text "X:" -width 2 -anchor e] {left filly} \
	[entry $w.row.x -relief flat -width 4] {left filly} \
	[label $w.row.yl -text "Y:" -width 2 -anchor e] {left filly} \
	[entry $w.row.y -relief flat -width 4] {left filly}
    bind $w.row.x <Return> "$self x11cmd.update.geo $w"
    bind $w.row.y <Return> "$self x11cmd.update.geo $w"
    pack $w.row -after $w.label
}
ControlMenu instproc x11cmd.pointer {} {
    $self instvar vpipe_
    global x11Source x11grabcontrols
    set w $x11grabcontrols
    $w.label configure -text "$x11Source"
    if [winfo exists $w.row] {
	destroy $w.row
    }
    frame $w.row
    pack append $w.row \
	[button $w.row.s -text "Follow pointer" \
	     -command "$vpipe_ hardware pointer"] { left filly }
    pack $w.row -after $w.label
}
ControlMenu instproc x11cmd.window {} {
    $self instvar vpipe_
    global x11Source x11grabcontrols
    puts "x11cmd -- x11Source $x11Source"
    set w $x11grabcontrols
    $w.label configure -text "$x11Source"
    if [winfo exists $w.row] {
	destroy $w.row
    }
    frame $w.row
    pack append $w.row \
	[button $w.row.s -text "Select window" \
	     -command "$vpipe_ hardware window"] { left filly }
    pack $w.row -after $w.label
}
ControlMenu instproc build.x11 w {
    global x11grabcontrols x11Source
    set f [$self get_option smallfont]
    label $w.title -text "X11 Grabber controls"
    frame $w.x11grab -relief sunken -borderwidth 2
    set x11grabcontrols $w.x11grab
    set x11Source "Fixed"
    set w1 $w.x11grab
    set m $w1.menu
    set m1 $m.m1
    menubutton $w1.menu -menu $m1 -text "Source:" \
	-relief raised -width 7 -font $f
    label $w1.label -width 6 -font $f
    frame $w1.row
    menu $m1
    $m1 add radiobutton -label Fixed \
	-state active \
	-command "$self x11cmd.fixed" -font $f -variable x11Source
    pack append $w1 \
	$w1.menu {left} \
	$w1.label {left} \
	$w1.row {left}
    pack $w $w.title $w1 -fill x -expand 1
    $self x11cmd.fixed
}
ControlMenu instproc build.v4l { w } {
	$self instvar vpipe_
	set f [$self get_option smallfont]
	label $w.title -text "Video4Linux grabber controls"
	pack $w.title  -fill x -expand 1
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.left -relief flat
	button $w.f.left.reset -font $f -width 10 -text "Reset" \
			-command "$w.f.right.top.c.cscale set 128; \
					$w.f.right.top.b.bscale set 128; \
					$w.f.right.bottom.h.hscale set 128; \
					$w.f.right.bottom.s.sscale set 128; \
					$vpipe_ hardware controls reset" \
			-padx 1 -pady 1
	pack $w.f.left.reset
	frame $w.f.right -relief flat
	frame $w.f.right.top -relief flat
	frame $w.f.right.top.c -relief flat -borderwidth 2
	scale $w.f.right.top.c.cscale -orient horizontal -font $f -relief groove \
			-width 12  \
			-showvalue 0 -from 0 -to 255 \
			-label Contrast \
			-command "$vpipe_ hardware contrast"
	$w.f.right.top.c.cscale set 128;
	pack  $w.f.right.top.c.cscale  -fill x -expand 1
	frame $w.f.right.top.b -relief flat -borderwidth 2
	scale $w.f.right.top.b.bscale -orient horizontal -font $f -relief groove \
			-width 12  \
			-showvalue 0 -from 0 -to 255 \
			-label Brightness \
			-command "$vpipe_ hardware brightness"
	pack  $w.f.right.top.b.bscale -fill x -expand 1
	$w.f.right.top.b.bscale set 128;
	frame $w.f.right.bottom -relief flat
	frame $w.f.right.bottom.h -relief flat -borderwidth 2
	scale $w.f.right.bottom.h.hscale -orient horizontal -font $f -relief groove \
			-width 12 \
			-showvalue 0 -from 0 -to 255 \
			-label Hue \
			-command "$vpipe_ hardware hue"
	$w.f.right.bottom.h.hscale set 128;
	pack  $w.f.right.bottom.h.hscale -fill x -expand 1
	frame $w.f.right.bottom.s -relief flat -borderwidth  2
	scale $w.f.right.bottom.s.sscale -orient horizontal -font $f -relief groove \
			-width 12 \
			-showvalue 0 -from 0 -to 255 \
			-label Saturation \
			-command "$vpipe_ hardware saturation"
	$w.f.right.bottom.s.sscale set 128;
	pack  $w.f.right.bottom.s.sscale -fill x -expand 1
	pack $w.f.right.top.b $w.f.right.top.c -side right
	pack $w.f.right.bottom.s $w.f.right.bottom.h -side right
	pack $w.f.right.top $w.f.right.bottom -side top -fill x -expand 1
	pack $w.f.left $w.f.right -side left -expand 1 -fill x
	pack $w.f -expand 1 -fill x
}
ControlMenu instproc build.test { w } {
	global testFileChoice
	global testFileNameEntry
	set f [$self get_option smallfont]
	label $w.title -text "Test capturer controls"
	pack $w.title  -fill x -expand 1
	frame $w.f -relief sunken -borderwidth 2
	frame $w.f.file
	button $w.f.file.select -text File -borderwidth 2 \
			-anchor c -font $f -command "$self change_file 1"
	set testFileNameEntry [new TextEntry "$self change_file 1" \
			$w.f.file.name ""]
	pack $w.f.file.select -side left
	pack $w.f.file.name -side left -expand 1 -fill x -pady 2
	pack $w.f.file -expand 1 -fill x
	pack $w.f -expand 1 -fill x
}
ControlMenu instproc change_file {tofile args} {
	global testFileChoice
	global testFileNameEntry
	$self instvar vpipe_
	if {$tofile == 1} {
		if {$args == ""} {
			set filename [tk_getOpenFile -filetypes {{{PPM Files} {.ppm}}}\
					-title "Choose the testcard image"]
			if {$filename != ""} {
				$testFileNameEntry set-value $filename
				set testFileChoice 1
			}
		} else {
			set filename [lindex $args 0]
			set testFileChoice 1
		}
		if {(![catch {file type $filename} res]) && ($res=="file")} {
			$vpipe_ hardware set-file $filename
			global inputPort
			set inputPort file
		}
	} else {
		set current_filename [$testFileNameEntry entry-value]
		if {$current_filename != ""} {
			$testFileNameEntry set-value ""
		}
		$vpipe_ hardware set-bluepassion
		set testFileChoice 0
	}
	return 0
}
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 CameraUI
CameraUI public init {w addrspec} {
    $self instvar al_ zoomSpeed_ panSpeed_ tiltSpeed_ \
	    presets_ pending_ setPresets_ remain_quiet_
    set remain_quiet_ 1
    set pending_ -1
    array set presets_ ""
    set zoomSpeed_ -1
    set panSpeed_ -1
    set tiltSpeed_ -1
    set setPresets_ 0
    set firstchar [string index $addrspec 0]
    if [string match \[a-zA-Z\] $firstchar] {
	set n [lindex [split $addrspec "/"] 0]
	set p [lindex [split $addrspec "/"] 1]
	set s [gethostbyname $n]
	if { $s == "" } {
	    puts "cannot find address for '$n'"
	    exit
	}
	set addrspec $s/$p
    }
    set al_ [new UDPChannel/CamCl $addrspec $self]
    $self build_gui $w
    update
    set remain_quiet_ 0
}
CameraUI public destroy {} {
    $self instvar al_
    delete $al_
    eval [list $self] next
}
CameraUI private build_gui {w} {
    $self instvar al_ scales_ w_
    set w $w.camFrame
	set w_ $w
    frame $w
    pack $w
    set il $w.infolabel
    frame $il -relief groove
    label $il.l -text "Camera Controller"
    pack $il -side bottom -fill x -expand 1
    pack $il.l -in $il -side bottom -fill x -expand 1
    set t $w.camera
    set cameraParent $w
    frame $t
    pack $t -in $w
    set width 120
    set height 80
    set winwidth 124
    set uparrow " -6 -9	 -6 -23	 -14 -23  0 -35	 14 -23	 6 -23	 6 -9  -6 -9"
    set dnarrow " -6  9	 -6  23	 -14  23  0  35	 14  23	 6  23	 6  9  -6  9"
    set ltarrow " -9 -6	 -23 -6	 -23 -14  -35 0	 -23 14	 -23 6	 -9 6  -9 -6"
    set rtarrow "  9 -6	  23 -6	  23 -14   35 0	  23 14	  23 6	  9 6	9 -6"
    set ziarrow " 54 -9	 54 -23	 46 -23	 60 -35	 74 -23	 66 -23 66 -9  54 -9"
    set zoarrow " 56  0	 56  10	 50  10	 60  15	 70  10	 64  10 64  0  56  0"
    set hhalf [expr $height/2]
    set c $t.c
    set region [list -40 -$hhalf 80 $hhalf]
    canvas $c -height $height -width $width -borderwidth 0 \
	    -scrollregion $region
    set p_up [eval $c create polygon $uparrow -tags \{up arrow\}]
    set p_dn [eval $c create polygon $dnarrow -tags \{dn arrow\}]
    set p_lt [eval $c create polygon $ltarrow -tags \{lt arrow\}]
    set p_rt [eval $c create polygon $rtarrow -tags \{rt arrow\}]
    set p_zi [eval $c create polygon $ziarrow -tags \{zi arrow\}]
    set p_zo [eval $c create polygon $zoarrow -tags \{zo arrow\}]
    $c scale all 0 0 .8 .8
    set t_pos [$c create text 0 -33 -text "position" -anchor c]
    set t_zoom [$c create text 50 -33 -text "zoom" -anchor c]
    $c bind arrow <Any-Enter> "$self itemEnter $c"
    $c bind arrow <Any-Leave> "$self itemLeave $c"
    set pressCmd "$self itemPress $c"
    set releaseCmd "$self itemRelease $c"
    $c bind up <ButtonPress-1>	 "$pressCmd;   $al_ send move_up"
    $c bind up <ButtonRelease-1> "$releaseCmd; $al_ send move_stop"
    $c bind dn <ButtonPress-1>	 "$pressCmd;   $al_ send move_down"
    $c bind dn <ButtonRelease-1> "$releaseCmd; $al_ send move_stop"
    $c bind lt <ButtonPress-1>	 "$pressCmd;   $al_ send move_left"
    $c bind lt <ButtonRelease-1> "$releaseCmd; $al_ send move_stop"
    $c bind rt <ButtonPress-1>	 "$pressCmd;   $al_ send move_right"
    $c bind rt <ButtonRelease-1> "$releaseCmd; $al_ send move_stop"
    $c bind zi <ButtonPress-1>	 "$pressCmd;   $al_ send zoom_in"
    $c bind zi <ButtonRelease-1> "$releaseCmd; $al_ send zoom_stop"
    $c bind zo <ButtonPress-1>	 "$pressCmd;   $al_ send zoom_out"
    $c bind zo <ButtonRelease-1> "$releaseCmd; $al_ send zoom_stop"
    pack $c -side top
    frame $t.right
    pack $t.right -side right
    set scales_ $t
    frame $t.pan
    scale $t.pan.sc -command "$self set_speed p" -showvalue 0 \
	    -from 1 -to 100 -orient horizontal \
	    -font "-*-*-*-*-*-*-8-*-*-*-*-*-*-*" -width 10
    label $t.pan.lab -text "pan"
    pack $t.pan.sc $t.pan.lab -in $t.pan -side right
    frame $t.tilt
    scale $t.tilt.sc -command "$self set_speed t" -showvalue 0 \
	    -from 1 -to 100 -orient horizontal \
	    -font "-*-*-*-*-*-*-8-*-*-*-*-*-*-*" -width 10
    label $t.tilt.lab -text "tilt"
    pack $t.tilt.sc $t.tilt.lab -in $t.tilt -side right
    frame $t.zoom
    scale $t.zoom.sc -command "$self set_speed z" -showvalue 0 \
	    -from 1 -to 100 -orient horizontal \
	    -font "-*-*-*-*-*-*-8-*-*-*-*-*-*-*" -width 10
    label $t.zoom.lab -text "zoom"
    pack $t.zoom.sc $t.zoom.lab -in $t.zoom -side right
    pack $t.pan $t.tilt $t.zoom -in $t.right -anchor e
    frame $t.presets
    pack $t.presets -in $t.right
    set tpre $t.presets
    checkbutton $tpre.setButton -command "$self toggle_preset_set" -text "set"
    pack $tpre.setButton -side bottom -anchor e
    foreach i {1 2 3 4} {
		button $tpre.b$i -text $i -command "$self presetButtonInvoke $i"
		pack  $tpre.b$i -side left -in $tpre
    }
    bind . <q> exit
}
CameraUI private hide_gui {} {
	$self instvar w_
	pack forget $w_
}
CameraUI private show_gui {} {
	$self instvar w_
	pack $w_
}
CameraUI private toggle_preset_set {} {
    $self instvar setPresets_
    if {$setPresets_} {
	set setPresets_ 0
    } else {
	set setPresets_ 1
    }
}
CameraUI private receive_update {data} {
    $self instvar scales_ zoomSpeed_ panSpeed_ tiltSpeed_ presets_ pending_
    if {[scan $data "z: %d t: %d p: %d pre: " z t p] != 3} {return}
    set pres [lrange $data 7 end]
    array set presets_ $pres
    if {$pending_ != -1} {
	return
    }
    scan $data "z: %d t: %d p: %d pre: " z t p
    if {$zoomSpeed_ != $z} {
	set zoomSpeed_ $z
	set s $scales_.zoom.sc
	catch {$s set $z}
    }
    if {$tiltSpeed_ != $t} {
	set tiltSpeed_ $t
	set s $scales_.tilt.sc
	catch {$s set $t}
    }
    if {$panSpeed_ != $p} {
	set panSpeed_ $p
	set s $scales_.pan.sc
	catch {$s set $p}
    }
}
CameraUI private presetButtonInvoke {num} {
    $self instvar setPresets_ presets_ al_
    if {$setPresets_} {
	$al_ send "set_preset $num"
    } elseif {[array names presets_ $num] == ""} {
	puts "No preset set..."
    } else {
	$al_ send "goto_preset $presets_($num)"
    }
}
CameraUI private set_speed {param perc} {
    $self instvar pending_ zoomSpeed_ panSpeed_ tiltSpeed_ remain_quiet_
    switch $param {
	z {set zoomSpeed_ $perc}
	p {set panSpeed_ $perc}
	t {set tiltSpeed_ $perc}
    }
    if {$remain_quiet_} {
	return
    }
    if {$pending_ != -1} {
	after cancel $pending_
    }
    set pending_ [after 300 $self announce_speeds]
}
CameraUI private announce_speeds {} {
    $self instvar al_ pending_ zoomSpeed_ panSpeed_ tiltSpeed_
    $al_ send "set_zoom_speed $zoomSpeed_"
    $al_ send "set_pan_speed $panSpeed_"
    $al_ send "set_tilt_speed $tiltSpeed_"
    set pending_ -1
}
CameraUI private itemPress {c} {
    set fill [lindex [$c itemconfig current -fill] 4]
    $c itemconfig current -fill blue
}
CameraUI private itemRelease {c} {
    $c itemconfig current -fill grey
}
CameraUI private itemEnter {c} {
    $c itemconfig current -fill gray
}
CameraUI private itemLeave {c} {
    $c itemconfig current -fill black
}
UDPChannel public init { {spec ""} {mtu 1024} } {
	$self next $mtu
	$self instvar net_
	set net_ [new Network]
	$net_ loopback 1
	if {$spec == ""} {
		$net_ open 0
	} elseif [regexp {^[0-9]*$} $spec] {
		$net_ open $spec
	} else {
		set spec [split $spec /]
		set len [llength $spec]
		if { $len<2 || $len>3 } {
			$self fatal "invalid spec \"$spec\"."
		}
		set addr [lindex $spec 0]
		set ports [split [lindex $spec 1] :]
		set ttl 15
		if {$len == 3} {
			set ttl [lindex $spec 2]
		}
		if {[llength $ports] == 1} {
			set port [lindex $ports 0]
			$net_ open $addr $port $ttl
		} else {
			set sport [lindex $ports 0]
			set rport [lindex $ports 1]
			$net_ open $addr $sport $rport $ttl
		}
	}
	$self network $net_
}
UDPChannel public destroy {} {
	$self instvar net_
	delete $net_
	$self next
}
UDPChannel public ttl {t} {
	$self instvar net_
	$net_ ttl $t
}
Class UDPChannel/CamCl -superclass UDPChannel
UDPChannel/CamCl public init {addrSpec parent {mtu 1500}} {
    eval [list $self] next $addrSpec $mtu
    $self instvar parent_
    set parent_ $parent
    $self send "update_state"
}
UDPChannel/CamCl private recv {addr port data size} {
    $self instvar parent_
    $parent_ receive_update $data
}
Class Trace
Trace set flags ""
Trace set onoff 0
Trace proc add {args} {
	set f [Trace set flags]
	foreach a $args {
		if {[lsearch -exact $f $a]==-1} {
			lappend f $a
		}
	}
	Trace set flags $f
}
Trace proc rm {args} {
	set f [Trace set flags]
	foreach a $args {
		set idx [lsearch -exact $f $a]
		if {$idx != -1} {
			set f [lreplace $f $idx $idx]
		}
	}
	Trace set flags $f
}
Trace proc on {} {Trace set onoff 1}
Trace proc off {} {Trace set onoff 0}
proc Trc {flag {msg ""}} {
	if ![Trace set onoff] {return}
	set t [clock format [clock seconds] -format {%H:%M:%S}]
	if {$msg == ""} {
		puts "\[$t\] Trc: $flag"
	} else {
		set f [Trace set flags]
		if {$f == "" || [lsearch $f $flag] != -1} {
			puts "\[$t\] Trc - $flag: $msg"
		}
	}
}
Class RendezvousManager -superclass {Observer Observable}
RendezvousManager public init {{speclist ""}} {
    Trc $class "--> ${class}::$proc"
    $self next
    $self instvar scopes_ rvMsgs_
    set rvMsgs_ ""
    if {$speclist == ""} {set speclist [$self get_option rendez]}
    if {$speclist == ""} {
	set s 224.2.127.253/1202/32
	$self add_spec $s
	set scopes_($s) "global"
    } else {
	foreach i [split $speclist ,] {
	    $self add_spec $i
	}
    }
}
RendezvousManager public add_spec {s} {
    Trc $class "--> ${class}::$proc"
    $self instvar rv_ local_rv_
    if [info exists rv_($s)] {return}
    set r [new Rendezvous $s]
    set rv_($s) $r
    $r attach_observer $self
    if ![info exists local_rv_] {
	set local_rv_ $s
    }
}
RendezvousManager public rm_spec {s} {
    Trc $class "--> ${class}::$proc"
    $self instvar rv_
    if {[array names rv_ $s] != ""} {
	$rv_($s) detach_observer $self
	delete $rv_($s)
	unset rv_($s)
    } else {
	puts "Error: attempted to remove bad spec `$s'"
    }
}
RendezvousManager public get_specs {} {
    $self instvar rv_
    return [array names rv_]
}
RendezvousManager public get_local_rv {} {
    Trc $class "--> ${class}::$proc"
    $self instvar local_rv_
    return $local_rv_
}
RendezvousManager public query {queryString} {
    Trc $class "--> ${class}::$proc"
    set msgs [$self query_msgs $queryString]
    if {$msgs == ""} {
	return ""
    } else {
	return [lindex $msgs 0]
    }
}
RendezvousManager public query_metadata {queryString} {
    Trc $class "--> ${class}::$proc"
    set msgs [$self query_msgs $queryString]
    if {$msgs == ""} {
	return ""
    } else {
	return [lindex $msgs 0]
    }
}
RendezvousManager public query_msgs {queryString} {
    Trc $class "--> ${class}::$proc $queryString"
    set and [string match "* & *" $queryString]
    set or [string match "* | *" $queryString]
    if {$and && $or } {
	puts "queries with both `and' (&) and `or' (|) \
		is not currently supported... returning {}."
	return ""
    }
    if {$and} {
	set msgs ""
	set q [split $queryString "&"]
	foreach field $q {
	    set field [string trim $field]
	    set msgs [$self field_query $field $msgs]
	    if {$msgs==""} {return ""}
	}
    } else {
	set msgs ""
	set q [split $queryString "|"]
	foreach field $q {
	    set field [string trim $field]
	    foreach msg [$self field_query $field] {
		if {$msg != ""} {lappend msgs $msg}
	    }
	}
	set msgs [$self uniq $msgs]
    }
    Trc $class "matching msgs = $msgs"
    return $msgs
}
RendezvousManager private field_query {qField {msgList ""}} {
    Trc $class "--> ${class}::$proc $qField $msgList"
    $self instvar rvMsgs_
    if {$msgList == ""} {
	set msgList $rvMsgs_
    }
    set results ""
    set is_not_query 0
    if {[string match !* $qField]} {
	set qField [string range $qField 1 end]
	set is_not_query 1
    }
    foreach m $msgList {
	if {[string first "$qField" [$m get_msg]] != -1} {
	    lappend results $m
	}
    }
    if {$is_not_query} {
	set newResults ""
	foreach m $msgList {
	    if {[lsearch -exact $results $m] == -1} {
		lappend newResults $m
	    }
	}
	Trace $class "-- field_query pre-NOT'd results: $results"
	set results $newResults
    }
    Trc $class "-- field_query results: $results"
    return $results
}
RendezvousManager private uniq {l} {
    Trc $class "--> ${class}::$proc"
    set uniqL ""
    foreach i $l {
	if {[lsearch -exact $i $uniqL] == -1} {
	    lappend uniqL $i
	}
    }
    return $uniqL
}
RendezvousManager public recv_msg {rspec addr port data size} {
    Trc $class "--> ${class}::$proc $rspec $data"
    $self instvar rv_ rvMsgs_
    foreach d [split $data \n] {
	set d [string trim $d]
	if {$d == ""} {continue}
	set newrvmsg [new RVMsg $data $rspec $addr/$port]
	$newrvmsg update_meta_field "time=[clock seconds]"
	set type [$newrvmsg get_type]
	set dupmsg -1
	foreach rv $rvMsgs_ {
	    if {[$newrvmsg get_msg] == [$rv get_msg]} {
		set dupmsg $rv
	    }
	}
	if {$dupmsg == -1} {
	    switch $type {
		"query" {set cache_it 0}
		default {set cache_it 1}
	    }
	    if $cache_it {
		lappend rvMsgs_ $newrvmsg
	    }
	    if {$type == "scope"} {
		$self recv_scope $newrvmsg
	    }
	} else {
	    $dupmsg update_meta_field "time=[clock seconds]"
	    delete $newrvmsg
	    set newrvmsg $dupmsg
	}
	$self notify_observers rendez_recv $newrvmsg
	$self notify_observers rendez_recv_$type $newrvmsg
    }
}
RendezvousManager private recv_scope {rv_msg} {
    Trc $class "--> ${class}::$proc"
    $self instvar local_rv_ scopes_
    set sname [$rv_msg get_field name]
    set sspec [$rv_msg get_field spec]
    if {$sname == "" || $sspec == ""} {
	puts "Improperly formatted scope msg: [$rv_msg get_msg]"
    }
    set scopes_($sspec) $sname
    $self add_spec $sspec
    if {$local_rv_ == [$rv_msg rspec]} {
	set local_rv_ $sspec
    }
}
RendezvousManager public get_spec_name {spec} {
    Trc $class "--> ${class}::$proc"
    set r [$self query "scope: & spec=$spec"]
    set n [$r get_field name]
    if {$n == ""} {return $spec}
    return $n
}
RendezvousManager public start {spec msg} {
    Trc $class "--> ${class}::$proc `$spec' announcing `$msg'"
    $self instvar rv_
    if {$spec == ""} {set spec [$self get_local_rv]}
    if [info exists rv_($spec)] {
	$rv_($spec) start $msg
    } else {
	puts "Error: not connected to `$spec': won't send msg to that addr."
    }
}
RendezvousManager public stop {spec msg} {
    Trc $class "--> ${class}::$proc `$spec' stop announcing `$msg'"
    $self instvar rv_
    if {$spec == ""} {set spec [$self get_local_rv]}
    if [info exists rv_($spec)] {
	$rv_($spec) stop $msg
    } else {
	puts "Error: not connected to `$spec': can't stop msgs there."
    }
}
Class Rendezvous -superclass {Observable AnnounceListenManager}
Rendezvous public init {spec} {
    Trc $class "--> ${class}::$proc"
    eval [list $self] next $spec
    $self instvar msgs_ spec_ snet_ rnet_
    set spec_ $spec
    if {$snet_ != ""} {$self ttl 16}
    $self set_timeout 600
    set msgs_ ""
    set t [new Timer/Adaptive/ConstBW 10000]
    $t randomize
    $self timer $t
    $self process_timeouts
}
Rendezvous private recv_announcement {addr port data size} {
    Trc $class "--> ${class}::$proc $data"
    $self instvar spec_
    set t [$self get_timer]
    $t sample_size $size
    foreach msg [split $data \n] {
	$self update_msg $msg
	$self notify_observers recv_msg $spec_ $addr $port $msg $size
    }
}
Rendezvous private update_msg {newMsg} {
    Trc $class "--> ${class}::$proc"
    $self instvar msgs_ msgtimestamps_
    set msgtimestamps_($newMsg) [clock seconds]
    if {[lsearch  $msgs_ $newMsg] != -1} {
	lappend $msgs_ $newMsg
	[$self get_timer] incr_nsrcs
    }
}
Rendezvous private process_timeouts {} {
    Trc $class "--> ${class}::$proc"
    $self instvar msgs_ msgtimestamps_ timeout_
    if {$timeout_ <= 0} {
	return
    }
    set currTime [clock seconds]
    foreach i $msgs_ {
	set t $msgtimestamps_($i)
	if {[expr $currTime - $t] > $timeout_} {
	    puts "Rendezvous: timing out msg $i"
	    set ind [lindex $i $msgs_]
	    set msgs_ [lreplace $msgs_ $ind $ind]
	    unset msgtimestamps_($i)
	    [$self get_timer] incr_nsrcs -1
	}
    }
    after 5000 "catch {$self process_timeouts}"
}
Rendezvous public set_timeout {seconds} {
    Trc $class "--> ${class}::$proc"
    $self instvar timeout_
    set timeout_ $seconds
}
Class RVMsg
RVMsg public init {msg rspec sender_spec} {
    $self instvar msg_ rspec_ sender_spec_ metadata_
    set msg_ $msg
    set rspec_ $rspec
    set sender_spec_ $sender_spec
    set metadata_ "time=[clock seconds]"
}
RVMsg public get_type {} {
    Trc $class "--> ${class}::$proc"
    $self instvar msg_
    set t [string trim [lindex $msg_ 0]]
    set lst [split $t :]
    if {[lindex $lst end] == ""} {
	return [lindex [split $t :] 0]
    }
    return ""
}
RVMsg public fields {} {
    Trc $class "--> ${class}::$proc"
    $self instvar msg_
    set flist ""
    set m [lrange $msg_ 1 end]
    foreach i $m {
	lappend flist [lindex [split $i =] 0]
    }
    return $flist
}
RVMsg public get_field {field} {
    Trc $class "--> ${class}::$proc"
    $self instvar msg_
    set i [lsearch $msg_ "*$field=*"]
    if {$i == -1} {
	return ""
    } else {
	set attVal [lindex $msg_ $i]
	set idx [string first = $attVal]
	return [string range $attVal [expr $idx+1] end]
    }
}
RVMsg public has_field {f} {
    Trc $class "--> ${class}::$proc"
    $self instvar msg_
    set i [lsearch $msg_ "*$field=*"]
    if {$i == -1} {
	return 0
    } else {
	return 1
    }
}
RVMsg public get_msg {} {
    $self instvar msg_
    return $msg_
}
RVMsg public rspec {} {
    $self instvar rspec_
    return $rspec_
}
RVMsg public sender_spec {} {
    $self instvar sender_spec_
    return $sender_spec_
}
RVMsg public sender_addr {} {
    $self instvar sender_spec_
    return [lindex [split $sender_spec_ /] 0]
}
RVMsg public sender_port {} {
    $self instvar sender_spec_
    return [lindex [split $sender_spec_ /] 1]
}
RVMsg public get_metadata {} {
    $self instvar metadata_
    return $metadata_
}
RVMsg public set_metadata {m} {
    $self instvar metadata_
    set metsdata_ $m
}
RVMsg public update_meta_fields {fields} {
    foreach attval $fields {
	$self update_meta_field $attval
    }
}
RVMsg public update_meta_field {m} {
    $self instvar metadata_
    set f [lindex [split $m =] 0]
    set i [lsearch $metadata_ "*$f=*"]
    if {$i == -1} {
	set metsdata_ "$metadata_ $m"
    } else {
	set metadata_ [lreplace $metadata_ $i $i $m]
    }
}
RVMsg public rm_meta_field {f} {
    $self instvar metadata_
    set i [lsearch $metadata_ "*$f=*"]
     if {$i == -1} {
	 return 0
    } else {
	set metadata_ [lreplace $metadata_ $i $i]
	return 1
    }
}
RVMsg public get_meta_field {f} {
    $self instvar metadata_
    set i [lsearch $metadata_ "*$f=*"]
    if {$i == -1} {
	return ""
    } else {
	return [lindex [split [lindex $metadata_ $i] =] 1]
    }
}
RVMsg public has_meta_field {f} {
    Trc $class "--> ${class}::$proc"
    $self instvar metadata_
    set i [lsearch $metadata_ "*$field=*"]
    if {$i == -1} {
	return 0
    } else {
	return 1
    }
}
RVMsg private data {} {
    $self instvar msg_ rspec_ sender_spec_
    return "$rspec_ $sender_spec_ $msg_"
}
Class RemoteCamera
RemoteCamera public init {userWindow w} {
    $self instvar uw_ addr_ camCli_ w_ as_ camMngr_ showUI_ isalloc_
    set uw_ $userWindow
    set w_ $w
    set camMngr_ [CameraManager info instances]
    if {$camMngr_ == ""} {
	puts "RemoteCamera::init: CameraManager should be allocated...?!?"
	return
    }
    set cname "[[[$uw_ set as_] set src_] sdes cname]"
    set addr_ [$camMngr_ get_addr_for $cname]
    if {$addr_ == ""} {
	set isalloc_ 0
	return
    } else {
	set isalloc_ 1
    }
    bind $w.frame.video <ButtonPress-1> "$self click \"%x %y\""
    bind $w.frame.video <ButtonRelease-1> "$self clickup"
    frame $w.camFrame
    set camCli_ [new CameraUI $w.camFrame $addr_]
    set showUI_ 0
}
RemoteCamera private isAllocated {} {
    $self instvar isalloc_
    return $isalloc_
}
RemoteCamera private click {xy} {
    $self instvar hei_ wid_ camCli_
    $self update_hei_wid
    set al [$camCli_ set al_]
    set x [lindex $xy 0]
    set y [lindex $xy 1]
    set normH [expr ($y*1.0)/$hei_]
    set normW [expr ($x*1.0)/$wid_]
    if {$normH > 0.6} {
	if {$normW > 0.6} {
	    $al send move_downright
	} elseif {$normW < 0.4 } {
	    $al send move_downleft
	} else {
	    $al send move_down
	}
    } elseif {$normH < 0.4 } {
	if {$normW > 0.6} {
	    $al send move_upright
	} elseif {$normW < 0.4 } {
	    $al send move_upleft
	} else {
	    $al send move_up
	}
    } else {
	if {$normW > 0.6} {
	    $al send move_right
	} elseif {$normW < 0.4 } {
	    $al send move_left
	} elseif {$normH > 0.5} {
	    $al send zoom_out
	} else {
	    $al send zoom_in
	}
    }
}
RemoteCamera private clickup {} {
    $self instvar camCli_
    set al [$camCli_ set al_]
    $al send "move_stop"
    $al send "zoom_stop"
}
RemoteCamera private update_hei_wid {} {
    $self instvar uw_ hei_ wid_
    set vidWin [[$uw_ set vw_] window]
    set hei_ [$vidWin height]
    set wid_ [$vidWin width]
}
RemoteCamera private toggleUI {} {
    $self instvar showUI_ w_
    if $showUI_ {
	pack forget $w_.camFrame
	set showUI_ 0
    } else {
	pack $w_.camFrame -fill both
	set showUI_ 1
    }
}
Class CameraManager -superclass Observer
CameraManager public init {} {
    $self next
    $self instvar rcList_ rv_ camList_
    set rcList_ ""
    set rv_ [new RendezvousManager]
    $rv_ attach_observer $self
}
CameraManager public destroy {} {
    $self instvar rv_
    $rv_ detach_observer $self
    $self next
}
CameraManager private add {camName camAddr} {
    $self instvar camList_
    if {([array names camList_ $camName] == "") || \
	    ($camList_($camName) != $camAddr)} {
    }
    set camList_($camName) $camAddr
}
CameraManager private rm {name} {
    $self instvar camList_
    if {[$self get $name] != ""} {
	unset camList_($name)
    }
}
CameraManager private get {name} {
    $self instvar camList_
    if {[array names camList_ $name] != ""} {
	return $camList_($name)
    } else {
	return ""
    }
}
CameraManager private get_addr_for {src} {
    set retVal [$self get $src]
    if {$retVal == ""} {
	set srcaddr [lindex [split $src "@"] 1]
	set retVal [$self get $srcaddr]
    }
    return $retVal
}
CameraManager private rendez_recv_camera {rvmsg} {
    $self instvar camData_
    set data [$rvmsg get_msg]
    set msgLine [lrange $data 1 end]
    regsub -all ":" $msgLine " " datalist
    set cn [lindex $datalist 1]
    if {[lindex $datalist 0] == "camName"} {
	if ![info exists camData_($cn)] {set camData_($cn) ""}
	if {[lindex $datalist 2] == "videoIn"} {
	    set i [lsearch $camData_($cn) "videoIn"]
	    while {$i != -1} {
		set camData_($cn) [lreplace $camData_($cn) $i $i]
		set i [lsearch $camData_($cn) "videoIn"]
	    }
	    foreach i [array names camData_] {
		set ind [lsearch $camData_($i) [lindex $msgLine 1]]
		if {$ind != -1} {
		    set camData_($i) [lreplace $camData_($i) $ind $ind]
		}
	    }
	}
    }
    if {([lindex $datalist 0] == "camCtrl") && \
	    ([lindex $datalist 2] == "cname")} {
	set camAddr [lindex $datalist 1]
	set cname [lindex $datalist 3]
	$self add $cname $camAddr
    }
    if {[lindex $datalist 0] == "camName"} {
	set cn [lindex $datalist 1]
	set entry [lindex $msgLine 1]
	if {[lsearch $camData_($cn) $entry] == -1} {
	    lappend camData_($cn) $entry
	    set camData_($cn) [lsort $camData_($cn)]
	}
	set camdata $camData_($cn)
	if {[llength $camdata] >= 2} {
	    regsub -all ":" $camdata " " cdl
	    set camAddr [lindex $cdl 1]
	    for {set i 1} {$i < [llength $camdata]} {incr i} {
		set cname [lindex $cdl [expr ($i*2)+1]]
		$self add $cname $camAddr
	    }
	}
    }
}
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-actual { {scale 1} } {
    $self instvar as_
    set src [$as_ set src_]
    set decoder [$src handler]
    set w [expr int($scale * [$decoder width])]
    set h [expr int($scale * [$decoder height])]
    $self resize $w $h
}
UserWindow instproc resize-zoom {scale} {
    $self instvar path_ vw_ as_
    global size$path_
    set w [expr int([[$vw_ window] width] * $scale)]
    set h [expr int([[$vw_ window] height] * $scale)]
    if {($w < 8) || ($h < 8)} {
        return
    }
    set src [$as_ set src_]
    set decoder [$src handler]
    set actualWidth [$decoder width]
    set actualHeight [$decoder height]
    if {($w == $actualWidth) && ($h == $actualHeight)} {
        set size$path_ actual
    } elseif {($w == $actualWidth / 2) && ($h == $actualHeight / 2)} {
        set size$path_ half
    } elseif {($w == $actualWidth * 2) && ($h == $actualHeight * 2)} {
        set size$path_ double
    } else {
        set size$path_ ${w}x${h}
    }
    $self resize $w $h
}
UserWindow instproc resize { w h } {
    $self instvar vw_ 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 {}} {showMenus 0}} {
    $self next $as
    $self instvar asm_ usecues_
    $self tkvar switched_ timed_ slow_ hw_ drop_even_
    set asm_ $asm
    set usecues_ $usecues
    set switched_ 0
    set timed_ 0
    set slow_ 0
    set hw_ 0
    set drop_even_ 1
    set blocky_ 0
    if { $cb != "" && $cb != "0" } {
        $self create-window $w $as 1 $showMenus
    } else {
        $self create-window $w $as 0 $showMenus
    }
    $asm_ instvar autoplace_
    if {[info exists autoplace_]} {
        $asm_ autoplace register $as $self
    }
}
UserWindow instproc destroy {} {
    $self instvar asm_ 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
    $asm_ instvar autoplace_
    if {[info exists autoplace_]} {
        $asm_ autoplace remove $as_
    }
    $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 \$heuristics]"
    Colormodel/$type instproc alloc-renderer { win dec {heuristics 0} } $body
    Renderer/$type set nb 0
}
VideoWidget instproc attach-decoder { src colorModel useHW {useHeuristics 0} } {
    set d [$src handler]
    if {$d==""} {
        global src_nickname
        if ![info exists src_nickname($src)] {
            set name [$src sdes cname]
        } else {
            set name $src_nickname($src)
        }
        puts stderr "can't attach-decoder: no handler for src $name;\
                     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] $useHeuristics]
    }
    if $is_slow_ {
        $target_ update-interval [$self get_option stampInterval]
    }
    $window_ adjust-voff $d
    $d attach $target_
}
VideoWidget instproc get_renderer { } {
    $self instvar target_
    if {[info exists target_]} {
	return $target_
    } else {
	return ""
    }
}
VideoWidget instproc set_heuristics { v } {
    $self instvar target_
    $target_ heuristics $v
}
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]
	if {[info exists target_]} {
		$d detach $target_
   	delete $target_
   	unset target_
	}
}
UserWindow instproc create-window { w as useCB {showMenus 1}} {
    set f [$self get_option smallfont]
    set uid [uniqueID]
    $self instvar asm_ usecues_ path_
    if { $w=={} } {
        set w .vw$uid
        Application toplevel $w
    } else {
        frame $w
    }
    set path_ $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
    set size actual
    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 $userwin_size($as)
    }
    set src [$as set src_]
    set decoder [$src handler]
    set width [$decoder width]
    set height [$decoder height]
    switch -regexp -- $size {
	"half" {
	    set width [expr $width/2]
	    set height [expr $height/2]
	}
	"double" {
	    set width [expr $width*2]
	    set height [expr $height*2]
	}
	"actual" { }
	"[0-9]+x[0-9]+" {
	    set L [split $size x]
	    set width [lindex $L 0]
	    set height [lindex $L 1]
	}
	default {
	    set size "actual"
	}
    }
    set vw_ [new VideoWidget $w.frame.video $width $height]
    set size$w $size
    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 {Enable Smoothing} \
	-command "$self set_heuristics" \
	-font $f -variable [$self tkvarname enable_heuristics_]
    $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 separator
    $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 cascade -label "Switch options..." -menu $m.opt \
        -font $f
    menu $m.opt -tearoff no
    $self instvar switch_list_
    global ${self}_switchname
    foreach s [$asm_ active-sources] {
        set ${self}_switchname($s) 1
        lappend switch_list_ $s
        $m.opt add checkbutton -label \
            [[$asm_ get_activesource $s] name] \
            -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 "Half Size" \
	-command "$self resize-actual 0.5" \
	-font $f -value half -variable size$w
    $m add radiobutton -label "Actual Size" \
	-command "$self resize-actual" \
	-font $f -value actual -variable size$w -accelerator =
    $m add radiobutton -label "Double Size" \
	-command "$self resize-actual 2" \
	-font $f -value double -variable size$w
    set submenu $m.advanced
    menu $submenu
    $m add cascade -label "Other" -font $f -menu $submenu
    $m add separator
    $m add command -label "Reduce" \
        -command "$self resize-zoom 0.5" -font $f -accelerator -
    $m add command -label "Enlarge" \
        -command "$self resize-zoom 2" -font $f -accelerator +
    $submenu add radiobutton -label QCIF -command "$self resize 176 144" \
        -font $f -value 176x144 -variable size$w
    $submenu add radiobutton -label CIF -command "$self resize 352 288" \
        -font $f -value 352x288 -variable size$w
    $submenu add radiobutton -label 4CIF -command "$self resize 704 576" \
        -font $f -value 704x576 -variable size$w
    $submenu add separator
    $submenu add radiobutton -label "1/16 NTSC" \
        -command "$self resize 160 120" \
        -font $f -value 160x120 -variable size$w
    $submenu add radiobutton -label "1/4 NTSC" \
        -command "$self resize 320 240" \
        -font $f -value 320x240 -variable size$w
    $submenu add radiobutton -label NTSC \
        -command "$self resize 640 480" \
        -font $f -value 640x480 -variable size$w
    $submenu add separator
    $submenu add radiobutton -label "1/16 NTSC 601" \
        -command "$self resize 180 120" \
        -font $f -value 180x120 -variable size$w
    $submenu add radiobutton -label "1/4 NTSC 601" \
        -command "$self resize 360 240" \
        -font $f -value 360x240 -variable size$w
    $submenu add radiobutton -label "NTSC 601" \
        -command "$self resize 720 480" \
        -font $f -value 720x480 -variable size$w
    $submenu add separator
    $submenu add radiobutton -label "1/16 PAL" \
        -command "$self resize 192 144" \
        -font $f -value 192x144 -variable size$w
    $submenu add radiobutton -label "1/4 PAL" \
        -command "$self resize 384 288" \
        -font $f -value 384x288 -variable size$w
    $submenu 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
    if [$self yesno camctrl] {
        $self instvar camCtrlAgent_
        set camCtrlAgent_ [new RemoteCamera $self $w]
        if ![$camCtrlAgent_ isAllocated] {
            destroy $camCtrlAgent_
            unset camCtrlAgent_
        } else {
            button $w.bar.camctrls -text CamCtrls -font $f \
                -width 8 -highlightthickness 0 \
                -command "$camCtrlAgent_ toggleUI"
            pack $w.bar.camctrls -side left
        }
    }
    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
    }
    if {$showMenus} {
	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"
    wm protocol $w WM_DELETE_WINDOW "$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"
    bind $w <equal> "$m invoke 1"
    bind $w <minus> "$m invoke 5"
    bind $w <plus> "$m invoke 6"
    $as attach-window $self
}
UserWindow instproc path {} {
    $self instvar path_
    return $path_
}
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 ${self}_switchname
    set new_switch_list {}
    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 \
            [[$asm_ get_activesource $s] name] \
            -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_ get_activesource $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
    }
}
UserWindow instproc set_heuristics {} {
    $self instvar vw_
    $vw_ set_heuristics [$self use_heuristics]
}
UserWindow instproc set_drop_even {} {
    $self tkvar drop_even_
    $self instvar as_
    set src [$as_ set src_]
    set fmt [$src format_name]
    if { $fmt == "jpeg" } {
	set d [$src handler]
	$d drop-even $drop_even_
    }
}
UserWindow instproc use_heuristics {} {
    $self tkvar enable_heuristics_
    if $enable_heuristics_ {
	return 1
    } else {
	return 0
    }
}
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
	radiobutton $dummy
	$self set_widget_default_ $dummy { -selectcolor }
	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 destroy { } {
	$self instvar path_ widget_proc_
	catch {rename $path_ {}}
	catch {rename $widget_proc_ {}}
	$self next
}
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 2]
	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 video"
	$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_] get_activesource $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_
	}
}
VideoBox public get_activesource {} {
	return [$self set as_]
}
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 name {} {
	global src_nickname
	$self instvar src_
	return $src_nickname($src_)
}
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 {{x false} {y false} {showMenus true} {scale 1}} {
	$self instvar asm_ localChannel_
    if {!$scale} {
        return ""
    }
	set uw [new UserWindow $asm_ $self [$self yesno useCues] $localChannel_ {} $showMenus]
	if {$x != "false" && $y != "false"} {
		wm geometry [$uw path] "+$x+$y"
	}
	$uw resize-zoom $scale
	return $uw
}
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] [$uw use_heuristics]
	$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 source {} {
	return [$self set src_]
}
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: FIXME"
		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: FIXME"
		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_
	return [$self create_user_window]
}
ActiveSource public place {x y {scale 1}} {
    foreach uw [$self user-windows] {
	if {[$uw attached-source] == "$self"} {
	    return
	}
    }
    $self instvar ui_
    return [$self create_user_window $x $y false $scale]
}
Class ActiveSourceManager -superclass {Observer} -configuration {
	tile 1
}
ActiveSourceManager public init {ui w videoAgent list_direction localChannel {autoplace 0}} {
	$self next
	$self instvar ui_ videoAgent_ localChannel_ autoplace_
	set ui_ $ui
	set videoAgent_ $videoAgent
	set localChannel_ $localChannel
	set autoplace_ $autoplace
	$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_ autoplace_
	set as [new ActiveSource $self $ui_ $grid_.$src $src $localChannel_]
	if { $autoplace_ } {
		set coords_scale [$self autoplace add $as]
		$as place [lindex $coords_scale 0] \
			[lindex $coords_scale 1] \
			[lindex $coords_scale 2]
	}
	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 uw $L {
		$as attach-window $uw
		[$uw video-widget] redraw
	}
	extout_attach_src $src $extoutList
	return
}
ActiveSourceManager public trigger_format_all { } {
	foreach s [$self active-sources] {
		$self trigger_format $s
	}
}
ActiveSourceManager public get_activesource src {
	$self instvar active_
	if [info exists active_($src)] {
		return $active_($src)
	} else {
		return ""
	}
}
ActiveSourceManager instproc switch-agent {new_agent} {
	$self instvar videoAgent_
	set videoAgent_ $new_agent
}
ActiveSourceManager instproc set_autoplace {} {
    $self tkvar autoplaceNewSources
    if { $autoplaceNewSources } {
	$self autoplace_on
    } else {
	$self autoplace_off
    }
}
ActiveSourceManager instproc toggle_autoplace {} {
    $self instvar autoplace_
    if { $autoplace_ } {
	$self autoplace_off
    } else {
	$self autoplace_on
    }
}
ActiveSourceManager instproc autoplace_off {} {
    $self instvar autoplace_
    set autoplace_ false
}
ActiveSourceManager instproc autoplace_on {} {
    $self instvar autoplace_ active_
    if {$autoplace_} return
    foreach src [$self active-sources] {
	set as $active_($src)
	foreach uw [$as user-windows] {
	    if {[$uw attached-source] == "$as"} {
		$uw destroy
	    }
	}
    }
    foreach src [$self active-sources] {
	set as $active_($src)
	set coords_scale [$self autoplace add $as]
	$as place [lindex $coords_scale 0] \
		[lindex $coords_scale 1] \
		[lindex $coords_scale 2]
    }
    set autoplace_ true
}
ActiveSourceManager instproc autoplace {cmd as {uw false}} {
    global mutebutton
    $self instvar asources_ windows_ mon_ xbase_ ybase_ nextx_ nexty_ maxy_ xoffset_ yoffset_ xincr_ yincr_ mon_list_ screen_width_ screen_height_ minx_ miny_ maxx_ maxy_ framesize_ titlebarsize_
    set cross_monitors 0
    if {$cmd == "add"} {
	if {![info exists mon_list_]} {
	    set mon_list_ [get_monitorinfo]
	    if { $mon_list_ == "" } {
		set mon_list_ [list [list 0 0 [winfo screenwidth .] [winfo screenheight .]] [list 0 0 [winfo screenwidth .] [winfo screenheight .]]]
	    }
	    set v_coords [lindex $mon_list_ 0]
	    set minx_ [lindex $v_coords 0]
	    set miny_ [lindex $v_coords 1]
	    set maxx_ [lindex $v_coords 2]
	    set maxy_ [lindex $v_coords 3]
	    set mon_list_ [lsort [lrange $mon_list_ 1 end]]
	    set screen_width_ [expr $maxx_ - $minx_ + 1]
	    set screen_height_ [expr $maxy_ - $miny_ + 1]
        set wm_geom [split [wm geometry .] {+}]
        set winfo_geom [split [winfo geometry .] {+}]
        if {[lindex $wm_geom 1] != [lindex $winfo_geom 1] && \
            [lindex $wm_geom 2] != [lindex $winfo_geom 2]} \
        {
            set framesize_ [expr [lindex $winfo_geom 1] - [lindex $wm_geom 1]]
            set titlebarsize_ [expr [lindex $winfo_geom 2] - [lindex $wm_geom 2]]
        } else {
            set framesize_ [expr [winfo rootx .] - [winfo x .]]
            set titlebarsize_ [expr [winfo rooty .] - [winfo y .]]
        }
	}
	if {![array size asources_]} {
	    set mon_   0
	    set xbase_ [expr $minx_ - $framesize_]
	    set ybase_ [expr $miny_ - $titlebarsize_]
	    set nextx_ $xbase_
	    set nexty_ $ybase_
	    set maxy_ $nexty_
	    set xincr_ 10
	    set yincr_ 20
	    set xoffset_ $framesize_
	    set yoffset_ $titlebarsize_
	}
	set retx [expr $nextx_ + $xoffset_]
	set rety [expr $nexty_ + $yoffset_]
	set scale 1
    if {$mutebutton([$as source])} {
        return "$retx $rety 0"
    }
	if {[info exists asources_($as)]} {
	    return $asources_($as)
	}
	set src [$as source]
	set decoder [$src handler]
	set width [expr int([$decoder width] * $scale)]
	set height [expr int([$decoder height] * $scale)]
	if {$cross_monitors || [llength $mon_list_] == 1} {
	    if {[expr $retx + $width] >= $screen_width_} {
		set retx [expr $xbase_ + $xoffset_]
		set rety [expr $maxy_ + $yoffset_]
		set nexty_ $maxy_
	    }
	    if {[expr $rety + $height] >= $screen_height_} {
		set xbase_ [expr $xbase_ + $xincr_]
		set ybase_ [expr $ybase_ + $yincr_]
		set retx [expr $xbase_ + $xoffset_]
		set rety [expr $ybase_ + $yoffset_]
		set nexty_ $ybase_
		set maxy_ $ybase_
	    }
	} else {
	    set placed 0
	    set looped [expr $mon_ == 0]
	    while {!$placed} {
		if {$mon_ < 0 || $mon_ >= [llength $mon_list_]} {
		    set mon_ 0
		}
		set v_coords [lindex $mon_list_ $mon_]
		set minx [lindex $v_coords 0]
		set miny [lindex $v_coords 1]
		set maxx [lindex $v_coords 2]
		set maxy [lindex $v_coords 3]
		set placed 1
		if {[expr $mon_ + 1] == [llength $mon_list_] && $looped} {
		    break;
		}
		if {[expr $retx + $width] >= $maxx} {
		    set retx [expr $minx + $xbase_ + $xoffset_]
		    set rety [expr $maxy_ + $yoffset_]
		    set nexty_ $maxy_
		    set placed 0
		}
		if {[expr $rety + $height] >= $maxy} {
		    incr mon_
		    if {$mon_ == [llength $mon_list_]} {
			set mon_ 0
			set xbase_ [expr $xbase_ + $xincr_]
			set ybase_ [expr $ybase_ + $yincr_]
			set looped 1
		    }
		    set v_coords [lindex $mon_list_ $mon_]
		    set minx [lindex $v_coords 0]
		    set miny [lindex $v_coords 1]
		    set retx [expr $minx + $xbase_ + $xoffset_]
		    set rety [expr $miny + $ybase_ + $yoffset_]
		    set nexty_ [expr $miny + $ybase_]
		    set maxy_ [expr $miny + $ybase_]
		    set placed 0
		}
	    }
	}
	set nextx_ [expr $retx + $width]
	if {[expr $rety + $height] > $maxy_} {
	    set maxy_ [expr $rety + $height]
	}
	set asources_($as) "$retx $rety $scale"
	return $asources_($as)
    }
    if {$cmd == "remove"} {
	array unset asources_ $as
	array unset windows_ $as
    }
    if {$cmd == "register" && $uw != "false"} {
	set windows_($as) $uw
    }
}
Class AudioArbiter -superclass {CoordinationBus Observable} -configuration {
	idleDropTime 20
	defaultPriority 100
}
AudioArbiter public init agent {
	$self next
	$self instvar agent_ activity_ id_ priority_ hold_
	set agent_ $agent
	set hold_ 0
	$self register audio-demand someone_demands
	$self register audio-request someone_requests
	$self register audio-release someone_released
	set activity_ 0
	set priority_ [$self get_option defaultPriority]
	set id_ [after 5000 "$self timeout"]
}
AudioArbiter instproc destroy {} {
	$self instvar id_
	after cancel $id_
	$self next
}
AudioArbiter instproc set-pri p {
	$self instvar priority_
	set priority_ $p
}
AudioArbiter public release {} {
	$self instvar agent_
	$agent_ release
	$self indicator_update
}
AudioArbiter public someone_requests { pid pri } {
	$self instvar agent_ priority_ hold_
	global unmuted outputMutebutton
	if { [$agent_ have_audio] && !$hold_ && ($pri > $priority_) } {
		$self give_it_up $pid
	}
}
AudioArbiter private give_it_up pid {
	$self release
	$self send audio-release $pid
}
AudioArbiter public someone_demands pid {
	$self instvar agent_
	if { [$agent_ have_audio] } {
		$self give_it_up $pid
	}
}
AudioArbiter public someone_released pid {
	if { $pid == [pid] } {
		$self grab
		$self notify_observers arbiter_snatch
	}
}
AudioArbiter instproc indicator_update { } {
	$self instvar agent_ activity_ hold_
	if [$agent_ have_audio] {
		$self notify_observers arbiter_have 1
		$agent_ reset_source_offsets
	} else {
		$self notify_observers arbiter_have 0
		set hold_ 0
	}
	set activity_ [$agent_ unix_time]
}
AudioArbiter public grab {} {
	$self instvar agent_
	$agent_ obtain
	$self indicator_update
}
AudioArbiter public request {} {
	$self instvar agent_ priority_
	$agent_ obtain
	if [$agent_ have_audio] {
		$self indicator_update
	} else {
		$self send audio-request [pid] $priority_
	}
}
AudioArbiter public demand {} {
	$self instvar agent_
	$agent_ obtain
	if [$agent_ have_audio] {
		$self indicator_update
	} else {
		$self send audio-demand [pid]
	}
}
AudioArbiter public hold v {
	$self instvar hold_ agent_
	set hold_ $v
	if { $hold_ && ![$agent_ have_audio] } {
		$self demand
	}
}
AudioArbiter private timeout {} {
	$self instvar activity_ agent_ id_ hold_
	if { [$agent_ have_audio] && !$hold_ } {
		if [$agent_ is_active] {
			$agent_ clear_active
			set activity_ [$agent_ unix_time]
		} else {
			set r [$self get_option idleDropTime]
			if { $r && [$agent_ unix_time] - $activity_ > \
			    $r } {
				$self give_it_up 0
			}
		}
	}
	set id_ [after 5000 "$self timeout"]
}
Class AudioPanel
AudioPanel instproc init { top agent } {
	$self add_default audioFont [$self get_option helv10]
	$self add_default ctrlFont [$self get_option helv10b]
	global tcl_platform
	if {$tcl_platform(platform) != "windows"} {
		option add *VatVU.background gray85 startupFile
	}
	option add *VatVU.foreground black startupFile
	option add *VatVU.peak gray50 startupFile
	option add *VatVU.hot firebrick1 startupFile
	option add *VatVU.hotLevel 90 startupFile
	if { [winfo depth .] == 1 } {
		option add *VatVU.background white startupFile
		option add *VatVU.hot gray50 startupFile
	}
	frame $top.panel
	pack $top.panel -side right -fill y
	set w $top.panel.audio
	frame $w
	pack $w -expand 1 -fill y
	option add *AudioPanelPane*borderWidth 2 widgetDefault
	frame $w.spkr -borderwidth 0 -class AudioPanelPane
	$self instvar spkr_meter_ mike_meter_ agent_ arbiter_
	set agent_ $agent
	set arbiter_ [new AudioArbiter $agent]
	set spkr_meter_ [$self mk.pane $w.spkr output speaker listen]
	frame $w.mike -borderwidth 0 -class AudioPanelPane
	set mike_meter_ [$self mk.pane $w.mike input mike talk]
	pack $w.spkr $w.mike -side left -expand 1 -fill y
	set f [$self get_option ctrlFont]
	checkbutton $top.panel.button -text "Keep Audio" -font $f \
		-command "$self invoke_keep_audio" \
		-variable [$self tkvarname audioHeld] -anchor c \
		-relief ridge -borderwidth 2 -highlightthickness 0
	global keepAudioButton
	set keepAudioButton $top.panel.button
	$self invoke_keep_audio
	pack $top.panel.button -fill x -side bottom -anchor c -before $w
}
AudioPanel instproc mute_invoke { which } {
	$self instvar agent_ arbiter_ $which\_mute_
	if { "[[$self set $which\_mute_] get-val]" == "unmuted" } {
		$agent_ set_$which\_mute 0
		if ![$agent_ have_audio] {
			$arbiter_ demand
		}
	} else {
		$agent_ set_$which\_mute 1
	}
}
AudioPanel instproc invoke_keep_audio {} {
	$self instvar arbiter_
	$self tkvar audioHeld
	$arbiter_ hold $audioHeld
}
AudioPanel instproc setgain { which level } {
	$self instvar agent_
	$agent_ set_$which\_gain $level
}
AudioPanel instproc enable_meters yesno {
	$self instvar spkr_meter_ mike_meter_ agent_
	if $yesno {
		$agent_ bind_transducer output $spkr_meter_
		$agent_ bind_transducer input $mike_meter_
	} else {
		$agent_ bind_transducer output ""
		$agent_ bind_transducer input ""
		$spkr_meter_ set_level 0.
		$mike_meter_ set_level 0.
	}
}
AudioPanel instproc lookup_bitmap { name } {
	switch -glob $name {
		mike { return mike }
		mic* { return mike }
		speaker { return speaker }
		jack { return headphone }
		headphone { return headphone }
		lineout2 { return lineout2 }
		lineout3 { return lineout3 }
		lineout* { return lineout }
		line*in2 { return linein2 }
		cd*       { return linein2 }
		linein3 { return linein3 }
		line*in { return linein }
		mix*    { return linein3 }
		synth*  { return linein3 }
		default { return linein3 }
	}
}
AudioPanel instproc setPort { which button scale port } {
	$self instvar agent_
	$agent_ set_$which\_port $port
	$button configure -bitmap [$self lookup_bitmap $port]
	$scale set [$agent_ get_$which\_gain]
}
AudioPanel instproc changePort { which button scale } {
	$self instvar agent_
	set ports [$agent_ get_$which\_ports]
	set n [$agent_ get_$which\_portno]
	if { $n < 0 } {
		return
	}
	incr n
	if { $n >= [llength $ports] } {
		set n 0
	}
	$self setPort $which $button $scale [lindex $ports $n]
}
AudioPanel instproc mk.pane { w which bitmap label } {
	set f [$self get_option audioFont]
	frame $w.mute -relief raised -borderwidth 1
	set cb [new CheckButton $w.mute.b -text $label -font $f -relief ridge \
		-anchor c \
		-command "$self mute_invoke $which" \
		-onvalue unmuted \
		-offvalue muted \
		-highlightthickness 0]
	$cb set-val unmuted
	$self instvar $which\_mute_
	set $which\_mute_ $cb
	pack $w.mute.b -expand 1 -fill x
	frame $w.select -relief raised
	button $w.select.b -bitmap $bitmap -relief flat \
		-command "$self changePort $which $w.select.b $w.frame.scale" \
		-height 24 -highlightthickness 1
	pack $w.select.b -expand 1 -fill x
	$self instvar agent_
	if { [llength [$agent_ get_$which\_ports]] <= 1 } {
		$w.select.b configure -state disabled
	}
	frame $w.frame -relief raised
	set meter [new Meter/Linear $w.frame.meter]
	scale $w.frame.scale -orient vertical \
			-showvalue 0 \
			-from 256 -to 0 \
			-command "$self setgain $which" \
			-relief groove -length 200 \
			-highlightthickness 0
	global $which\Scale $which\PortButton
	set $which\Scale $w.frame.scale
	set $which\PortButton $w.select.b
	pack $w.frame.meter $w.frame.scale -side left -expand 1 -fill y
	pack $w.mute $w.select -fill x
	pack $w.frame -expand 1 -fill both
	return $meter
}
AudioPanel instproc ptt-press {} {
	$self instvar input_mute_
	if { "[$input_mute_ get-val]" == "muted" } {
		$input_mute_ invoke
	}
}
AudioPanel instproc ptt-release {} {
	$self instvar input_mute_
	if { "[$input_mute_ get-val]" == "unmuted" } {
		$input_mute_ invoke
	}
}
AudioPanel instproc set_recv_only v {
	$self instvar input_mute_
	if $v {
		$self ptt-release
		$input_mute_ configure -state disabled
	} else {
		$input_mute_ configure -state normal
	}
}
AudioPanel instproc is_recv_only {} {
	$self instvar input_mute_
	if { [$input_mute_ cget -state] == "disabled" } { return 1 } \
			else { return 0 }
}
AudioPanel instproc action {} {
	$self instvar agent_ arbiter_ output_mute_
	if { ![$agent_ have_audio] && "[$output_mute_ get-val]" == "unmuted" } {
		$arbiter_ request
	}
}
AudioPanel instproc cancel_timer {} {
	$self instvar arbiter_
	delete $arbiter_
}
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
	wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
	$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 -superclass Observable -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} {
	global V
	$self instvar gamma_ dither_
	Application set colormap_ $w
	set dither [$self get_option dither]
	if { $dither == "best" } {
		set dither ED
	}
	if { $dither == "dither" } {
		set dither Dither
	}
	if { $dither == "gray" } {
		set dither Gray
	}
	if { $dither == "quantize" } {
		set dither Quant
	}
	set gamma_ [$self get_option gamma]
	if { [lsearch -exact "Dither ED Gray Quant" $dither] < 0 } {
		puts stderr "[$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_
	set dither_ $d
	if ![$self init_color] {
		$self revert_to_gray
	}
	$self notify_observers trigger_format_all
}
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 Settings -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 {}} {scrollbars_on 0} {autoplace 0} {CINDY_HACK_HAVE_VIDEO 1} } {
	$self next
	$self instvar localChannel_ globalChannel_ videoAgent_ vpipe_ exitCmd_ scrollbars_on_ autoplace_
	set localChannel_ $localChannel
	set globalChannel_ $globalChannel
	set videoAgent_ $videoAgent
	set vpipe_ $vpipe
	set exitCmd_ "$exitCmd"
	set scrollbars_on_ $scrollbars_on
	set autoplace_ $autoplace
	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_"
        wm protocol . WM_DELETE_WINDOW "$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
	}
	if [$self yesno camctrl] {
		puts "camera controls enabled..."
		$self instvar camMngr_
		set camMngr_ [new CameraManager]
	}
}
VicUI public rearrange {w h} {
    $self instvar asm_canvas_ asm_width_ asm_height_ manual_width_ manual_height_ scrollbars_on_
    set asm_width_ $w
    set asm_height_ $h
    if { $scrollbars_on_ } {
	set w [expr $asm_width_ > $manual_width_ ? $asm_width_ : $manual_width_]
	set h [expr $asm_height_ > $manual_height_ ? $asm_height_ : $manual_height_]
	$asm_canvas_ configure -scrollregion "0 0 $w $h"
    } else {
	$asm_canvas_ configure -width $w -height $h
    }
    $self reanchor_asm
}
VicUI public reconfine {w h} {
    $self instvar asm_canvas_ asm_width_ asm_height_ manual_width_ manual_height_
    set manual_width_ $w
    set manual_height_ $h
    set w [expr $manual_width_ > $asm_width_ ? $manual_width_ : $asm_width_]
    set h [expr $manual_height_ > $asm_height_ ? $manual_height_ : $asm_height_]
    $asm_canvas_ configure -scrollregion "0 0 $w $h"
    $self reanchor_asm
}
VicUI public toggle_scrollbars {} {
    $self instvar scrollbars_on_
    if { $scrollbars_on_ } {
	$self scrollbars_off
    } else {
	$self scrollbars_on
    }
}
VicUI public scrollbars_off {} {
    $self instvar asm_canvas_ asm_grid_ scrollbars_on_
    if { $scrollbars_on_ } {
	grid $asm_canvas_ -in $asm_grid_ -padx 1 -pady 1 \
		-row 0 -column 0 -rowspan 2 -columnspan 2 -sticky news
    }
    set scrollbars_on_ 0
}
VicUI public scrollbars_on {} {
    $self instvar asm_canvas_ asm_grid_ asm_vscroll_ asm_hscroll_ scrollbars_on_
    if { ! $scrollbars_on_ } {
	grid $asm_canvas_ -in $asm_grid_ -padx 1 -pady 1 \
		-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
	grid $asm_vscroll_ -in $asm_grid_ -padx 1 -pady 1 \
		-row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
	grid $asm_hscroll_ -in $asm_grid_ -padx 1 -pady 1 \
		-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
    }
    set scrollbars_on_ 1
}
VicUI public set_scrollbars {} {
    $self tkvar useScrollbars_
    if { $useScrollbars_ } {
	$self scrollbars_on
    } else {
	$self scrollbars_off
    }
}
VicUI public reanchor_asm {} {
    $self instvar asm_ asm_canvas_ asm_window_id_ asm_anchored_ manual_width_ manual_height_
    set num_sources [llength [$asm_ active-sources]]
    if {$asm_anchored_} return
    if {!$asm_anchored_ && [llength [$asm_ active-sources]] == 0} {
	$asm_canvas_ delete $asm_window_id_
	set asm_window_id_ [$asm_canvas_ create window [expr $manual_width_ / 2] [expr $manual_height_ / 2] -anchor center -window $asm_canvas_.top]
    } else {
	$asm_canvas_ delete $asm_window_id_
	set asm_window_id_ [$asm_canvas_ create window 0 0 -anchor nw -window $asm_canvas_.top]
	set asm_anchored_ 1
    }
}
VicUI public layout_gui {w} {
	$self instvar asm_ controlMenu_ videoAgent_ vpipe_ vframe_ exitCmd_ localChannel_ asm_canvas_ asm_grid_ asm_width_ asm_height_ manual_width_ manual_height_ scrollbars_on_ asm_vscroll_ asm_hscroll_ asm_window_id_ asm_anchored_ autoplace_
	set asm_canvas_ $w.asm_canvas
	set asm_grid_ $w.asm_grid
	set asm_vscroll_ $w.asm_vscroll
	set asm_hscroll_ $w.asm_hscroll
	set asm_width_ 0
	set asm_height_ 0
	set manual_width_ 173
	set manual_height_ 140
	set asm_anchored_ 0
	frame $asm_grid_
	scrollbar $asm_hscroll_ -orient horiz -command "$w.asm_canvas xview"
	scrollbar $asm_vscroll_ -orient vert -command "$w.asm_canvas yview"
	canvas $asm_canvas_ -width $manual_width_ -height $manual_height_ \
		-highlightthickness 0 -scrollregion "0 0 $manual_width_ $manual_height_" \
		-xscrollcommand "$w.asm_hscroll set" \
		-yscrollcommand "$w.asm_vscroll set"
	pack $asm_grid_ -expand yes -fill both -padx 1 -pady 1
	grid rowconfig $asm_grid_ 0 -weight 1 -minsize 0
	grid columnconfig $asm_grid_ 0 -weight 1 -minsize 0
	if { $scrollbars_on_ } {
		grid $asm_canvas_ -in $asm_grid_ -padx 1 -pady 1 \
			-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
		grid $asm_vscroll_ -in $asm_grid_ -padx 1 -pady 1 \
			-row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
		grid $asm_hscroll_ -in $asm_grid_ -padx 1 -pady 1 \
			-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
	} else {
		grid $asm_canvas_ -in $asm_grid_ -padx 1 -pady 1 \
			-row 0 -column 0 -rowspan 2 -columnspan 2 -sticky news
	}
	set vframe_ [new VisualFrame $asm_canvas_.top]
	set asm_ [new ActiveSourceManager $self $asm_canvas_.top $videoAgent_ vertical $localChannel_ $autoplace_]
	$vframe_ attach_observer $asm_
	$asm_ redecorate 3
	$asm_ init_grid $asm_canvas_.top.f
	pack $asm_canvas_.top -expand 1 -fill both
	pack $asm_canvas_.top.f -expand 1 -fill both -side top
	set asm_window_id_ [$asm_canvas_ create window [expr $manual_width_ / 2] [expr $manual_height_ / 2] -anchor center -window $asm_canvas_.top]
	set controlMenu_ [new ControlMenu $self $videoAgent_ $vpipe_ $vframe_ $asm_ [new UISrcListWindow $w $videoAgent_]]
	$self build_menubar $w.asm_bar $controlMenu_ [new VicHelpWindow .help] "$exitCmd_"
	grid $w.asm_bar -in $asm_grid_ -padx 1 -pady 1 \
		-row 2 -column 0 -rowspan 1 -columnspan 2 -sticky news
	bind $asm_canvas_.top.f <Configure> "$self rearrange %w %h"
	bind $asm_canvas_ <Configure> "$self reconfine %w %h"
	foreach i { 1 2 3 4 5 6 7 8 } {
		bind . <Key-$i> "$asm_ redecorate $i; $controlMenu_ update_layout $i"
	}
	bind . <t> "$controlMenu_ build_window ; $controlMenu_ invoke_transmit"
	bind . <s> "$self toggle_scrollbars; $controlMenu_ toggle_scrollcheck"
	bind . <a> "$asm_ toggle_autoplace; $controlMenu_ toggle_autocheck"
}
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 {} {
	global mash
	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
	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
}
VicUI instproc scuba_session {} {
	$self instvar scuba_sess_
	if [info exists scuba_sess_] { return $scuba_sess_ }  else {return "" }
}
VicUI instproc switch-agent {spec} {
	$self instvar videoAgent_
	$self instvar vpipe_
	$self instvar asm_ controlMenu_
	if {[catch {new VideoAgent $self $spec} new_agent]} {
		error $new_agent
	}
	if {[$vpipe_ info vars bufferPool_] == "bufferPool_"} {
		[$vpipe_ set bufferPool_] srcid [$new_agent get_local_srcid]
	}
	if {[$vpipe_ info vars encoder_] == "encoder_"} {
		[$vpipe_ set encoder_] target [$new_agent get_transmitter]
	}
	$vpipe_ set session_ $new_agent
	foreach observer [$videoAgent_ set observers_] {
		$new_agent attach $observer
	}
	if { ![$self yesno vain] && [$new_agent have_network] } {
		Switcher set ignore_([$new_agent local]) 1
	}
	$asm_ switch-agent $new_agent
	$controlMenu_ switch-agent $new_agent
	if {[llength [VicApplication info instances]] > 0} {
		[lindex [VicApplication info instances] 0] set agent_ $new_agent
	}
	$videoAgent_ destroy
	set videoAgent_ $new_agent
}
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 openmash-users@openmash.org.  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
        wm protocol $w WM_DELETE_WINDOW "wm withdraw $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]
	if {[$o get_option userhookFile] != ""} {
		if {[file isfile [$o get_option userhookFile]] && \
			[file readable [$o get_option userhookFile]]} {
			source [$o get_option userhookFile]
		} else {
			puts stderr "Unable to source \"[$o get_option userhookFile]\". Not a file or not readable."
		}
	}
	set spec [$self check_hostspec $argv [$self get_option megaVideoSession]]
	$self check_rtp_sdes
	set t [$self get_option maxbw]
	if { $t > 0 } {
		$o add_option maxbw [expr 1000*$t]
	}
	if { $spec != "" } {
		set ab [new AddressBlock $spec]
		$o add_option maxbw [$ab set maxbw_(0)]
		delete $ab
	}
	$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 [$self get_option useScrollbars] [$self get_option autoPlace]]
	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 vpipe_
	$self instvar agent_
	$vpipe_ destroy
	$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 -u userhookFile
	$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_boolean_option -scroll useScrollbars
	$o register_boolean_option -auto autoPlace
	$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
	$o register_boolean_option -camctrl camctrl
	$o register_option -rendez rendez
}
VicApplication instproc reset { ab } {
	$self instvar handler_ ui_
	if ![info exists handler_] {return}
	$handler_ reset $ab
	if ![info exists ui_] {return}
	$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 camctrl 0
	$o add_default jvColors 32
	$o add_default softJPEGthresh -1
	$o add_default softJPEGcthresh 6
	$o add_default maxVideoSessionBW 1000000
	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
	} else {
		set b [button .b____dummy____$self]
		$o add_default background [$b cget -background]
		$o add_default foreground [$b cget -foreground]
		$o add_default disabledForeground [$b cget -disabledforeground]
		destroy $b
	}
	$o add_default useScrollbars false
	$o add_default autoPlace false
}
VicApplication instproc init_confbus {} {
	set channel [$self get_option confBusChannel]
	if {$channel == ""} {set channel 2}
	$self instvar local_chan_ glob_chan_
	set local_chan_ [new CoordinationBus -channel $channel]
	incr channel
	set ttl [$self get_option defaultTTL]
	set glob_chan_ [new CoordinationBus -channel $channel -ttl $ttl]
}
new VicApplication .[pid] $argv
