root/rat/trunk/ui_audiotool.tcl @ 2862

Revision 2862, 92.8 KB (checked in by ucaccsp, 15 years ago)

More windows fixes...

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