root/rat/trunk/ui_audiotool.tcl @ 2260

Revision 2260, 88.4 KB (checked in by ucacoxh, 15 years ago)

- Remap codecs now checks codec being mapped is not one of encodings
being used by transmitter.

- Fixed sequence of updates in ui so codecs displayed always correct.

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