Context Navigation

ui_audiotool.tcl @ 2271

Revision 2271, 88.5 KB (checked in by ucaccsp, 14 years ago)
Debugging code; fix indentation in places (someone's been using the MS editor which changes tabs to sequences of 4 spaces!)
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`

Line
1	catch {
2	#
3	# Copyright (c) 1995-99 University College London
4	# All rights reserved.
5	#
6	# $Revision$
7	#
8	# Full terms and conditions of the copyright appear below.
9	#
10
11	wm withdraw .
12
13	if {[string compare [info commands registry] "registry"] == 0} {
14	set win32 1
15	} else {
16	set win32 0
17	option add MenuselectColor forestgreen
18	option add RadiobuttonselectColor forestgreen
19	option add CheckbuttonselectColor forestgreen
20	option add *Entry.background gray70
21	}
22
23	set statsfont {helvetica 10}
24	set titlefont {helvetica 10}
25	set infofont {helvetica 10}
26	set smallfont {helvetica 8}
27	set verysmallfont {helvetica 8}
28
29	option add *Entry.relief sunken
30	option add *borderWidth 1
31	option add *highlightThickness 0
32	option add ButtonpadX 4
33	option add ButtonpadY 0
34	option add *font $infofont
35	option add MenutearOff 0
36
37	set V(class) "Mbone Applications"
38	set V(app) "rat"
39
40	set iht 16
41	set iwd 250
42	set cancel_info_timer 0
43	set num_cname 0
44	set fw .l.t.list.f
45
46	proc init_source {cname} {
47	global CNAME NAME EMAIL LOC PHONE TOOL NOTE num_cname
48	global CODEC DURATION PCKTS_RECV PCKTS_LOST PCKTS_MISO PCKTS_DUP JITTER \
49	LOSS_TO_ME LOSS_FROM_ME INDEX JIT_TOGED BUFFER_SIZE PLAYOUT_DELAY
50
51	if {[array names INDEX $cname] != [list $cname]} {
52	# This is a source we've not seen before...
53	set CNAME($cname) $cname
54	set NAME($cname) $cname
55	set EMAIL($cname) ""
56	set PHONE($cname) ""
57	set LOC($cname) ""
58	set TOOL($cname) ""
59	set NOTE($cname) ""
60	set CODEC($cname) unknown
61	set DURATION($cname) ""
62	set BUFFER_SIZE($cname) 0
63	set PLAYOUT_DELAY($cname) 0
64	set PCKTS_RECV($cname) 0
65	set PCKTS_LOST($cname) 0
66	set PCKTS_MISO($cname) 0
67	set PCKTS_DUP($cname) 0
68	set JITTER($cname) 0
69	set JIT_TOGED($cname) 0
70	set LOSS_TO_ME($cname) 101
71	set LOSS_FROM_ME($cname) 101
72	set INDEX($cname) $num_cname
73	incr num_cname
74	chart_enlarge $num_cname
75	chart_label $cname
76	}
77	}
78
79	proc window_plist {cname} {
80	global fw
81	regsub -all {@\|\.} $cname {-} foo
82	return $fw.source-$foo
83	}
84
85	proc window_stats {cname} {
86	regsub -all {[\. ]} $cname {-} foo
87	return .stats$foo
88	}
89
90	# Commands to send message over the conference bus...
91	proc output_mute {state} {
92	mbus_send "R" "audio.output.mute" "$state"
93	if {$state} {
94	.r.c.vol.t1 configure -relief sunken
95	pack forget .r.c.vol.b1 .r.c.vol.s1
96	pack .r.c.vol.ml -side top -fill both -expand 1
97	} else {
98	.r.c.vol.t1 configure -relief raised
99	pack forget .r.c.vol.ml
100	pack .r.c.vol.b1 -side top -fill x -expand 1
101	pack .r.c.vol.s1 -side top -fill x -expand 1
102	}
103	}
104
105	proc input_mute {state} {
106	mbus_send "R" "audio.input.mute" "$state"
107	if {$state} {
108	.r.c.gain.t2 configure -relief sunken
109	pack forget .r.c.gain.b2 .r.c.gain.s2
110	pack .r.c.gain.ml -side top -fill both -expand 1
111	} else {
112	.r.c.gain.t2 configure -relief raised
113	pack forget .r.c.gain.ml
114	pack .r.c.gain.b2 -side top -fill x -expand 1
115	pack .r.c.gain.s2 -side top -fill x -expand 1
116	}
117	}
118
119	proc set_vol {new_vol} {
120	global volume
121	set volume $new_vol
122	mbus_send "R" "audio.output.gain" $volume
123	}
124
125	proc set_gain {new_gain} {
126	global gain
127	set gain $new_gain
128	mbus_send "R" "audio.input.gain" $gain
129	}
130
131	proc toggle_input_port {} {
132	global input_port
133
134	switch $input_port {
135	microphone {set input_port "line_in"}
136	line_in {set input_port "cd"}
137	cd {set input_port "microphone"}
138	* {error "unknown port $input_port"}
139	}
140
141	mbus_send "R" "audio.input.port" [mbus_encode_str $input_port]
142	}
143
144
145	proc toggle_output_port {} {
146	global output_port
147
148	switch $output_port {
149	speaker {set output_port "line_out"}
150	line_out {set output_port "headphone"}
151	headphone {set output_port "speaker"}
152	* {error "unknown port $output_port"}
153	}
154
155	mbus_send "R" "audio.output.port" [mbus_encode_str $output_port]
156	}
157
158	proc mbus_heartbeat {} {
159	}
160
161	#############################################################################################################
162	# Reception of Mbus messages...
163
164	proc mbus_recv {cmnd args} {
165	# This is not the most efficient way of doing this, since we could call mbus_recv_...
166	# directly from the C code. It does, however, make it explicit which Mbus commands we
167	# understand.
168	switch $cmnd {
169	mbus.waiting {eval mbus_recv_mbus.waiting $args}
170	mbus.go {eval mbus_recv_mbus.go $args}
171	mbus.hello {eval mbus_recv_mbus.hello $args}
172	mbus.quit {eval mbus_recv_mbus.quit $args}
173	tool.rat.load.settings {eval mbus_recv_tool.rat.load.settings $args}
174	tool.rat.sampling.supported {eval mbus_recv_tool.rat.sampling.supported $args}
175	tool.rat.converter.supported {eval mbus_recv_tool.rat.converter.supported $args}
176	tool.rat.repair.supported {eval mbus_recv_tool.rat.repair.supported $args}
177	tool.rat.agc {eval mbus_recv_tool.rat.agc $args}
178	tool.rat.sync {eval mbus_recv_tool.rat.sync $args}
179	tool.rat.format.in {eval mbus_recv_tool.rat.format.in $args}
180	tool.rat.codec {eval mbus_recv_tool.rat.codec $args}
181	tool.rat.codec.details {eval mbus_recv_tool.rat.codec.details $args}
182	tool.rat.rate {eval mbus_recv_tool.rat.rate $args}
183	tool.rat.lecture.mode {eval mbus_recv_tool.rat.lecture.mode $args}
184	tool.rat.disable.audio.ctls {eval mbus_recv_tool.rat.disable.audio.ctls $args}
185	tool.rat.enable.audio.ctls {eval mbus_recv_tool.rat.enable.audio.ctls $args}
186	tool.rat.audio.buffered {eval mbus_recv_tool.rat.audio.buffered $args}
187	tool.rat.audio.delay {eval mbus_recv_tool.rat.audio.delay $args}
188	tool.rat.3d.enabled {eval mbus_recv_tool.rat.3d.enabled $args}
189	tool.rat.3d.azimuth.min {eval mbus_recv_tool.rat.3d.azimuth.min $args}
190	tool.rat.3d.azimuth.max {eval mbus_recv_tool.rat.3d.azimuth.max $args}
191	tool.rat.3d.filter.types {eval mbus_recv_tool.rat.3d.filter.types $args}
192	tool.rat.3d.filter.lengths {eval mbus_recv_tool.rat.3d.filter.lengths $args}
193	tool.rat.3d.user.settings {eval mbus_recv_tool.rat.3d.user.settings $args}
194	audio.suppress.silence {eval mbus_recv_audio.suppress.silence $args}
195	audio.channel.coding {eval mbus_recv_audio.channel.coding $args}
196	audio.channel.repair {eval mbus_recv_audio.channel.repair $args}
197	audio.input.gain {eval mbus_recv_audio.input.gain $args}
198	audio.input.port {eval mbus_recv_audio.input.port $args}
199	audio.input.mute {eval mbus_recv_audio.input.mute $args}
200	audio.input.powermeter {eval mbus_recv_audio.input.powermeter $args}
201	audio.output.gain {eval mbus_recv_audio.output.gain $args}
202	audio.output.port {eval mbus_recv_audio.output.port $args}
203	audio.output.mute {eval mbus_recv_audio.output.mute $args}
204	audio.output.powermeter {eval mbus_recv_audio.output.powermeter $args}
205	audio.file.play.ready {eval mbus_recv_audio.file.play.ready $args}
206	audio.file.play.alive {eval mbus_recv_audio.file.play.alive $args}
207	audio.file.record.ready {eval mbus_recv_audio.file.record.ready $args}
208	audio.file.record.alive {eval mbus_recv_audio.file.record.alive $args}
209	audio.devices {eval mbus_recv_audio_devices $args}
210	audio.device {eval mbus_recv_audio_device $args}
211	session.title {eval mbus_recv_session.title $args}
212	session.address {eval mbus_recv_session.address $args}
213	rtp.cname {eval mbus_recv_rtp.cname $args}
214	rtp.source.exists {eval mbus_recv_rtp.source.exists $args}
215	rtp.source.remove {eval mbus_recv_rtp.source.remove $args}
216	rtp.source.name {eval mbus_recv_rtp.source.name $args}
217	rtp.source.email {eval mbus_recv_rtp.source.email $args}
218	rtp.source.phone {eval mbus_recv_rtp.source.phone $args}
219	rtp.source.loc {eval mbus_recv_rtp.source.loc $args}
220	rtp.source.tool {eval mbus_recv_rtp.source.tool $args}
221	rtp.source.note {eval mbus_recv_rtp.source.note $args}
222	rtp.source.codec {eval mbus_recv_rtp.source.codec $args}
223	rtp.source.packet.duration {eval mbus_recv_rtp.source.packet.duration $args}
224	rtp.source.packet.loss {eval mbus_recv_rtp.source.packet.loss $args}
225	rtp.source.reception {eval mbus_recv_rtp.source.reception $args}
226	rtp.source.active {eval mbus_recv_rtp.source.active $args}
227	rtp.source.inactive {eval mbus_recv_rtp.source.inactive $args}
228	rtp.source.mute {eval mbus_recv_rtp.source.mute $args}
229	security.encryption.key {eval mbus_recv_security.encryption.key $args}
230	default {puts "Unknown mbus command $cmnd"}
231	}
232	}
233
234	proc mbus_recv_mbus.waiting {condition} {
235	if {$condition == "rat.ui.init"} {
236	mbus_send "U" "mbus.go" [mbus_encode_str rat.ui.init]
237	}
238	}
239
240	proc mbus_recv_mbus.go {condition} {
241	}
242
243	proc mbus_recv_mbus.hello {} {
244	# Ignore...
245	}
246
247	proc mbus_recv_tool.rat.load.settings {} {
248	load_settings
249	check_rtcp_name
250	sync_engine_to_ui
251	chart_show
252	file_show
253	toggle_plist
254	}
255
256	proc change_freq {new_freq} {
257	global freq
258
259	if {$freq != $new_freq} {
260	set freq $new_freq
261	update_channels_displayed
262	update_codecs_displayed
263	reset_encodings
264	}
265	}
266
267	proc change_channels {new_channels} {
268	global ichannels
269	if {$ichannels != $new_channels} {
270	set ichannels $new_channels
271	update_codecs_displayed
272	reset_encodings
273	}
274	}
275
276	proc update_channels_displayed {} {
277	global freq channel_support
278
279	set m1 .prefs.pane.audio.dd.sampling.ch_in.mb.m
280	$m1 delete 0 last
281	set s [lsearch -glob $channel_support $freq]
282
283	foreach i [lrange [split [lindex $channel_support $s] ","] 1 2] {
284	$m1 add command -label "$i" -command "change_channels $i"
285	}
286	}
287
288	proc mbus_recv_tool.rat.sampling.supported {arg} {
289	global freq channel_support
290
291	#clear away old state of channel support
292	if [info exists channel_support] {
293	unset channel_support
294	}
295
296	set freqs [list]
297	set channel_support [list]
298
299	.prefs.pane.audio.dd.sampling.freq.mb.m delete 0 last
300
301	set mode [split $arg]
302	foreach m $mode {
303	lappend channel_support $m
304	set support [split $m ","]
305	set f [lindex $support 0]
306	lappend freqs $f
307	.prefs.pane.audio.dd.sampling.freq.mb.m add command -label $f -command "change_freq $f"
308	}
309	set freq [lindex $freqs 0]
310	update_channels_displayed
311	}
312
313	# CODEC HANDLING ##############################################################
314
315	set codecs {}
316	set prencs {}
317	set secencs {}
318
319	proc codec_get_name {nickname freq channels} {
320	global codecs codec_nick_name codec_rate codec_channels
321
322	foreach {c} $codecs {
323	if {$codec_nick_name($c) == $nickname && \
324	$codec_rate($c) == $freq && \
325	$codec_channels($c) == $channels} {
326	return $c
327	}
328	}
329	}
330
331	proc codecs_loosely_matching {freq channels} {
332	global codecs codec_nick_name codec_channels codec_rate codec_pt codec_state_size codec_data_size codec_block_size codec_desc
333
334	set x {}
335
336	foreach {c} $codecs {
337	if {$codec_channels($c) == $channels && \
338	$codec_rate($c) == $freq && \
339	$codec_pt($c) != "-" } {
340	lappend x $c
341	}
342	}
343
344	return $x
345	}
346
347	proc codecs_matching {freq channels blocksize} {
348	global codec_block_size
349	set codecs [codecs_loosely_matching $freq $channels]
350
351	set x {}
352
353	foreach {c} $codecs {
354	if {$codec_block_size($c) == $blocksize} {
355	lappend x $c
356	}
357	}
358	return $x
359	}
360
361	proc mbus_recv_tool.rat.codec.details {args} {
362	catch {
363	global codecs codec_nick_name codec_channels codec_rate codec_pt codec_state_size codec_data_size codec_block_size codec_desc
364
365	set name [lindex $args 1]
366	if {[lsearch $codecs $name] == -1} {
367	lappend codecs $name
368	}
369	set codec_pt($name) [lindex $args 0]
370	set codec_nick_name($name) [lindex $args 2]
371	set codec_channels($name) [lindex $args 3]
372	set codec_rate($name) [lindex $args 4]
373	set codec_block_size($name) [lindex $args 5]
374	set codec_state_size($name) [lindex $args 6]
375	set codec_data_size($name) [lindex $args 7]
376	set codec_desc($name) [lindex $args 8]
377	set stackup ""
378	} details_error
379
380	if { $details_error != "" } {
381	puts "Error: $details_error"
382	destroy .
383	exit -1
384	}
385	}
386
387	proc update_primary_list {arg} {
388	# We now have a list of codecs which this RAT supports...
389	global prenc prencs
390
391	.prefs.pane.transmission.dd.pri.m.menu delete 0 last
392	set prencs {}
393
394	set codecs [split $arg]
395	foreach c $codecs {
396	.prefs.pane.transmission.dd.pri.m.menu add command -label $c -command "set prenc $c; update_codecs_displayed"
397	lappend prencs $c
398	}
399	}
400
401	proc update_redundancy_list {arg} {
402	global secenc secencs
403
404	.prefs.pane.transmission.cc.red.fc.m.menu delete 0 last
405	set secencs {}
406
407	set codecs [split $arg]
408	foreach c $codecs {
409	.prefs.pane.transmission.cc.red.fc.m.menu add command -label $c -command "set secenc \"$c\""
410	lappend secencs $c
411	}
412	}
413
414	proc reset_encodings {} {
415	global prenc prencs secenc secencs
416	set prenc [lindex $prencs 0]
417	set secenc [lindex $secencs 0]
418	}
419
420	proc update_codecs_displayed { } {
421	global freq ichannels codec_nick_name prenc codec_block_size
422
423	if {[string match $ichannels Mono]} {
424	set sample_channels 1
425	} else {
426	set sample_channels 2
427	}
428
429	set sample_rate [string trimright $freq -kHz]
430	set sample_rate [expr $sample_rate * 1000]
431
432	set long_names [codecs_loosely_matching $sample_rate $sample_channels]
433	set friendly_names {}
434	foreach {n} $long_names {
435	lappend friendly_names $codec_nick_name($n)
436	}
437
438	update_primary_list $friendly_names
439
440	set long_name [codec_get_name $prenc $sample_rate $sample_channels]
441
442	set long_names [codecs_matching $sample_rate $sample_channels $codec_block_size($long_name)]
443
444	set friendly_names {}
445	set found 0
446	foreach {n} $long_names {
447	if {$codec_nick_name($n) == $prenc} {
448	set found 1
449	}
450	if {$found} {
451	lappend friendly_names $codec_nick_name($n)
452	}
453	}
454
455	update_redundancy_list $friendly_names
456	}
457
458	proc change_sampling { } {
459	update_channels_displayed
460	update_codecs_displayed
461	}
462
463	###############################################################################
464
465	proc mbus_recv_tool.rat.converter.supported {arg} {
466	global convert_var
467
468	.prefs.pane.reception.r.ms.menu delete 0 last
469
470	set converters [split $arg ","]
471	foreach c $converters {
472	.prefs.pane.reception.r.ms.menu add command -label $c -command "set convert_var \"$c\""
473	}
474	}
475
476	proc mbus_recv_tool.rat.repair.supported {arg} {
477	.prefs.pane.reception.r.m.menu delete 0 last
478
479	set schemes [split $arg ","]
480	foreach rep $schemes {
481	.prefs.pane.reception.r.m.menu add command -label $rep -command "set repair_var \"$rep\""
482	}
483	}
484
485	proc mbus_recv_audio_devices {arg} {
486	global audio_device
487
488	set m .prefs.pane.audio.dd.device.mdev
489	set max_len 0
490
491	$m.menu delete 0 last
492	set devices [split $arg ","]
493	foreach d $devices {
494	$m.menu add command -label "$d" -command "set audio_device \"$d\""
495	set len [string length "$d"]
496	if [expr $len > $max_len] {
497	set max_len $len
498	}
499	}
500	$m configure -width $max_len
501	}
502
503	proc mbus_recv_audio_device {arg} {
504	global audio_device
505
506	set audio_device $arg
507	}
508
509	proc mbus_recv_tool.rat.agc {arg} {
510	global agc_var
511	set agc_var $arg
512	}
513
514	proc mbus_recv_tool.rat.sync {arg} {
515	global sync_var
516	set sync_var $arg
517	}
518
519	proc mbus_recv_security.encryption.key {new_key} {
520	global key_var key
521	set key_var 1
522	set key $new_key
523	}
524
525	proc mbus_recv_tool.rat.format.in {arg} {
526	global freq ichannels
527	#expect arg to be <sample_type>,<sample rate>,<mono/stereo>
528	set e [split $arg ","]
529
530	set freq [lindex $e 1]
531	set ichannels [lindex $e 2]
532	puts "tool.rat.format.in \"$freq\" \"$ichannels\""
533	}
534
535	proc mbus_recv_tool.rat.codec {arg} {
536	global prenc
537	set prenc $arg
538	}
539
540	proc mbus_recv_tool.rat.rate {arg} {
541	global upp
542	set upp $arg
543	}
544
545	proc mbus_recv_audio.channel.coding {channel args} {
546	global channel_var secenc red_off int_units int_gap
547	set channel_var $channel
548	switch $channel {
549	redundant {
550	set secenc [lindex $args 0]
551	set red_off [lindex $args 1]
552	}
553	interleaved {
554	set int_units [lindex $args 0]
555	set int_gap [lindex $args 1]
556	}
557	}
558	}
559
560	proc mbus_recv_audio.channel.repair {arg} {
561	global repair_var
562	set repair_var $arg
563	}
564
565	proc mbus_recv_audio.input.powermeter {level} {
566	global bargraphTotalHeight
567	bargraphSetHeight .r.c.gain.b2 [expr ($level * $bargraphTotalHeight) / 100]
568	}
569
570	proc mbus_recv_audio.output.powermeter {level} {
571	global bargraphTotalHeight
572	bargraphSetHeight .r.c.vol.b1 [expr ($level * $bargraphTotalHeight) / 100]
573	}
574
575	proc mbus_recv_audio.input.gain {new_gain} {
576	global gain
577	set gain $new_gain
578	.r.c.gain.s2 set $gain
579	}
580
581	proc mbus_recv_audio.input.port {device} {
582	global input_port
583	set input_port $device
584	.r.c.gain.l2 configure -bitmap $device
585	puts "set iport $input_port"
586	}
587
588	proc mbus_recv_audio.input.mute {val} {
589	global in_mute_var
590	set in_mute_var $val
591	if {$val} {
592	.r.c.gain.t2 configure -relief sunken
593	pack forget .r.c.gain.b2 .r.c.gain.s2
594	pack .r.c.gain.ml -side top -fill both -expand 1
595	} else {
596	.r.c.gain.t2 configure -relief raised
597	pack forget .r.c.gain.ml
598	pack .r.c.gain.b2 -side top -fill x -expand 1
599	pack .r.c.gain.s2 -side top -fill x -expand 1
600	}
601	}
602
603	proc mbus_recv_audio.output.gain {gain} {
604	.r.c.vol.s1 set $gain
605	}
606
607	proc mbus_recv_audio.output.port {device} {
608	global output_port
609	set output_port $device
610	.r.c.vol.l1 configure -bitmap $device
611	}
612
613	proc mbus_recv_audio.output.mute {val} {
614	global out_mute_var
615	set out_mute_var $val
616	if {$val} {
617	.r.c.vol.t1 configure -relief sunken
618	} else {
619	.r.c.vol.t1 configure -relief raised
620	}
621	}
622
623	proc mbus_recv_session.title {title} {
624	global session_title
625	set session_title $title
626	wm title . "RAT: $title"
627	}
628
629	proc mbus_recv_session.address {addr port ttl} {
630	global session_address
631	set session_address "Address: $addr Port: $port TTL: $ttl"
632	}
633
634	proc mbus_recv_tool.rat.lecture.mode {mode} {
635	global lecture_var
636	set lecture_var $mode
637	}
638
639	proc mbus_recv_audio.suppress.silence {mode} {
640	global silence_var
641	set silence_var $mode
642	}
643
644	proc mbus_recv_rtp.cname {cname} {
645	global my_cname rtcp_name rtcp_email rtcp_phone rtcp_loc num_cname
646
647	set my_cname $cname
648	init_source $cname
649	cname_update $cname
650	}
651
652	proc mbus_recv_rtp.source.exists {cname} {
653	init_source $cname
654	chart_label $cname
655	cname_update $cname
656	}
657
658	proc mbus_recv_rtp.source.name {cname name} {
659	global NAME
660	init_source $cname
661	set NAME($cname) $name
662	chart_label $cname
663	cname_update $cname
664	}
665
666	proc mbus_recv_rtp.source.email {cname email} {
667	global EMAIL
668	init_source $cname
669	set EMAIL($cname) $email
670	}
671
672	proc mbus_recv_rtp.source.phone {cname phone} {
673	global PHONE
674	init_source $cname
675	set PHONE($cname) $phone
676	}
677
678	proc mbus_recv_rtp.source.loc {cname loc} {
679	global LOC
680	init_source $cname
681	set LOC($cname) $loc
682	}
683
684	proc mbus_recv_rtp.source.tool {cname tool} {
685	global TOOL my_cname
686	init_source $cname
687	set TOOL($cname) $tool
688	if {[string compare $cname $my_cname] == 0} {
689	global tool_name
690	# tool name looks like RAT x.x.x platform ....
691	# lose the platform stuff
692	set tool_frag [split $tool]
693	set tool_name "UCL [lindex $tool_frag 0] [lindex $tool_frag 1]"
694	wm title . ""
695	}
696	}
697
698	proc mbus_recv_rtp.source.note {cname note} {
699	global NOTE
700	init_source $cname
701	set NOTE($cname) $note
702	}
703
704	proc mbus_recv_rtp.source.codec {cname codec} {
705	global CODEC
706	init_source $cname
707	set CODEC($cname) $codec
708	}
709
710	proc mbus_recv_rtp.source.packet.duration {cname packet_duration} {
711	global DURATION
712	init_source $cname
713	set DURATION($cname) $packet_duration
714	}
715
716	proc mbus_recv_tool.rat.audio.buffered {cname buffered} {
717	global BUFFER_SIZE
718	init_source $cname
719	set BUFFER_SIZE($cname) $buffered
720	# we don't update cname as source.packet.duration always follows
721	}
722
723	proc mbus_recv_tool.rat.audio.delay {cname len} {
724	global PLAYOUT_DELAY
725	init_source $cname
726	set PLAYOUT_DELAY($cname) $len
727	# we don't update cname as source.packet.duration always follows
728	}
729
730	proc mbus_recv_tool.rat.3d.enabled {mode} {
731	global 3d_audio_var
732	set 3d_audio_var $mode
733	}
734
735	proc mbus_recv_tool.rat.3d.azimuth.min {min} {
736	global 3d_azimuth
737	set 3d_azimuth(min) $min
738	}
739
740	proc mbus_recv_tool.rat.3d.azimuth.max {max} {
741	global 3d_azimuth
742	set 3d_azimuth(max) $max
743	}
744
745	proc mbus_recv_tool.rat.3d.filter.types {args} {
746	global 3d_filters
747	set 3d_filters [split $args ","]
748	}
749
750	proc mbus_recv_tool.rat.3d.filter.lengths {args} {
751	global 3d_filter_lengths
752	set 3d_filter_lengths [split $args ","]
753	}
754
755	proc mbus_recv_tool.rat.3d.user.settings {args} {
756	global filter_type filter_length azimuth
757	set cname [lindex $args 0]
758	set filter_type($cname) [lindex $args 1]
759	set filter_length($cname) [lindex $args 2]
760	set azimuth($cname) [lindex $args 3]
761	}
762
763	proc mbus_recv_rtp.source.packet.loss {dest srce loss} {
764	global losstimers my_cname LOSS_FROM_ME LOSS_TO_ME
765	init_source $srce
766	init_source $dest
767	catch {after cancel $losstimers($srce,$dest)}
768	chart_set $srce $dest $loss
769	set losstimers($srce,$dest) [after 7500 chart_set \"$srce\" \"$dest\" 101]
770	if {[string compare $dest $my_cname] == 0} {
771	set LOSS_TO_ME($srce) $loss
772	}
773	if {[string compare $srce $my_cname] == 0} {
774	set LOSS_FROM_ME($dest) $loss
775	}
776	cname_update $srce
777	cname_update $dest
778	}
779
780	proc mbus_recv_rtp.source.reception {cname packets_recv packets_lost packets_miso packets_dup jitter jit_tog} {
781	global PCKTS_RECV PCKTS_LOST PCKTS_MISO PCKTS_DUP JITTER JIT_TOGED
782	init_source $cname
783	set PCKTS_RECV($cname) $packets_recv
784	set PCKTS_LOST($cname) $packets_lost
785	set PCKTS_MISO($cname) $packets_miso
786	set PCKTS_DUP($cname) $packets_dup
787	set JITTER($cname) $jitter
788	set JIT_TOGED($cname) $jit_tog
789	}
790
791	proc mbus_recv_rtp.source.active {cname} {
792	catch [[window_plist $cname] configure -background white]
793	cname_update $cname
794	}
795
796	proc mbus_recv_rtp.source.inactive {cname} {
797	catch [[window_plist $cname] configure -background grey90]
798	after 60 "catch {[window_plist $cname] configure -background grey88}"
799	after 120 "catch {[window_plist $cname] configure -background [.l.t.list cget -background]}"
800	cname_update $cname
801	}
802
803	proc mbus_recv_rtp.source.remove {cname} {
804	global CNAME NAME EMAIL LOC PHONE TOOL NOTE CODEC DURATION PCKTS_RECV PCKTS_LOST PCKTS_MISO \
805	PCKTS_DUP JITTER BUFFER_SIZE PLAYOUT_DELAY LOSS_TO_ME LOSS_FROM_ME INDEX JIT_TOGED \
806	num_cname loss_to_me_timer loss_from_me_timer
807
808	# Disable updating of loss diamonds. This has to be done before we destroy the
809	# window representing the participant, else the background update may try to
810	# access a window which has been destroyed...
811	catch {after cancel $loss_to_me_timer($cname)}
812	catch {after cancel $loss_from_me_timer($cname)}
813
814	catch [destroy [window_plist $cname]]
815
816	unset CNAME($cname) NAME($cname) EMAIL($cname) PHONE($cname) LOC($cname) TOOL($cname) NOTE($cname)
817	unset CODEC($cname) DURATION($cname) PCKTS_RECV($cname) PCKTS_LOST($cname) PCKTS_MISO($cname) PCKTS_DUP($cname)
818	unset JITTER($cname) LOSS_TO_ME($cname) LOSS_FROM_ME($cname) INDEX($cname) JIT_TOGED($cname) BUFFER_SIZE($cname)
819	unset PLAYOUT_DELAY($cname)
820
821	incr num_cname -1
822	chart_redraw $num_cname
823	}
824
825	proc mbus_recv_rtp.source.mute {cname val} {
826	global iht
827
828	if {$val} {
829	[window_plist $cname] create line [expr $iht + 2] [expr $iht / 2] 500 [expr $iht / 2] -tags a -width 2.0 -fill gray95
830	} else {
831	catch [[window_plist $cname] delete a]
832	}
833	}
834
835	proc mbus_recv_audio.file.play.ready {name} {
836	global play_file
837	set play_file(name) $name
838	file_enable_play
839	}
840
841	proc mbus_recv_audio.file.play.alive {alive} {
842	global play_file
843
844	puts "file_play_live"
845	if {$alive} {
846	after 200 file_play_live
847	} else {
848	set play_file(state) end
849	file_enable_play
850	}
851	}
852
853	proc mbus_recv_audio.file.record.ready {name} {
854	global record_file
855	set record_file(name) $name
856	file_enable_record
857	}
858
859	proc mbus_recv_audio.file.record.alive {alive} {
860	global rec_file
861	if {$alive} {
862	after 200 file_rec_live
863	} else {
864	set rec_file(state) end
865	file_enable_record
866	}
867	}
868
869	proc mbus_recv_mbus.quit {} {
870	save_settings
871	destroy .
872	}
873
874	#############################################################################################################
875
876	proc set_loss_to_me {cname loss} {
877	global prev_loss_to_me loss_to_me_timer
878
879	catch {after cancel $loss_to_me_timer($cname)}
880	set loss_to_me_timer($cname) [after 7500 catch \"[window_plist $cname] itemconfigure h -fill grey\"]
881
882	if {$loss < 5} {
883	catch [[window_plist $cname] itemconfigure m -fill green]
884	} elseif {$loss < 10} {
885	catch [[window_plist $cname] itemconfigure m -fill orange]
886	} elseif {$loss <= 100} {
887	catch [[window_plist $cname] itemconfigure m -fill red]
888	} else {
889	catch [[window_plist $cname] itemconfigure m -fill grey]
890	}
891	}
892
893	proc set_loss_from_me {cname loss} {
894	global prev_loss_from_me loss_from_me_timer
895
896	catch {after cancel $loss_from_me_timer($cname)}
897	set loss_from_me_timer($cname) [after 7500 catch \"[window_plist $cname] itemconfigure h -fill grey\"]
898
899	if {$loss < 5} {
900	catch [[window_plist $cname] itemconfigure h -fill green]
901	} elseif {$loss < 10} {
902	catch [[window_plist $cname] itemconfigure h -fill orange]
903	} elseif {$loss <= 100} {
904	catch [[window_plist $cname] itemconfigure h -fill red]
905	} else {
906	catch [[window_plist $cname] itemconfigure h -fill grey]
907	}
908	}
909
910	proc cname_update {cname} {
911	# This procedure updates the on-screen representation of
912	# a participant.
913	global NAME LOSS_TO_ME LOSS_FROM_ME
914	global fw iht iwd my_cname
915
916	set cw [window_plist $cname]
917
918	if {[winfo exists $cw]} {
919	$cw itemconfigure t -text $NAME($cname)
920	} else {
921	# Add this participant to the list...
922	set thick 0
923	set l $thick
924	set h [expr $iht / 2 + $thick]
925	set f [expr $iht + $thick]
926	canvas $cw -width $iwd -height $f -highlightthickness $thick
927	$cw create text [expr $f + 2] $h -anchor w -text $NAME($cname) -fill black -tag t
928	$cw create polygon $l $h $h $l $h $f -outline black -fill grey50 -tag m
929	$cw create polygon $f $h $h $l $h $f -outline black -fill grey50 -tag h
930
931	bind $cw <Button-1> "toggle_stats \"$cname\""
932	bind $cw <Button-2> "toggle_mute $cw \"$cname\""
933	bind $cw <Control-Button-1> "toggle_mute $cw \"$cname\""
934
935	if {[info exists my_cname] && ([string compare $cname $my_cname] == 0) && ([pack slaves $fw] != "")} {
936	pack $cw -before [lindex [pack slaves $fw] 0] -fill x
937	}
938	pack $cw -fill x
939	fix_scrollbar
940	}
941
942	set_loss_to_me $cname $LOSS_TO_ME($cname)
943	set_loss_from_me $cname $LOSS_FROM_ME($cname)
944	}
945
946	#power meters
947
948	# number of elements in the bargraphs...
949	set bargraphTotalHeight 24
950	set bargraphRedHeight [expr $bargraphTotalHeight * 3 / 4]
951
952	proc bargraphCreate {bgraph} {
953	global oh$bgraph bargraphTotalHeight
954
955	frame $bgraph -bg black
956	frame $bgraph.inner0 -width 8 -height 6 -bg green
957	pack $bgraph.inner0 -side left -padx 0 -fill both -expand true
958	for {set i 1} {$i < $bargraphTotalHeight} {incr i} {
959	frame $bgraph.inner$i -width 8 -height 8 -bg black
960	pack $bgraph.inner$i -side left -padx 0 -fill both -expand true
961	}
962	set oh$bgraph 0
963	}
964
965	proc bargraphSetHeight {bgraph height} {
966	upvar #0 oh$bgraph oh
967	global bargraphTotalHeight bargraphRedHeight
968
969	if {$oh > $height} {
970	for {set i [expr $height + 1]} {$i <= $oh} {incr i} {
971	$bgraph.inner$i config -bg black
972	}
973	} else {
974	if {$bargraphRedHeight > $height} {
975	for {set i [expr $oh + 1]} {$i <= $height} {incr i} {
976	$bgraph.inner$i config -bg green
977	}
978	} else {
979	for {set i [expr $oh + 1]} {$i <= $bargraphRedHeight} {incr i} {
980	$bgraph.inner$i config -bg green
981	}
982	for {set i $bargraphRedHeight} {$i <= $height} {incr i} {
983	$bgraph.inner$i config -bg red
984	}
985	}
986	}
987	set oh $height
988	}
989
990	proc toggle {varname} {
991	upvar 1 $varname local
992	set local [expr !$local]
993	}
994
995	proc toggle_plist {} {
996	global plist_on
997	if {$plist_on} {
998	pack .l.t -side top -fill both -expand 1
999	} else {
1000	pack forget .l.t
1001	}
1002	update
1003	wm deiconify .
1004	}
1005
1006	proc toggle_mute {cw cname} {
1007	global iht
1008	if {[$cw gettags a] == ""} {
1009	mbus_send "R" "rtp.source.mute" "[mbus_encode_str $cname] 1"
1010	} else {
1011	mbus_send "R" "rtp.source.mute" "[mbus_encode_str $cname] 0"
1012	}
1013	}
1014
1015	proc fix_scrollbar {} {
1016	global iht iwd fw
1017
1018	set ch [expr $iht * ([llength [pack slaves $fw]] + 2)]
1019	set bh [winfo height .l.t.scr]
1020	if {$ch > $bh} {set h $ch} else {set h $bh}
1021	.l.t.list configure -scrollregion "0.0 0.0 $iwd $h"
1022	}
1023
1024	proc info_timer {} {
1025	global cancel_info_timer
1026	if {$cancel_info_timer == 1} {
1027	set cancel_info_timer 0
1028	} else {
1029	update_rec_info
1030	after 1000 info_timer
1031	}
1032	}
1033
1034	proc stats_add_field {widget label watchVar} {
1035	global statsfont
1036	frame $widget -relief sunk
1037	label $widget.l -text $label -font $statsfont -anchor w
1038	label $widget.w -textvariable $watchVar -font $statsfont
1039	pack $widget -side top -fill x -expand 1
1040	pack $widget.l -side left -fill x -expand 1
1041	pack $widget.w -side right
1042	}
1043
1044	set 3d_azimuth(min) 0
1045	set 3d_azimuth(max) 0
1046	set 3d_filters [list "Not Available"]
1047	set 3d_filter_lengths [list "0"]
1048
1049	proc toggle_stats {cname} {
1050	global statsfont
1051	set win [window_stats $cname]
1052	if {[winfo exists $win]} {
1053	destroy $win
1054	} else {
1055	global stats_pane
1056	# Window does not exist so create it
1057	toplevel $win
1058	frame $win.mf
1059	pack $win.mf -padx 0 -pady 0
1060	label $win.mf.l -text "Category:"
1061
1062	menubutton $win.mf.mb -menu $win.mf.mb.menu -indicatoron 1 -textvariable stats_pane($win) -relief raised -width 16
1063	pack $win.mf.l $win.mf.mb -side left
1064	menu $win.mf.mb.menu -tearoff 0
1065	$win.mf.mb.menu add command -label "Personal Details" -command "set_pane stats_pane($win) $win.df \"Personal Details\""
1066	$win.mf.mb.menu add command -label "Reception" -command "set_pane stats_pane($win) $win.df Reception"
1067	$win.mf.mb.menu add command -label "3D Positioning" -command "set_pane stats_pane($win) $win.df \"3D Positioning\""
1068
1069	set stats_pane($win) "Personal Details"
1070	frame $win.df
1071	frame $win.df.personal
1072	pack $win.df $win.df.personal -fill x
1073
1074	global NAME EMAIL PHONE LOC NOTE CNAME TOOL
1075	stats_add_field $win.df.personal.1 "Name: " NAME($cname)
1076	stats_add_field $win.df.personal.2 "Email: " EMAIL($cname)
1077	stats_add_field $win.df.personal.3 "Phone: " PHONE($cname)
1078	stats_add_field $win.df.personal.4 "Location: " LOC($cname)
1079	stats_add_field $win.df.personal.5 "Note: " NOTE($cname)
1080	stats_add_field $win.df.personal.6 "Tool: " TOOL($cname)
1081	stats_add_field $win.df.personal.7 "CNAME: " CNAME($cname)
1082
1083	frame $win.df.reception
1084	global CODEC DURATION BUFFER_SIZE PLAYOUT_DELAY PCKTS_RECV PCKTS_LOST PCKTS_MISO \
1085	PCKTS_DUP LOSS_FROM_ME LOSS_TO_ME JITTER JIT_TOGED
1086	stats_add_field $win.df.reception.1 "Audio encoding: " CODEC($cname)
1087	stats_add_field $win.df.reception.2 "Packet duration (ms): " DURATION($cname)
1088	stats_add_field $win.df.reception.3 "Playout delay (ms): " PLAYOUT_DELAY($cname)
1089	stats_add_field $win.df.reception.4 "Buffer length (ms): " BUFFER_SIZE($cname)
1090	stats_add_field $win.df.reception.5 "Arrival jitter (ms): " JITTER($cname)
1091	stats_add_field $win.df.reception.6 "Loss from me (%): " LOSS_FROM_ME($cname)
1092	stats_add_field $win.df.reception.7 "Loss to me (%): " LOSS_TO_ME($cname)
1093	stats_add_field $win.df.reception.8 "Packets received: " PCKTS_RECV($cname)
1094	stats_add_field $win.df.reception.9 "Packets lost: " PCKTS_LOST($cname)
1095	stats_add_field $win.df.reception.a "Packets misordered: " PCKTS_MISO($cname)
1096	stats_add_field $win.df.reception.b "Packets duplicated: " PCKTS_DUP($cname)
1097	stats_add_field $win.df.reception.c "Units dropped (jitter): " JIT_TOGED($cname)
1098
1099	# 3D settings
1100	# Trigger engine to send details for this participant
1101	mbus_send "R" "tool.rat.3d.user.settings.request" [mbus_encode_str $cname]
1102
1103	frame $win.df.3d -relief sunk
1104	label $win.df.3d.advice -text "These options allow the rendering of the\nparticipant to be altered when 3D\nrendering is enabled."
1105	checkbutton $win.df.3d.ext -text "3D Audio Rendering" -variable 3d_audio_var
1106	pack $win.df.3d.advice
1107	pack $win.df.3d.ext
1108
1109	frame $win.df.3d.opts
1110	pack $win.df.3d.opts -side top
1111
1112	frame $win.df.3d.opts.filters
1113	label $win.df.3d.opts.filters.l -text "Filter Type:"
1114	pack $win.df.3d.opts.filters.l -side top -fill x -expand 1 -anchor w
1115	global 3d_filters 3d_filter_lengths
1116
1117	global filter_type
1118	set filter_type($cname) [lindex $3d_filters 0]
1119
1120	set cnt 0
1121	foreach i $3d_filters {
1122	radiobutton $win.df.3d.opts.filters.$cnt \
1123	-value "$i" -variable filter_type($cname) \
1124	-text "$i"
1125	pack $win.df.3d.opts.filters.$cnt -side top -anchor w
1126	incr cnt
1127	}
1128
1129	frame $win.df.3d.opts.lengths
1130	label $win.df.3d.opts.lengths.l -text "Filter Length:" -width 16
1131	pack $win.df.3d.opts.lengths.l -side top -fill x -expand 1
1132
1133	global filter_length
1134	set filter_length($cname) [lindex $3d_filter_lengths 0]
1135
1136	set cnt 0
1137	foreach i $3d_filter_lengths {
1138	radiobutton $win.df.3d.opts.lengths.$cnt \
1139	-value "$i" -variable filter_length($cname) \
1140	-text "$i"
1141	pack $win.df.3d.opts.lengths.$cnt -side top -anchor w
1142	incr cnt
1143	}
1144	pack $win.df.3d.opts.filters -side left -expand 1 -anchor n
1145	pack $win.df.3d.opts.lengths -side left -expand 1 -anchor n
1146
1147	global 3d_azimuth azimuth
1148	scale $win.df.3d.azimuth -from $3d_azimuth(min) -to $3d_azimuth(max) \
1149	-orient horizontal -label "Azimuth" -variable azimuth($cname)
1150	pack $win.df.3d.azimuth -fill x -expand 1
1151
1152	button $win.df.3d.apply -text "Apply" -command "3d_send_parameters $cname"
1153	pack $win.df.3d.apply -side bottom -anchor e -padx 2 -pady 2
1154
1155	# Window Magic
1156	frame $win.dis
1157	button $win.dis.b -text "Dismiss" -command "destroy $win; 3d_delete_parameters $cname"
1158	pack $win.dis -side bottom -anchor s -fill x -expand 1
1159	pack $win.dis.b -side right -anchor e -padx 2 -pady 2
1160	wm title $win "Participant $NAME($cname)"
1161	wm resizable $win 1 0
1162	constrain_window $win 0 250 21 0
1163	}
1164	}
1165
1166	proc 3d_send_parameters {cname} {
1167	global azimuth filter_type filter_length 3d_audio_var
1168
1169	mbus_send "R" "tool.rat.3d.enabled" $3d_audio_var
1170	mbus_send "R" "tool.rat.3d.user.settings" "[mbus_encode_str $cname] [mbus_encode_str $filter_type($cname)] $filter_length($cname) $azimuth($cname)"
1171	}
1172
1173	proc 3d_delete_parameters {cname} {
1174	global filter_type filter_length azimuth
1175
1176	# None of these should ever fail, but you can't be too defensive...
1177	catch {
1178	unset filter_type($cname)
1179	unset filter_length($cname)
1180	unset azimuth($cname)
1181	}
1182	}
1183
1184	proc do_quit {} {
1185	catch {
1186	profile off pdat
1187	profrep pdat cpu
1188	}
1189	save_settings
1190	destroy .
1191	mbus_send "R" "mbus.quit" ""
1192	}
1193
1194	# Initialise RAT MAIN window
1195	frame .r
1196	frame .l
1197	frame .l.t -relief sunken
1198	scrollbar .l.t.scr -relief flat -highlightthickness 0 -command ".l.t.list yview"
1199	canvas .l.t.list -highlightthickness 0 -bd 0 -relief raised -width $iwd -height 160 -yscrollcommand ".l.t.scr set" -yscrollincrement $iht
1200	frame .l.t.list.f -highlightthickness 0 -bd 0
1201	.l.t.list create window 0 0 -anchor nw -window .l.t.list.f
1202
1203	frame .l.f -relief flat
1204	label .l.f.title -font $infofont -textvariable session_title
1205	label .l.f.addr -font $smallfont -textvariable session_address
1206
1207	frame .l.s1 -bd 0
1208	label .l.s1.tool -textvariable tool_name
1209	button .l.s1.opts -text "Options" -command {wm deiconify .prefs; raise .prefs}
1210	button .l.s1.about -text "About" -command {jiggle_credits; wm deiconify .about}
1211	button .l.s1.quit -text "Quit" -command do_quit
1212
1213	frame .r.c
1214	frame .r.c.vol
1215	frame .r.c.gain
1216
1217	pack .r -side top -fill x
1218	pack .r.c -side top -fill x -expand 1
1219	pack .r.c.vol -side top -fill x
1220	pack .r.c.gain -side top -fill x
1221
1222	pack .l -side top -fill both -expand 1
1223	pack .l.f -side top -fill x -padx 2
1224	pack .l.f.title .l.f.addr -side top -fill x -pady 2
1225	pack .l.s1 -side bottom -fill x
1226	pack .l.s1.tool -side left -anchor w
1227	pack .l.s1.quit .l.s1.about .l.s1.opts -side right -anchor w -padx 2 -pady 2
1228	pack .l.t -side top -fill both -expand 1 -padx 2
1229	pack .l.t.scr -side left -fill y
1230	pack .l.t.list -side left -fill both -expand 1
1231	bind .l.t.list <Configure> {fix_scrollbar}
1232
1233	# Device output controls
1234	set out_mute_var 0
1235	button .r.c.vol.t1 -highlightthickness 0 -pady 0 -padx 0 -text mute -command {toggle out_mute_var; output_mute $out_mute_var}
1236	set output_port "speaker"
1237	button .r.c.vol.l1 -pady 0 -padx 0 -highlightthickness 0 -command toggle_output_port
1238	bargraphCreate .r.c.vol.b1
1239	scale .r.c.vol.s1 -highlightthickness 0 -from 0 -to 99 -command set_vol -orient horizontal -relief raised -showvalue false -width 10 -variable volume
1240	label .r.c.vol.ml -text "Reception is muted" -relief sunken
1241
1242	pack .r.c.vol.l1 -side left -fill y
1243	pack .r.c.vol.t1 -side left -fill y
1244	pack .r.c.vol.b1 -side top -fill x -expand 1
1245	pack .r.c.vol.s1 -side top -fill x -expand 1
1246
1247	# Device input controls
1248	set in_mute_var 1
1249	button .r.c.gain.t2 -highlightthickness 0 -pady 0 -padx 0 -text mute -command {toggle in_mute_var; input_mute $in_mute_var}
1250	set input_port "microphone"
1251	button .r.c.gain.l2 -highlightthickness 0 -command toggle_input_port
1252	bargraphCreate .r.c.gain.b2
1253	scale .r.c.gain.s2 -highlightthickness 0 -from 0 -to 99 -command set_gain -orient horizontal -relief raised -showvalue false -width 10 -variable gain
1254	label .r.c.gain.ml -text "Transmission is muted" -relief sunken
1255
1256	pack .r.c.gain.l2 -side left -fill y
1257	pack .r.c.gain.t2 -side left -fill y
1258	pack .r.c.gain.ml -side top -fill both -expand 1
1259
1260	proc mbus_recv_tool.rat.disable.audio.ctls {} {
1261	.r.c.vol.t1 configure -state disabled
1262	.r.c.vol.l1 configure -state disabled
1263	.r.c.vol.s1 configure -state disabled
1264	.r.c.gain.t2 configure -state disabled
1265	.r.c.gain.l2 configure -state disabled
1266	.r.c.gain.s2 configure -state disabled
1267	}
1268
1269	proc mbus_recv_tool.rat.enable.audio.ctls {} {
1270	.r.c.vol.t1 configure -state normal
1271	.r.c.vol.l1 configure -state normal
1272	.r.c.vol.s1 configure -state normal
1273	.r.c.gain.t2 configure -state normal
1274	.r.c.gain.l2 configure -state normal
1275	.r.c.gain.s2 configure -state normal
1276	}
1277	bind all <ButtonPress-3> {toggle in_mute_var; input_mute $in_mute_var}
1278	bind all <ButtonRelease-3> {toggle in_mute_var; input_mute $in_mute_var}
1279	bind all <q> "do_quit"
1280
1281	# Override default tk behaviour
1282	wm protocol . WM_DELETE_WINDOW do_quit
1283
1284	if {$win32 == 0} {
1285	wm iconbitmap . rat_small
1286	}
1287	wm resizable . 0 1
1288	if ([info exists geometry]) {
1289	wm geometry . $geometry
1290	}
1291
1292	proc constrain_window {win maxstr xpad ylines ypad} {
1293	set fn [.prefs.buttons.apply cget -font]
1294	set w [expr [font measure $fn $maxstr] + $xpad]
1295	set h [expr $ylines * [font metrics $fn -linespace] + $ypad]
1296	wm geometry $win [format "%sx%s" $w $h]
1297	}
1298
1299	proc tk_optionCmdMenu {w varName firstValue args} {
1300	upvar #0 $varName var
1301
1302	if ![info exists var] {
1303	set var $firstValue
1304	}
1305	menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
1306	-relief raised -bd 2 -highlightthickness 2 -anchor c
1307
1308	menu $w.menu -tearoff 0
1309	$w.menu add command -label $firstValue -command "set $varName \"$firstValue\""
1310	foreach i $args {
1311	$w.menu add command -label $i -command "set $varName \"$i\""
1312	}
1313	return $w.menu
1314	}
1315
1316
1317	###############################################################################
1318	# Preferences Panel
1319	#
1320
1321	set prefs_pane "Personal"
1322	toplevel .prefs
1323	wm title .prefs "Preferences"
1324	wm resizable .prefs 0 0
1325	wm withdraw .prefs
1326
1327	frame .prefs.m
1328	pack .prefs.m -side top -fill x -expand 0 -padx 2 -pady 2
1329	frame .prefs.m.f
1330	pack .prefs.m.f -padx 0 -pady 0
1331	label .prefs.m.f.t -text "Category: "
1332	pack .prefs.m.f.t -pady 2 -side left
1333	menubutton .prefs.m.f.m -menu .prefs.m.f.m.menu -indicatoron 1 -textvariable prefs_pane -relief raised -width 14
1334	pack .prefs.m.f.m -side top
1335	menu .prefs.m.f.m.menu -tearoff 0
1336	.prefs.m.f.m.menu add command -label "Personal" -command {set_pane prefs_pane .prefs.pane "Personal"}
1337	.prefs.m.f.m.menu add command -label "Transmission" -command {set_pane prefs_pane .prefs.pane "Transmission"; update_codecs_displayed}
1338	.prefs.m.f.m.menu add command -label "Reception" -command {set_pane prefs_pane .prefs.pane "Reception"}
1339	.prefs.m.f.m.menu add command -label "Audio" -command {set_pane prefs_pane .prefs.pane "Audio"}
1340	.prefs.m.f.m.menu add command -label "Codecs" -command {set_pane prefs_pane .prefs.pane "Codecs"; codecs_panel_fill}
1341	.prefs.m.f.m.menu add command -label "Security" -command {set_pane prefs_pane .prefs.pane "Security"}
1342	.prefs.m.f.m.menu add command -label "Interface" -command {set_pane prefs_pane .prefs.pane "Interface"}
1343
1344	frame .prefs.buttons
1345	pack .prefs.buttons -side bottom -fill x
1346	button .prefs.buttons.bye -text "Cancel" -command {sync_ui_to_engine; wm withdraw .prefs}
1347	button .prefs.buttons.apply -text "Apply" -command {wm withdraw .prefs; sync_engine_to_ui}
1348	button .prefs.buttons.save -text "Save & Apply" -command {save_settings; wm withdraw .prefs; sync_engine_to_ui}
1349	pack .prefs.buttons.bye .prefs.buttons.apply .prefs.buttons.save -side right -padx 2 -pady 2
1350
1351	frame .prefs.pane -relief sunken
1352	pack .prefs.pane -side left -fill both -expand 1 -padx 4 -pady 2
1353
1354	# setup width of prefs panel
1355	constrain_window .prefs "XXXXXXXX48-kHzXXXStereoXXXLinear-16XXXUnitsXPerXPcktXXXXXXX" 0 12 128
1356
1357	# Personal Info Pane
1358	set i .prefs.pane.personal
1359	frame $i
1360	pack $i -fill both -expand 1 -pady 2 -padx 2
1361
1362	frame $i.a -relief sunken
1363	frame $i.a.f
1364	pack $i.a -side top -fill both -expand 1
1365	pack $i.a.f -side left -fill x -expand 1
1366
1367	frame $i.a.f.f
1368	pack $i.a.f.f
1369
1370	label $i.a.f.f.l -width 40 -height 2 -text "The personal details below are conveyed\nto the other conference participants." -justify left -anchor w
1371	pack $i.a.f.f.l -side top -anchor w -fill x
1372
1373	frame $i.a.f.f.lbls
1374	frame $i.a.f.f.ents
1375	pack $i.a.f.f.lbls -side left -fill y
1376	pack $i.a.f.f.ents -side right
1377
1378	label $i.a.f.f.lbls.name -text "Name:" -anchor w
1379	label $i.a.f.f.lbls.email -text "Email:" -anchor w
1380	label $i.a.f.f.lbls.phone -text "Phone:" -anchor w
1381	label $i.a.f.f.lbls.loc -text "Location:" -anchor w
1382	pack $i.a.f.f.lbls.name $i.a.f.f.lbls.email $i.a.f.f.lbls.phone $i.a.f.f.lbls.loc -fill x -anchor w -side top
1383
1384	entry $i.a.f.f.ents.name -width 28 -highlightthickness 0 -textvariable rtcp_name
1385	entry $i.a.f.f.ents.email -width 28 -highlightthickness 0 -textvariable rtcp_email
1386	entry $i.a.f.f.ents.phone -width 28 -highlightthickness 0 -textvariable rtcp_phone
1387	entry $i.a.f.f.ents.loc -width 28 -highlightthickness 0 -textvariable rtcp_loc
1388	pack $i.a.f.f.ents.name $i.a.f.f.ents.email $i.a.f.f.ents.phone $i.a.f.f.ents.loc -anchor n -expand 0
1389
1390	# Transmission Pane ###########################################################
1391	set i .prefs.pane.transmission
1392	frame $i
1393	frame $i.dd -relief sunken
1394	frame $i.cc -relief sunken
1395	frame $i.cc.van
1396	frame $i.cc.red
1397	frame $i.cc.int
1398
1399	pack $i.dd -fill x
1400	pack $i.cc $i.cc.van $i.cc.red -fill x -anchor w -pady 1
1401	pack $i.cc.int -fill x -anchor w -pady 0
1402	frame $i.dd.units
1403	frame $i.dd.pri
1404
1405	pack $i.dd.units $i.dd.pri -side right -fill x
1406
1407	label $i.dd.pri.l -text "Encoding:"
1408	menubutton $i.dd.pri.m -menu $i.dd.pri.m.menu -indicatoron 1 -textvariable prenc -relief raised -width 13
1409	pack $i.dd.pri.l $i.dd.pri.m -side top
1410	# fill in codecs
1411	menu $i.dd.pri.m.menu -tearoff 0
1412
1413	label $i.dd.units.l -text "Units:"
1414	tk_optionCmdMenu $i.dd.units.m upp 1 2 4 8
1415	$i.dd.units.m configure -width 13 -highlightthickness 0 -bd 1
1416	pack $i.dd.units.l $i.dd.units.m -side top -fill x
1417
1418	radiobutton $i.cc.van.rb -text "No Loss Protection" -justify right -value none -variable channel_var
1419	radiobutton $i.cc.red.rb -text "Redundancy" -justify right -value redundant -variable channel_var
1420	radiobutton $i.cc.int.rb -text "Interleaving" -justify right -value interleaved -variable channel_var
1421	pack $i.cc.van.rb $i.cc.red.rb $i.cc.int.rb -side left -anchor nw -padx 2
1422
1423	frame $i.cc.red.fc
1424	label $i.cc.red.fc.l -text "Encoding:"
1425	menubutton $i.cc.red.fc.m -textvariable secenc -indicatoron 1 -menu $i.cc.red.fc.m.menu -relief raised -width 13
1426	menu $i.cc.red.fc.m.menu -tearoff 0
1427
1428	frame $i.cc.red.u
1429	label $i.cc.red.u.l -text "Offset in Pkts:"
1430	tk_optionCmdMenu $i.cc.red.u.m red_off "1" "2" "4" "8"
1431	$i.cc.red.u.m configure -width 13 -highlightthickness 0 -bd 1
1432	pack $i.cc.red.u -side right -anchor e -fill y
1433	pack $i.cc.red.u.l $i.cc.red.u.m -fill x
1434	pack $i.cc.red.fc -side right
1435	pack $i.cc.red.fc.l $i.cc.red.fc.m
1436
1437	frame $i.cc.int.zz
1438	label $i.cc.int.zz.l -text "Units:"
1439	tk_optionCmdMenu $i.cc.int.zz.m int_units 2 4 6 8
1440	$i.cc.int.zz.m configure -width 13 -highlightthickness 0 -bd 1
1441
1442	frame $i.cc.int.fc
1443	label $i.cc.int.fc.l -text "Separation:"
1444	tk_optionCmdMenu $i.cc.int.fc.m int_gap 2 4 6 8
1445	$i.cc.int.fc.m configure -width 13 -highlightthickness 0 -bd 1
1446
1447	pack $i.cc.int.fc $i.cc.int.zz -side right
1448	pack $i.cc.int.fc.l $i.cc.int.fc.m -fill x -expand 1
1449	pack $i.cc.int.zz.l $i.cc.int.zz.m -fill x -expand 1
1450
1451	# Reception Pane ##############################################################
1452	set i .prefs.pane.reception
1453	frame $i
1454	frame $i.r -relief sunken
1455	frame $i.o -relief sunken
1456	frame $i.c -relief sunken
1457	pack $i.r -side top -fill x -pady 0 -ipady 1
1458	pack $i.o -side top -fill both -pady 1
1459	pack $i.c -side top -fill both -pady 1 -expand 1
1460	label $i.r.l -text "Repair Scheme:"
1461	tk_optionCmdMenu $i.r.m repair_var {None}
1462
1463	label $i.r.ls -text "Sample Rate Conversion"
1464	tk_optionCmdMenu $i.r.ms convert_var {None}
1465
1466	$i.r.m configure -width 20 -bd 1
1467	$i.r.ms configure -width 20 -bd 1
1468	pack $i.r.l $i.r.m $i.r.ls $i.r.ms -side top
1469
1470	frame $i.o.f
1471	checkbutton $i.o.f.cb -text "Limit Playout Delay" -variable limit_var
1472	frame $i.o.f.fl
1473	label $i.o.f.fl.l1 -text "Minimum Delay (ms)"
1474	scale $i.o.f.fl.scmin -orient horizontal -from 0 -to 1000 -variable min_var -font $smallfont
1475	frame $i.o.f.fr
1476	label $i.o.f.fr.l2 -text "Maximum Delay (ms)"
1477	scale $i.o.f.fr.scmax -orient horizontal -from 1000 -to 2000 -variable max_var -font $smallfont
1478	pack $i.o.f
1479	pack $i.o.f.cb -side top -fill x
1480	pack $i.o.f.fl $i.o.f.fr -side left
1481	pack $i.o.f.fl.l1 $i.o.f.fl.scmin $i.o.f.fr.l2 $i.o.f.fr.scmax -side top -fill x -expand 1
1482
1483	frame $i.c.f
1484	frame $i.c.f.f
1485	checkbutton $i.c.f.f.lec -text "Lecture Mode" -variable lecture_var
1486	checkbutton $i.c.f.f.ext -text "3D Audio Rendering" -variable 3d_audio_var
1487
1488	pack $i.c.f -fill x -side left -expand 1
1489	pack $i.c.f.f
1490	pack $i.c.f.f.lec -side top -anchor w
1491	pack $i.c.f.f.ext -side top -anchor w
1492
1493	# Audio #######################################################################
1494	set i .prefs.pane.audio
1495	frame $i
1496	frame $i.dd -relief sunken
1497	pack $i.dd -fill both -expand 1 -anchor w -pady 1
1498
1499	frame $i.dd.device
1500	pack $i.dd.device -side top -fill x
1501
1502	label $i.dd.device.l -text "Audio Device:"
1503	pack $i.dd.device.l -side top -fill x
1504	menubutton $i.dd.device.mdev -menu $i.dd.device.mdev.menu -indicatoron 1 \
1505	-textvariable audio_device -relief raised -width 32
1506	pack $i.dd.device.mdev
1507	menu $i.dd.device.mdev.menu -tearoff 0
1508
1509	frame $i.dd.sampling
1510	pack $i.dd.sampling
1511
1512	frame $i.dd.sampling.freq
1513	frame $i.dd.sampling.ch_in
1514	pack $i.dd.sampling.freq $i.dd.sampling.ch_in -side left -fill x
1515
1516	label $i.dd.sampling.freq.l -text "Sample Rate: "
1517	label $i.dd.sampling.ch_in.l -text "Channels:"
1518	pack $i.dd.sampling.freq.l $i.dd.sampling.ch_in.l -fill x
1519
1520	menubutton $i.dd.sampling.freq.mb -menu $i.dd.sampling.freq.mb.m -indicatoron 1 \
1521	-textvariable freq -relief raised
1522	pack $i.dd.sampling.freq.mb -side left -fill x -expand 1
1523	menu $i.dd.sampling.freq.mb.m
1524
1525	menubutton $i.dd.sampling.ch_in.mb -menu $i.dd.sampling.ch_in.mb.m -indicatoron 1 \
1526	-textvariable ichannels -relief raised
1527	pack $i.dd.sampling.ch_in.mb -side left -fill x -expand 1
1528	menu $i.dd.sampling.ch_in.mb.m
1529
1530	frame $i.cks -relief sunken
1531	pack $i.cks -fill both -expand 1 -anchor w -pady 1
1532	frame $i.cks.f
1533	frame $i.cks.f.f
1534	checkbutton $i.cks.f.f.silence -text "Silence Suppression" -variable silence_var
1535	checkbutton $i.cks.f.f.agc -text "Automatic Gain Control" -variable agc_var
1536	checkbutton $i.cks.f.f.loop -text "Audio Loopback" -variable audio_loop_var
1537	checkbutton $i.cks.f.f.suppress -text "Echo Suppression" -variable echo_var
1538	pack $i.cks.f -fill x -side top -expand 1
1539	pack $i.cks.f.f
1540	pack $i.cks.f.f.silence $i.cks.f.f.agc $i.cks.f.f.loop $i.cks.f.f.suppress -side top -anchor w
1541
1542	# Codecs pane #################################################################
1543	set i .prefs.pane.codecs
1544	frame $i
1545	frame $i.of -relief sunken
1546	pack $i.of -fill both -expand 1 -anchor w -pady 1
1547
1548	label $i.of.l -height 2 -width 40 -justify left -text "This panel shows the available codecs, their properties and allows\n their RTP payload types to be re-mapped."
1549	pack $i.of.l -side top -fill x
1550
1551	frame $i.of.codecs
1552
1553	pack $i.of.codecs -side left -padx 2
1554	label $i.of.codecs.l -text "Codec" -relief raised
1555	listbox $i.of.codecs.lb -width 20 -yscrollcommand "$i.of.codecs.scroll set"
1556	scrollbar $i.of.codecs.scroll -command "$i.of.codecs.lb yview"
1557	pack $i.of.codecs.l -side top -fill x
1558	pack $i.of.codecs.scroll $i.of.codecs.lb -side left -fill both
1559
1560	frame $i.of.details
1561	pack $i.of.details -side left -fill both -expand 1
1562
1563	frame $i.of.details.upper
1564	pack $i.of.details.upper -fill x -pady 2
1565
1566	frame $i.of.details.desc
1567	pack $i.of.details.desc -side top -fill x
1568
1569	frame $i.of.details.pt
1570	pack $i.of.details.pt -side bottom -fill x -anchor s
1571	label $i.of.details.pt.l -anchor w -text "RTP payload:"
1572	pack $i.of.details.pt.l -side left -anchor w
1573
1574	entry $i.of.details.pt.e -width 4
1575	pack $i.of.details.pt.e -side left -padx 4
1576
1577	button $i.of.details.pt.b -text "Map Codec" -command map_codec
1578	pack $i.of.details.pt.b -side left -padx 4
1579
1580	label $i.of.details.upper.l0 -text "Details" -relief raised
1581	pack $i.of.details.upper.l0 -side top -fill x -expand 1
1582
1583	frame $i.of.details.upper.l
1584	pack $i.of.details.upper.l -side left
1585	label $i.of.details.upper.l.0 -text "Short name:" -anchor w
1586	label $i.of.details.upper.l.1 -text "Sample Rate (Hz):" -anchor w
1587	label $i.of.details.upper.l.2 -text "Channels:" -anchor w
1588	label $i.of.details.upper.l.3 -text "Bitrate (kbps):" -anchor w
1589	label $i.of.details.upper.l.4 -text "RTP Payload:" -anchor w
1590	for {set idx 0} {$idx < 5} {incr idx} {
1591	pack $i.of.details.upper.l.$idx -side top -fill x
1592	}
1593
1594	frame $i.of.details.upper.r
1595	pack $i.of.details.upper.r -side left -fill x -expand 1
1596	label $i.of.details.upper.r.0 -anchor w
1597	label $i.of.details.upper.r.1 -anchor w
1598	label $i.of.details.upper.r.2 -anchor w
1599	label $i.of.details.upper.r.3 -anchor w
1600	label $i.of.details.upper.r.4 -anchor w
1601	for {set idx 0} {$idx < 5} {incr idx} {
1602	pack $i.of.details.upper.r.$idx -side top -fill x
1603	}
1604
1605	label $i.of.details.desc.l -text "Description:" -anchor w -wraplength 190 -justify left
1606	pack $i.of.details.desc.l -side left -fill x
1607
1608	bind $i.of.codecs.lb <1> {
1609	codecs_panel_select [%W index @%x,%y]
1610	}
1611
1612	bind $i.of.codecs.lb <ButtonRelease-1> {
1613	codecs_panel_select [%W index @%x,%y]
1614	}
1615	proc codecs_panel_fill {} {
1616	global codecs
1617
1618	.prefs.pane.codecs.of.codecs.lb delete 0 end
1619
1620	foreach {c} $codecs {
1621	.prefs.pane.codecs.of.codecs.lb insert end $c
1622	}
1623	}
1624
1625	proc codecs_panel_select { idx } {
1626	global codecs codec_nick_name codec_rate codec_channels codec_pt codec_block_size codec_data_size codec_desc
1627
1628	set codec [lindex $codecs $idx]
1629	set root .prefs.pane.codecs.of.details.upper.r
1630	$root.0 configure -text $codec_nick_name($codec)
1631	$root.1 configure -text $codec_rate($codec)
1632	$root.2 configure -text $codec_channels($codec)
1633
1634	set fps [expr $codec_rate($codec) * 2 * $codec_channels($codec) / $codec_block_size($codec) ]
1635	set kbps [expr 8 * $fps * $codec_data_size($codec) / 1000.0]
1636	$root.3 configure -text [format "%.1f" $kbps]
1637
1638	$root.4 configure -text $codec_pt($codec)
1639
1640	.prefs.pane.codecs.of.details.desc.l configure -text "Description: $codec_desc($codec)"
1641
1642	}
1643
1644	proc map_codec {} {
1645	global codecs
1646
1647	set idx [.prefs.pane.codecs.of.codecs.lb curselection]
1648
1649	if {[llength $idx] == 0} {
1650	return
1651	}
1652
1653	set pt [.prefs.pane.codecs.of.details.pt.e get]
1654	.prefs.pane.codecs.of.details.pt.e delete 0 end
1655
1656	set ptnot [string trim $pt 1234567890]
1657	if {$ptnot != ""} {
1658	return
1659	}
1660
1661	set codec [lindex $codecs $idx]
1662
1663	mbus_send "R" "tool.rat.payload.set" "[mbus_encode_str $codec] $pt"
1664	after 1000 codecs_panel_select $idx
1665	}
1666
1667	# Security Pane ###############################################################
1668	set i .prefs.pane.security
1669	frame $i
1670	frame $i.a -relief sunken
1671	frame $i.a.f
1672	frame $i.a.f.f
1673	label $i.a.f.f.l -anchor w -justify left -text "Your communication can be secured with\nDES encryption. Only conference participants\nwith the same key can receive audio data when\nencryption is enabled."
1674	pack $i.a.f.f.l
1675	pack $i.a -side top -fill both -expand 1
1676	label $i.a.f.f.lbl -text "Key:"
1677	entry $i.a.f.f.e -width 28 -textvariable key
1678	checkbutton $i.a.f.f.cb -text "Enabled" -variable key_var
1679	pack $i.a.f -fill x -side left -expand 1
1680	pack $i.a.f.f
1681	pack $i.a.f.f.lbl $i.a.f.f.e $i.a.f.f.cb -side left -pady 4 -padx 2 -fill x
1682
1683	# Interface Pane ##############################################################
1684	set i .prefs.pane.interface
1685	frame $i
1686	frame $i.a -relief sunken
1687	frame $i.a.f
1688	frame $i.a.f.f
1689	label $i.a.f.f.l -anchor w -justify left -text "The following features may be\ndisabled to conserve processing\npower."
1690	pack $i.a -side top -fill both -expand 1
1691	pack $i.a.f -fill x -side left -expand 1
1692	checkbutton $i.a.f.f.power -text "Powermeters active" -variable meter_var
1693	checkbutton $i.a.f.f.video -text "Video synchronization" -variable sync_var
1694	checkbutton $i.a.f.f.balloon -text "Balloon help" -variable help_on
1695	checkbutton $i.a.f.f.matrix -text "Reception quality matrix" -variable matrix_on -command chart_show
1696	checkbutton $i.a.f.f.plist -text "Participant list" -variable plist_on -command toggle_plist
1697	checkbutton $i.a.f.f.fwin -text "File Control Window" -variable files_on -command file_show
1698	pack $i.a.f.f $i.a.f.f.l
1699	pack $i.a.f.f.power $i.a.f.f.video $i.a.f.f.balloon $i.a.f.f.matrix $i.a.f.f.plist $i.a.f.f.fwin -side top -anchor w
1700
1701	proc set_pane {p base desc} {
1702	upvar 1 $p pane
1703	set tpane [string tolower [lindex [split $pane] 0]]
1704	pack forget $base.$tpane
1705	set tpane [string tolower [lindex [split $desc] 0]]
1706	pack $base.$tpane -fill both -expand 1 -padx 2 -pady 2
1707	set pane $desc
1708	}
1709
1710	# Initialise "About..." toplevel window
1711	toplevel .about
1712	frame .about.rim -relief sunken
1713	frame .about.m
1714	frame .about.rim.d
1715	pack .about.m -fill x
1716	pack .about.rim -padx 4 -pady 2 -side top -fill both -expand 1
1717	pack .about.rim.d -side top -fill both -expand 1
1718
1719	frame .about.m.f
1720	label .about.m.f.l -text "Category:"
1721	menubutton .about.m.f.mb -menu .about.m.f.mb.menu -indicatoron 1 -textvariable about_pane -relief raised -width 10
1722	menu .about.m.f.mb.menu -tearoff 0
1723	.about.m.f.mb.menu add command -label "Credits" -command {set_pane about_pane .about.rim.d "Credits" }
1724	.about.m.f.mb.menu add command -label "Feedback" -command {set_pane about_pane .about.rim.d "Feedback" }
1725	.about.m.f.mb.menu add command -label "Copyright" -command {set_pane about_pane .about.rim.d "Copyright" }
1726
1727	pack .about.m.f
1728	pack .about.m.f.l .about.m.f.mb -side left
1729
1730	#label .about.rim.t.d.logo -highlightthickness 0 -bitmap rat_med
1731
1732	frame .about.rim.d.copyright
1733	frame .about.rim.d.copyright.f
1734	frame .about.rim.d.copyright.f.f
1735	text .about.rim.d.copyright.f.f.blurb -height 17 -yscrollcommand ".about.rim.d.copyright.f.f.scroll set"
1736	scrollbar .about.rim.d.copyright.f.f.scroll -command ".about.rim.d.copyright.f.f.blurb yview"
1737
1738	pack .about.rim.d.copyright.f -expand 1 -fill both
1739	pack .about.rim.d.copyright.f.f
1740	pack .about.rim.d.copyright.f.f.scroll -side right -fill y -expand 1
1741	pack .about.rim.d.copyright.f.f.blurb -side left -expand 1
1742
1743	frame .about.rim.d.credits
1744	frame .about.rim.d.credits.f -relief sunken
1745	frame .about.rim.d.credits.f.f
1746	pack .about.rim.d.credits.f -fill both -expand 1
1747	pack .about.rim.d.credits.f.f -side left -fill x -expand 1
1748	label .about.rim.d.credits.f.f.1 -text "The Robust-Audio Tool was developed in the Department of\nComputer Science, University College London.\n\nProject Supervision:"
1749	label .about.rim.d.credits.f.f.2 -foreground blue -text Good
1750	label .about.rim.d.credits.f.f.3 -text "\nCore Development Team:"
1751	label .about.rim.d.credits.f.f.4 -foreground blue -text Bad
1752	label .about.rim.d.credits.f.f.5 -text "Additional Contributions:"
1753	label .about.rim.d.credits.f.f.6 -foreground blue -text Ugly
1754	for {set i 1} {$i<=6} {incr i} {
1755	pack .about.rim.d.credits.f.f.$i -side top -fill x
1756	}
1757
1758	button .about.dismiss -text Dismiss -command "wm withdraw .about"
1759	pack .about.dismiss -side bottom -anchor e -padx 2 -pady 2
1760
1761	frame .about.rim.d.feedback
1762	frame .about.rim.d.feedback.f -relief sunken
1763	frame .about.rim.d.feedback.f.f
1764	pack .about.rim.d.feedback.f -fill both -expand 1
1765	pack .about.rim.d.feedback.f.f -side left -fill x -expand 1
1766	label .about.rim.d.feedback.f.f.1 -text "Comments, suggestions, and bug-reports should be sent to:"
1767	label .about.rim.d.feedback.f.f.2 -foreground blue -text "rat-trap@cs.ucl.ac.uk\n"
1768	label .about.rim.d.feedback.f.f.3 -text "Further information is available on the world-wide web at:"
1769	label .about.rim.d.feedback.f.f.4 -foreground blue -text "http://www-mice.cs.ucl.ac.uk/multimedia/software/rat/\n"
1770	for {set i 1} {$i<=4} {incr i} {
1771	pack .about.rim.d.feedback.f.f.$i -side top -fill x
1772	}
1773	#pack .about.rim.t.logo .about.rim.t.blurb .about.rim.t.scroll -side right -fill y
1774
1775	wm withdraw .about
1776	wm title .about "About RAT"
1777	wm resizable .about 0 0
1778	set about_pane Copyright
1779	set_pane about_pane .about.rim.d "Credits"
1780	constrain_window .about "XANDXFITNESSXFORXAXPARTICULARXPURPOSEXAREXDISCLAIMED.XINXNOXEVENTX" 0 21 28
1781
1782	.about.rim.d.copyright.f.f.blurb insert end {
1783	Copyright (C) 1995-1999 University College London
1784	All rights reserved.
1785
1786	Redistribution and use in source and binary forms, with or
1787	without modification, is permitted, for non-commercial use
1788	only, provided that the following conditions are met:
1789	1. Redistributions of source code must retain the above
1790	copyright notice, this list of conditions and the
1791	following disclaimer.
1792	2. Redistributions in binary form must reproduce the above
1793	copyright notice, this list of conditions and the
1794	following disclaimer in the documentation and/or other
1795	materials provided with the distribution.
1796	3. All advertising materials mentioning features or use of
1797	this software must display the following acknowledgement:
1798	"This product includes software developed by the
1799	Computer Science Department at University College
1800	London."
1801	4. Neither the name of the University nor of the Department
1802	may be used to endorse or promote products derived from
1803	this software without specific prior written permission.
1804	Use of this software for commercial purposes is explicitly
1805	forbidden unless prior written permission is obtained from
1806	the authors.
1807
1808	THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS
1809	"AS IS" AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING,
1810	BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
1811	AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
1812	SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
1813	INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1814	DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
1815	SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
1816	OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
1817	LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1818	(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
1819	THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
1820	OF SUCH DAMAGE.
1821
1822	This software is derived, in part, from publically available
1823	source code with the following copyright:
1824
1825	Copyright (C) 1991-1993 Regents of the University of California
1826	Copyright (C) 1992 Stichting Mathematisch Centrum, Amsterdam
1827	Copyright (C) 1991-1992 RSA Data Security, Inc
1828	Copyright (C) 1992 Jutta Degener and Carsten Bormann, TU Berlin
1829	Copyright (C) 1994 Paul Stewart
1830	Copyright (C) 1996 Regents of the University of California
1831
1832	This product includes software developed by the Computer
1833	Systems Engineering Group and by the Network Research Group
1834	at Lawrence Berkeley Laboratory.
1835
1836	The WB-ADPCM algorithm was developed by British Telecommunications
1837	plc. Permission has been granted to use it for non-commercial
1838	research and development projects. BT retain the intellectual
1839	property rights to this algorithm.
1840
1841	Encryption features of this software use the RSA Data
1842	Security, Inc. MD5 Message-Digest Algorithm.
1843	}
1844
1845	proc shuffle_rats {args} {
1846	# This should really animate the movement and play fruit-machine sounds.... :-)
1847	set r ""
1848	set end [llength $args]
1849	set l 0
1850	while { $l < $end } {
1851	set toget [expr abs([clock clicks]) % [llength $args]]
1852	set r [format "%s%s " $r [lindex $args $toget]]
1853	set args [lreplace $args $toget $toget]
1854	lappend used $toget
1855	if {$l >0 && [expr ($l + 1) % 3] == 0} {
1856	set r "$r\n"
1857	}
1858	incr l
1859	}
1860	return $r
1861	}
1862
1863	proc jiggle_credits {} {
1864	# Software really developed by the Socialist Department of Computer Science
1865	.about.rim.d.credits.f.f.2 configure -text [shuffle_rats "Angela Sasse" "Vicky Hardman"]
1866	.about.rim.d.credits.f.f.4 configure -text [shuffle_rats "Colin Perkins" "Isidor Kouvelas" "Orion Hodson"]
1867	.about.rim.d.credits.f.f.6 configure -text [shuffle_rats "Darren Harris" "Anna Watson" "Mark Handley" "Jon Crowcroft" "Anna Bouch" "Marcus Iken" "Kris Hasler"]
1868	}
1869
1870	proc sync_ui_to_engine {} {
1871	# the next time the display is shown, it needs to reflect the
1872	# state of the audio engine.
1873	mbus_send "R" "tool.rat.settings" ""
1874	}
1875
1876	proc sync_engine_to_ui {} {
1877	# make audio engine concur with ui
1878	global my_cname rtcp_name rtcp_email rtcp_phone rtcp_loc
1879	global prenc upp channel_var secenc red_off int_gap int_units
1880	global silence_var agc_var audio_loop_var echo_var
1881	global repair_var limit_var min_var max_var lecture_var 3d_audio_var convert_var
1882	global meter_var sync_var gain volume input_port output_port
1883	global in_mute_var out_mute_var ichannels freq key key_var
1884	global audio_device
1885
1886	set my_cname_enc [mbus_encode_str $my_cname]
1887	#rtcp details
1888	mbus_send "R" "rtp.source.name" "$my_cname_enc [mbus_encode_str $rtcp_name]"
1889	mbus_send "R" "rtp.source.email" "$my_cname_enc [mbus_encode_str $rtcp_email]"
1890	mbus_send "R" "rtp.source.phone" "$my_cname_enc [mbus_encode_str $rtcp_phone]"
1891	mbus_send "R" "rtp.source.loc" "$my_cname_enc [mbus_encode_str $rtcp_loc]"
1892
1893	#transmission details
1894	mbus_send "R" "tool.rat.codec" "[mbus_encode_str $prenc] [mbus_encode_str $ichannels] [mbus_encode_str $freq]"
1895	mbus_send "R" "tool.rat.rate" $upp
1896
1897	switch $channel_var {
1898	none {mbus_send "R" "audio.channel.coding" "[mbus_encode_str $channel_var]"}
1899	redundant {mbus_send "R" "audio.channel.coding" "[mbus_encode_str $channel_var] [mbus_encode_str $secenc] $red_off"}
1900	interleaved {mbus_send "R" "audio.channel.coding" "[mbus_encode_str $channel_var] $int_gap $int_units"}
1901	* {error "unknown channel coding scheme $channel_var"}
1902	}
1903
1904	mbus_send "R" "tool.rat.silence" $silence_var
1905	mbus_send "R" "tool.rat.agc" $agc_var
1906	mbus_send "R" "tool.rat.loopback" $audio_loop_var
1907	mbus_send "R" "tool.rat.echo.suppress" $echo_var
1908
1909	#Reception Options
1910	mbus_send "R" "audio.channel.repair" [mbus_encode_str $repair_var]
1911	mbus_send "R" "tool.rat.playout.limit" $limit_var
1912	mbus_send "R" "tool.rat.playout.min" $min_var
1913	mbus_send "R" "tool.rat.playout.max" $max_var
1914	mbus_send "R" "tool.rat.lecture" $lecture_var
1915	mbus_send "R" "tool.rat.3d.enabled" $3d_audio_var
1916	mbus_send "R" "tool.rat.converter" [mbus_encode_str $convert_var]
1917
1918	#Security
1919	if {$key_var==1 && [string length $key]!=0} {
1920	mbus_send "R" "security.encryption.key" [mbus_encode_str $key]
1921	} else {
1922	mbus_send "R" "security.encryption.key" [mbus_encode_str ""]
1923	}
1924
1925	#Interface
1926	mbus_send "R" "tool.rat.powermeter" $meter_var
1927	mbus_send "R" "tool.rat.sync" $sync_var
1928
1929	#device
1930	mbus_send "R" "audio.device" [mbus_encode_str "$audio_device"]
1931	mbus_send "R" "audio.input.gain" $gain
1932	mbus_send "R" "audio.output.gain" $volume
1933	mbus_send "R" "audio.input.port" [mbus_encode_str $input_port]
1934	mbus_send "R" "audio.output.port" [mbus_encode_str $output_port]
1935	mbus_send "R" "audio.input.mute" $in_mute_var
1936	mbus_send "R" "audio.output.mute" $out_mute_var
1937	}
1938
1939	if {$win32 == 0 && [glob ~] == "/"} {
1940	set rtpfname /.RTPdefaults
1941	} else {
1942	set rtpfname ~/.RTPdefaults
1943	}
1944
1945	proc save_setting {f field var} {
1946	global win32 V rtpfname
1947	upvar #0 $var value
1948	if {$win32 == 0} {
1949	catch { puts $f *"$field: $value"** }
1950	} else {
1951	if {[string first "rtp" "$field"] == -1} {
1952	set fail [catch {registry set "HKEY_CURRENT_USER\\Software\\$V(class)\\$V(app)" *"$field" "$value"**} errmsg ]
1953	} else {
1954	set fail [catch {registry set "HKEY_CURRENT_USER\\Software\\$V(class)\\common" *"$field" "$value"**} errmsg ]
1955	}
1956	if {$fail} {
1957	puts "registry set failed:\n$errmsg"
1958	}
1959	}
1960	}
1961
1962	proc save_settings {} {
1963	global rtpfname win32 TOOL my_cname
1964
1965	set f 0
1966	if {$win32 == 0} {
1967	set fail [catch {set f [open $rtpfname w]}]
1968	if {$fail} {
1969	return
1970	}
1971	}
1972
1973	# personal
1974	save_setting $f rtpName rtcp_name
1975	save_setting $f rtpEmail rtcp_email
1976	save_setting $f rtpPhone rtcp_phone
1977	save_setting $f rtpLoc rtcp_loc
1978	save_setting $f audioTool TOOL($my_cname)
1979
1980	# transmission
1981	save_setting $f audioFrequency freq
1982	save_setting $f audioChannelsIn ichannels
1983	save_setting $f audioPrimary prenc
1984	save_setting $f audioUnits upp
1985	save_setting $f audioChannelCoding channel_var
1986	save_setting $f audioRedundancy secenc
1987	save_setting $f audioRedundancyOffset red_off
1988	save_setting $f audioInterleavingGap int_gap
1989	save_setting $f audioInterleavingUnits int_units
1990	save_setting $f audioSilence silence_var
1991	save_setting $f audioAGC agc_var
1992	save_setting $f audioLoopback audio_loop_var
1993	save_setting $f audioEchoSuppress echo_var
1994	# reception
1995	save_setting $f audioRepair repair_var
1996	save_setting $f audioLimitPlayout limit_var
1997	save_setting $f audioMinPlayout min_var
1998	save_setting $f audioMaxPlayout max_var
1999	save_setting $f audioLecture lecture_var
2000	save_setting $f audio3dRendering 3d_audio_var
2001	save_setting $f audioAutoConvert convert_var
2002	#security
2003
2004	# ui bits
2005	save_setting $f audioPowermeters meter_var
2006	save_setting $f audioLipSync sync_var
2007	save_setting $f audioHelpOn help_on
2008	save_setting $f audioMatrixOn matrix_on
2009	save_setting $f audioPlistOn plist_on
2010	save_setting $f audioFilesOn files_on
2011
2012	# device
2013	save_setting $f audioDevice audio_device
2014	save_setting $f audioOutputGain volume
2015	save_setting $f audioInputGain gain
2016	save_setting $f audioOutputPort output_port
2017	save_setting $f audioInputPort input_port
2018
2019	if {$win32 == 0} {
2020	close $f
2021	}
2022	}
2023
2024	proc load_setting {attrname field var default} {
2025	global V win32 $var
2026	upvar 1 $attrname attr
2027	set fail 0
2028	# who has the tcl manual? is the only way to pass arrays thru upvar...
2029	if {$win32} {
2030	if {[string first "rtp" "$field"] == -1} {
2031	set fail [ catch { set tmp *"[registry get HKEY_CURRENT_USER\\Software\\$V(class)\\$V(app) $field]"** } msg ]
2032	} else {
2033	set fail [ catch { set tmp *"[registry get HKEY_CURRENT_USER\\Software\\$V(class)\\common $field]"** } msg ]
2034	}
2035	if {$fail} {
2036	puts "Failed to get $field reason $msg\n";
2037	set tmp ""
2038	} else {
2039	puts "$field $var $tmp"
2040	}
2041	} else {
2042	set tmp [option get . $field rat]
2043	if {$tmp == ""} {
2044	# not in xresources...
2045	if {[info exists attr($field)]} {
2046	set tmp $attr($field)
2047	}
2048	}
2049	}
2050	if {$tmp == ""} {
2051	# either not in rtp defaults, or registry...
2052	set tmp $default
2053	}
2054	set $var $tmp
2055	}
2056
2057	proc tool_version {tool} {
2058	if {![regexp {RAT v[0-9]+\.[0-9]+\.[0-9]+ [a-zA-Z]+} $tool]} {
2059	# Unknown tool version, so put out something which won't
2060	# match with the current version string to force a reset
2061	# of the saved parameters.
2062	return "RAT v0.0.0"
2063	}
2064	regsub {(RAT v[0-9]+\.[0-9]+\.[0-9]+) [a-zA-Z]+} $tool {\1} v
2065	return $v
2066	}
2067
2068	proc load_settings {} {
2069	global rtpfname win32 my_cname TOOL
2070
2071	set attr(zero) ""
2072	if {$win32 == 0} {
2073	if {[file readable $rtpfname]} {
2074	set f [open $rtpfname]
2075	while {[eof $f] == 0} {
2076	gets $f line
2077	set field [string trim [lindex $line 0] *":"**]
2078	set value [lrange $line 1 end]
2079	set attr($field) "$value"
2080	}
2081	close $f
2082	}
2083	}
2084
2085	# personal
2086	load_setting attr rtpName rtcp_name "unknown"
2087	load_setting attr rtpEmail rtcp_email "unknown"
2088	load_setting attr rtpPhone rtcp_phone ""
2089	load_setting attr rtpLoc rtcp_loc ""
2090	load_setting attr audioTool audio_tool ""
2091
2092	# If the version of the saved settings is different
2093	# from those the current version use defaults.
2094	global audio_tool
2095	if {[tool_version $audio_tool] != [tool_version $TOOL($my_cname)]} {
2096	puts "New version of tool ([tool_version $audio_tool]), resetting preferences"
2097	foreach i [array names attr audio*] {
2098	unset attr($i)
2099	}
2100	}
2101	unset audio_tool
2102
2103	# reception
2104	load_setting attr audioRepair repair_var "Repetition"
2105
2106	load_setting attr audioLimitPlayout limit_var "0"
2107	load_setting attr audioMinPlayout min_var "0"
2108	load_setting attr audioMaxPlayout max_var "2000"
2109	load_setting attr audioLecture lecture_var "0"
2110	load_setting attr audio3dRendering 3d_audio_var "0"
2111	load_setting attr audioAutoConvert convert_var "None"
2112	#security
2113
2114	# ui bits
2115	load_setting attr audioPowermeters meter_var "1"
2116	load_setting attr audioLipSync sync_var "0"
2117	load_setting attr audioHelpOn help_on "1"
2118	load_setting attr audioMatrixOn matrix_on "0"
2119	load_setting attr audioPlistOn plist_on "1"
2120	load_setting attr audioFilesOn files_on "0"
2121
2122	# device config
2123	load_setting attr audioOutputGain volume "50"
2124	load_setting attr audioInputGain gain "50"
2125	load_setting attr audioOutputPort output_port "speaker"
2126	load_setting attr audioInputPort input_port "microphone"
2127	# we don't save the following but we can set them so if people
2128	# want to start with mic open then they add following attributes
2129	load_setting attr audioOutputMute out_mute_var "0"
2130	load_setting attr audioInputMute in_mute_var "1"
2131	# transmission
2132	load_setting attr audioSilence silence_var "1"
2133	load_setting attr audioAGC agc_var "0"
2134	load_setting attr audioLoopback audio_loop_var "0"
2135	load_setting attr audioEchoSuppress echo_var "0"
2136	load_setting attr audioFrequency freq "8-kHz"
2137	load_setting attr audioChannelsIn ichannels "Mono"
2138	load_setting attr audioPrimary prenc "GSM"
2139	load_setting attr audioUnits upp "2"
2140	load_setting attr audioChannelCoding channel_var "none"
2141	load_setting attr audioRedundancy secenc "GSM"
2142	load_setting attr audioRedundancyOffset red_off "1"
2143	load_setting attr audioInterleavingGap int_gap "4"
2144	load_setting attr audioInterleavingUnits int_units "4"
2145	#device
2146	load_setting attr audioDevice audio_device "Unknown"
2147
2148	global prenc ichannels freq
2149	mbus_send "R" "tool.rat.codec" "[mbus_encode_str $prenc] [mbus_encode_str $ichannels] [mbus_encode_str $freq]"
2150
2151	global in_mute_var out_mute_var
2152	input_mute $in_mute_var
2153	output_mute $out_mute_var
2154	}
2155
2156	proc check_rtcp_name {} {
2157	global rtcp_name
2158	if {$rtcp_name == ""} {
2159	toplevel .name
2160	wm title .name "RAT User Information"
2161	message .name.m -width 1000 -text {
2162	Please enter the following details, for transmission
2163	to other conference participants.
2164	}
2165	frame .name.b
2166	label .name.b.res -text "Name:"
2167	entry .name.b.e -highlightthickness 0 -width 20 -relief sunken -textvariable rtcp_name
2168	button .name.d -text Done -command {save_settings; sync_engine_to_ui; destroy .name}
2169	bind .name.b.e <Return> {save_settings; sync_engine_to_ui; destroy .name}
2170
2171	pack .name.m -side top -fill x -expand 1
2172	pack .name.b -side top -fill x -expand 1
2173	pack .name.b.res -side left
2174	pack .name.b.e -side right -fill x -expand 1
2175	pack .name.d -side bottom -fill x -expand 1
2176	wm resizable .name 0 0
2177	update
2178	raise .name .
2179	}
2180	}
2181
2182	#
2183	# Routines to display the "chart" of RTCP RR statistics...
2184	#
2185
2186	set chart_font 6x10
2187	set chart_size 1
2188	set chart_boxsize 15
2189	set chart_xoffset 180
2190	set chart_yoffset 17
2191
2192	toplevel .chart
2193	wm protocol .chart WM_DELETE_WINDOW {set matrix_on 0; chart_show}
2194	canvas .chart.c -background white -xscrollcommand {.chart.sb set} -yscrollcommand {.chart.sr set}
2195	scrollbar .chart.sr -orient vertical -command {.chart.c yview}
2196	scrollbar .chart.sb -orient horizontal -command {.chart.c xview}
2197	button .chart.d -text "Dismiss" -command {set matrix_on 0; chart_show}
2198
2199	pack .chart.d -side bottom -expand 0 -anchor e -padx 2 -pady 2
2200	pack .chart.sb -side bottom -fill x -expand 0 -anchor s
2201	pack .chart.sr -side right -fill y -expand 0 -anchor e
2202	pack .chart.c -side left -fill both -expand 1 -anchor n
2203
2204	# Add a few labels to the chart...
2205	.chart.c create text 2 [expr ($chart_boxsize / 2) + 2] -anchor w -text "Sender:" -font $chart_font
2206	.chart.c create line $chart_xoffset [expr $chart_boxsize + 2] $chart_xoffset 2
2207	.chart.c create line $chart_xoffset 2 2 2
2208
2209	proc chart_enlarge {new_size} {
2210	global chart_size
2211	global chart_boxsize
2212	global chart_xoffset
2213	global chart_yoffset
2214	global chart_font
2215
2216	if {$new_size < $chart_size} {
2217	return
2218	}
2219
2220	for {set i 0} {$i <= $new_size} {incr i} {
2221	set s1 $chart_xoffset
2222	set s2 [expr $chart_yoffset + ($chart_boxsize * $i)]
2223	set s3 [expr $chart_xoffset + ($chart_boxsize * $new_size)]
2224	set s4 [expr $chart_xoffset + ($chart_boxsize * $i)]
2225	set s5 $chart_yoffset
2226	set s6 [expr $chart_yoffset + ($chart_boxsize * $new_size)]
2227	.chart.c create line $s1 $s2 $s3 $s2
2228	.chart.c create line $s4 $s5 $s4 $s6
2229	}
2230
2231	for {set i 0} {$i < $new_size} {incr i} {
2232	set s1 $chart_xoffset
2233	set s2 [expr $chart_yoffset + ($chart_boxsize * $i)]
2234	set s3 [expr $chart_xoffset + ($chart_boxsize * $new_size)]
2235	set s4 [expr $chart_xoffset + ($chart_boxsize * $i)]
2236	set s5 $chart_yoffset
2237	set s6 [expr $chart_yoffset + ($chart_boxsize * $new_size)]
2238	.chart.c create text [expr $chart_xoffset - 2] [expr $s2 + ($chart_boxsize / 2)] -text $i -anchor e -font $chart_font
2239	.chart.c create text [expr $s4 + ($chart_boxsize / 2)] [expr $chart_yoffset - 2] -text $i -anchor s -font $chart_font
2240	}
2241	.chart.c configure -scrollregion "0 0 [expr $s3 + 1] [expr $s6 + 1]"
2242	set chart_size $new_size
2243	}
2244
2245	proc chart_set {dest srce val} {
2246	global INDEX chart_size chart_boxsize chart_xoffset chart_yoffset
2247
2248	if {[array names INDEX $srce] != [list $srce]} {
2249	return
2250	}
2251	if {[array names INDEX $dest] != [list $dest]} {
2252	return
2253	}
2254	set x $INDEX($srce)
2255	set y $INDEX($dest)
2256
2257	if {($x > $chart_size) \|\| ($x < 0)} return
2258	if {($y > $chart_size) \|\| ($y < 0)} return
2259	if {($val > 101) \|\| ($val < 0)} return
2260
2261	set xv [expr ($x * $chart_boxsize) + $chart_xoffset + 1]
2262	set yv [expr ($y * $chart_boxsize) + $chart_yoffset + 1]
2263
2264	if {$val < 5} {
2265	set colour green
2266	} elseif {$val < 10} {
2267	set colour orange
2268	} elseif {$val <= 100} {
2269	set colour red
2270	} else {
2271	set colour white
2272	}
2273
2274	.chart.c create rectangle $xv $yv [expr $xv + $chart_boxsize - 2] [expr $yv + $chart_boxsize - 2] -fill $colour -outline $colour
2275	}
2276
2277	proc chart_label {cname} {
2278	global CNAME NAME INDEX chart_size chart_boxsize chart_xoffset chart_yoffset chart_font
2279
2280	set pos $INDEX($cname)
2281	set val $NAME($cname)
2282	if {[string length $val] == 0} {
2283	set val $CNAME($cname)
2284	}
2285
2286	if {($pos > $chart_size) \|\| ($pos < 0)} return
2287
2288	set ypos [expr $chart_yoffset + ($chart_boxsize * $pos) + ($chart_boxsize / 2)]
2289	.chart.c delete cname_$cname
2290	.chart.c create text 2 $ypos -text [string range $val 0 25] -anchor w -font $chart_font -tag cname_$cname
2291	}
2292
2293	proc chart_redraw {size} {
2294	# This is not very efficient... [csp]
2295	global CNAME NAME INDEX chart_size chart_boxsize chart_xoffset chart_yoffset chart_font
2296
2297	.chart.c delete all
2298	set chart_size 0
2299	chart_enlarge $size
2300	set j 0
2301	foreach i [array names CNAME] {
2302	set INDEX($i) $j
2303	chart_label $i
2304	incr j
2305	}
2306	}
2307
2308	proc chart_show {} {
2309	global matrix_on
2310	if {$matrix_on} {
2311	wm deiconify .chart
2312	} else {
2313	wm withdraw .chart
2314	}
2315	}
2316
2317	wm withdraw .chart
2318	wm title .chart "Reception quality matrix"
2319	wm geometry .chart 320x200
2320
2321	chart_enlarge 1
2322
2323	#
2324	# End of RTCP RR chart routines
2325	#
2326
2327	#
2328	# File Control Window
2329	#
2330
2331	catch {
2332	toplevel .file
2333	wm protocol .file WM_DELETE_WINDOW {set files_on 0; file_show}
2334	frame .file.play
2335	frame .file.rec
2336	pack .file.play -side left
2337	pack .file.rec -side right
2338
2339	label .file.play.l -text "Playback"
2340	pack .file.play.l -side top -fill x
2341	label .file.rec.l -text "Record"
2342	pack .file.rec.l -side top -fill x
2343
2344	wm withdraw .file
2345	wm title .file "RAT File Control"
2346
2347	foreach action { play rec } {
2348	frame .file.$action.buttons
2349	pack .file.$action.buttons
2350	button .file.$action.buttons.disk -bitmap disk -command "fileDialog $action"
2351	pack .file.$action.buttons.disk -side left
2352	foreach cmd "$action pause stop" {
2353	button .file.$action.buttons.$cmd -bitmap $cmd -state disabled -command file_$action\_$cmd
2354	pack .file.$action.buttons.$cmd -side left
2355	}
2356	}
2357	} fwinerr
2358
2359	if {$fwinerr != {}} {
2360	puts stderr $fwinerr
2361	}
2362
2363	proc fileDialog {cmdbox} {
2364	global win32 tcl_platform
2365
2366	set defaultExtension au
2367	set defaultLocation .
2368
2369	switch -glob $tcl_platform(os) {
2370	SunOS {
2371	if [file exists /usr/demo/SOUND/sounds] { set defaultLocation /usr/demo/SOUND/sounds }
2372	}
2373	Windows* {
2374	if [file exists C:/Windows/Media] { set defaultLocation C:/Windows/Media }
2375	set defaultExtension wav
2376	}
2377	}
2378
2379	set types {
2380	{"NeXT/Sun Audio files" "au"}
2381	{"Microsoft RIFF files" "wav"}
2382	{"All files" *""**}
2383	}
2384
2385	if {![string compare $cmdbox "play"]} {
2386	catch { asFileBox .playfilebox -defaultextension $defaultExtension -command file_open_$cmdbox -directory $defaultLocation -extensions $types } asferror
2387	} else {
2388	catch { asFileBox .recfilebox -defaultextension $defaultExtension -command file_open_$cmdbox -extensions $types -force_extension 1 } asferror
2389	}
2390
2391	if {$asferror != ""} {
2392	puts stderr asferror
2393	}
2394	}
2395
2396	proc file_show {} {
2397	global files_on
2398
2399	if {$files_on} {
2400	wm deiconify .file
2401	} else {
2402	wm withdraw .file
2403	}
2404	}
2405
2406	proc file_play_live {} {
2407	# Request heart beat to determine if file is valid
2408	mbus_send "R" audio.file.play.live ""
2409	}
2410
2411	proc file_rec_live {} {
2412	# Request heart beat to determine if file is valid
2413	mbus_send "R" audio.file.record.live ""
2414	}
2415
2416	proc file_open_play {path} {
2417	global play_file
2418
2419	mbus_send "R" "audio.file.play.open" [mbus_encode_str $path]
2420	mbus_send "R" "audio.file.play.pause" 1
2421	set play_file(state) paused
2422	set play_file(name) $path
2423
2424	# Test whether file is still playing/valid
2425	after 200 file_play_live
2426	}
2427
2428	proc file_open_rec {path} {
2429	global rec_file
2430
2431	mbus_send "R" "audio.file.record.open" [mbus_encode_str $path]
2432	mbus_send "R" "audio.file.record.pause" 1
2433
2434	set rec_file(state) paused
2435	set rec_file(name) $path
2436
2437	# Test whether file is still recording/valid
2438	after 200 file_rec_live
2439	}
2440
2441	proc file_enable_play { } {
2442	.file.play.buttons.play configure -state normal
2443	.file.play.buttons.pause configure -state disabled
2444	.file.play.buttons.stop configure -state disabled
2445	}
2446
2447	proc file_enable_record { } {
2448	.file.rec.buttons.rec configure -state normal
2449	.file.rec.buttons.pause configure -state disabled
2450	.file.rec.buttons.stop configure -state disabled
2451	}
2452
2453	proc file_play_play {} {
2454	global play_file
2455
2456	catch {
2457	puts stderr $play_file(state)
2458	if {$play_file(state) == "paused"} {
2459	mbus_send "R" "audio.file.play.pause" 0
2460	puts stderr "unpaused"
2461	} else {
2462	mbus_send "R" "audio.file.play.open" [mbus_encode_str $play_file(name)]
2463	puts stderr "re-opening"
2464	}
2465	set play_file(state) play
2466	} pferr
2467
2468	if { $pferr != "play" } { puts stderr "pferr: $pferr" }
2469
2470	.file.play.buttons.play configure -state disabled
2471	.file.play.buttons.pause configure -state normal
2472	.file.play.buttons.stop configure -state normal
2473
2474	after 200 file_play_live
2475	}
2476
2477	proc file_play_pause {} {
2478	global play_file
2479
2480	.file.play.buttons.play configure -state normal
2481	.file.play.buttons.pause configure -state disabled
2482	.file.play.buttons.stop configure -state normal
2483
2484	set play_file(state) paused
2485	mbus_send "R" "audio.file.play.pause" 1
2486	}
2487
2488	proc file_play_stop {} {
2489	global play_file
2490
2491	set play_file(state) end
2492	file_enable_play
2493	mbus_send "R" "audio.file.play.stop" ""
2494	}
2495
2496	proc file_rec_rec {} {
2497	global rec_file
2498
2499	catch {
2500	puts stderr $rec_file(state)
2501	if {$rec_file(state) == "paused"} {
2502	mbus_send "R" "audio.file.record.pause" 0
2503	} else {
2504	mbus_send "R" "audio.file.record.open" [mbus_encode_str $rec_file(name)]
2505	}
2506	set rec_file(state) record
2507	} prerr
2508
2509	if { $prerr != "record" } { puts stderr "prerr: $prerr" }
2510
2511	.file.rec.buttons.rec configure -state disabled
2512	.file.rec.buttons.pause configure -state normal
2513	.file.rec.buttons.stop configure -state normal
2514
2515	after 200 file_rec_live
2516	}
2517
2518	proc file_rec_pause {} {
2519	global rec_file
2520
2521	.file.rec.buttons.rec configure -state normal
2522	.file.rec.buttons.pause configure -state disabled
2523	.file.rec.buttons.stop configure -state normal
2524
2525	set rec_file(state) paused
2526	mbus_send "R" "audio.file.rec.pause" 1
2527	}
2528
2529	proc file_rec_stop {} {
2530	global rec_file
2531
2532	set rec_file(state) end
2533	file_enable_record
2534	mbus_send "R" "audio.file.record.stop" ""
2535	}
2536
2537	#
2538	# End of File Window routines
2539	#
2540
2541	bind . <t> {mbus_send "R" "toggle.input.port" ""}
2542
2543	proc show_help {window} {
2544	global help_text help_on help_id
2545	if {$help_on} {
2546	.help.text configure -text $help_text($window)
2547	# Beware! Don't put the popup under the cursor! Else we get window enter
2548	# for .help and leave for $window, making us hide_help which removes the
2549	# help window, giving us a window enter for $window making us popup the
2550	# help again.....
2551	if {[winfo width $window] > [winfo height $window]} {
2552	set xpos [expr [winfo pointerx $window] + 10]
2553	set ypos [expr [winfo rooty $window] + [winfo height $window] + 4]
2554	} else {
2555	set xpos [expr [winfo rootx $window] + [winfo width $window] + 4]
2556	set ypos [expr [winfo pointery $window] + 10]
2557	}
2558
2559	wm geometry .help +$xpos+$ypos
2560	set help_id [after 100 wm deiconify .help]
2561	raise .help $window
2562	}
2563	}
2564
2565	proc hide_help {window} {
2566	global help_id help_on
2567	if {[info exists help_id]} {
2568	after cancel $help_id
2569	}
2570	wm withdraw .help
2571	}
2572
2573	proc add_help {window text} {
2574	global help_text
2575	set help_text($window) $text
2576	bind $window <Enter> "+show_help $window"
2577	bind $window <Leave> "+hide_help $window"
2578	}
2579
2580	bind Entry <KeyPress> "+hide_help %W"
2581	toplevel .help -bg black
2582	label .help.text -bg lavender -justify left
2583	pack .help.text -side top -anchor w -fill x
2584	wm transient .help .
2585	wm withdraw .help
2586	wm overrideredirect .help true
2587
2588	add_help .r.c.gain.s2 "This slider controls the volume\nof the sound you send."
2589	add_help .r.c.gain.l2 "Click to change input device."
2590	add_help .r.c.gain.t2 "If this button is not pushed in, you are are transmitting,\nand may be\
2591	heard by other participants. Holding down the\nright mouse button in\
2592	any RAT window will temporarily\ntoggle the state of this button,\
2593	allowing for easy\npush-to-talk operation."
2594	add_help .r.c.gain.b2 "Indicates the loudness of the\nsound you are sending. If this\nis\
2595	moving, you may be heard by\nthe other participants."
2596
2597	add_help .r.c.vol.s1 "This slider controls the volume\nof the sound you hear."
2598	add_help .r.c.vol.l1 "Click to change output device."
2599	add_help .r.c.vol.t1 "If pushed in, reception is muted."
2600	add_help .r.c.vol.b1 "Indicates the loudness of the\nsound you are hearing."
2601
2602	add_help .l.f "Name of the session, and the IP address, port\n&\
2603	TTL used to transmit the audio data."
2604	add_help .l.t "The participants in this session with you at the top.\nClick on a name\
2605	with the left mouse button to display\ninformation on that participant,\
2606	and with the middle\nbutton to mute that participant (the right button\nwill\
2607	toggle the transmission mute button, as usual)."
2608
2609	add_help .l.s1.opts "Brings up another window allowing\nthe control of various options."
2610	add_help .l.s1.about "Brings up another window displaying\ncopyright & author information."
2611	add_help .l.s1.quit "Press to leave the session."
2612
2613	# preferences help
2614	add_help .prefs.m.f.m "Click here to change the preference\ncategory."
2615	set i .prefs.buttons
2616	add_help $i.bye "Cancel changes."
2617	add_help $i.apply "Apply changes."
2618	add_help $i.save "Save and apply changes."
2619
2620	# user help
2621	set i .prefs.pane.personal.a.f.f.ents
2622	add_help $i.name "Enter your name for transmission\nto other participants."
2623	add_help $i.email "Enter your email address for transmission\nto other participants."
2624	add_help $i.phone "Enter your phone number for transmission\nto other participants."
2625	add_help $i.loc "Enter your location for transmission\nto other participants."
2626
2627	#audio help
2628	set i .prefs.pane.audio
2629	add_help $i.dd.device.mdev "Selects preferred audio device."
2630	add_help $i.dd.sampling.freq.mb \
2631	"Sets the sampling rate of the audio device.\nThis changes the available codecs."
2632	add_help $i.dd.sampling.ch_in.mb \
2633	"Changes between mono and stereo audio input."
2634	add_help $i.cks.f.f.silence\
2635	"Prevents silence from being transmitted when the speaker is silent\n\
2636	and the input is unmuted."
2637	add_help $i.cks.f.f.agc "Enables automatic control of the volume\nof the sound you send."
2638	add_help $i.cks.f.f.loop "Enables hardware for loopback of audio input."
2639	add_help $i.cks.f.f.suppress \
2640	"Mutes microphone when playing audio."
2641
2642	# transmission help
2643	set i .prefs.pane.transmission
2644
2645	add_help $i.dd.units.m "Sets the duration of each packet sent.\nThere is a fixed per-packet\
2646	overhead, so\nmaking this larger will reduce the total\noverhead.\
2647	The effects of packet loss are\nmore noticable with large packets."
2648	add_help $i.dd.pri.m "Changes the primary audio compression\nscheme. The list is arranged\
2649	with high-\nquality, high-bandwidth choices at the\ntop, and\
2650	poor-quality, lower-bandwidth\nchoices at the bottom."
2651	add_help $i.cc.van.rb "Sets no channel coding."
2652	add_help $i.cc.red.rb "Piggybacks earlier units of audio into packets\n\
2653	to protect against packet loss. Some audio\n\
2654	tools (eg: vat-4.0) are not able to receive\n\
2655	audio sent with this option."
2656	add_help $i.cc.red.fc.m \
2657	"Sets the format of the piggybacked data."
2658	add_help $i.cc.red.u.m \
2659	"Sets the offset of the piggybacked data."
2660	add_help $i.cc.int.fc.m \
2661	"Sets the separation of adjacent units within\neach packet. Larger values correspond\
2662	to longer\ndelays."
2663	add_help $i.cc.int.zz.m "Number of compound units per packet."
2664	add_help $i.cc.int.rb "Enables interleaving which exchanges latency\n\
2665	for protection against burst losses. No other\n\
2666	audio tools can decode this format (experimental)."
2667
2668	# Reception Help
2669	set i .prefs.pane.reception
2670	add_help $i.r.m "Sets the type of repair applied when packets are\nlost. The schemes\
2671	are listed in order of increasing\ncomplexity and quality of repair."
2672	add_help $i.r.ms "Sets the type of sample rate conversion algorithm\n\
2673	that will be applied to streams that differ in rate\n\
2674	to the audio device rate."
2675	add_help $i.o.f.cb "Enforce playout delay limits set below.\nThis is not usually desirable."
2676	add_help $i.o.f.fl.scmin "Sets the minimum playout delay that will be\napplied to incoming\
2677	audio streams."
2678	add_help $i.o.f.fr.scmax "Sets the maximum playout delay that will be\napplied to incoming\
2679	audio streams."
2680	add_help $i.c.f.f.lec "If enabled, extra delay is added at both sender and receiver.\nThis allows\
2681	the receiver to better cope with host scheduling\nproblems, and the sender\
2682	to perform better silence suppression.\nAs the name suggests, this option\
2683	is intended for scenarios such\nas transmitting a lecture, where interactivity\
2684	is less important\nthan quality."
2685
2686	# security...too obvious for balloon help!
2687	add_help .prefs.pane.security.a.f.f.e "Due to government export restrictions\nhelp\
2688	for this option is not available."
2689
2690	# interface...ditto!
2691	set i .prefs.pane.interface
2692	add_help $i.a.f.f.power "Disable display of audio powermeters. This\nis only\
2693	useful if you have a slow machine"
2694	add_help $i.a.f.f.video "Enable lip-synchronisation, if\nyou\
2695	have a compatible video tool"
2696	add_help $i.a.f.f.balloon "If you can see this, balloon help\nis enabled. If not, it isn't."
2697	add_help $i.a.f.f.matrix "Displays a chart showing the reception\nquality reported by all participants"
2698	add_help $i.a.f.f.plist "Hides the list of participants"
2699
2700	add_help .chart "This chart displays the reception quality reported\n by all session\
2701	participants. Looking along a row\n gives the quality with which that\
2702	participant was\n received by all other participants in the session:\n green\
2703	is good quality, orange medium quality, and\n red poor quality audio."
2704
2705	} script_error
2706
2707	if { $script_error != "" } {
2708	puts "Error: \"$script_error\""
2709	destroy .
2710	exit -1
2711	}

Note: See TracBrowser for help on using the browser.

Context Navigation

root/rat/trunk/ui_audiotool.tcl @ 2271

Download in other formats: