root/rat/trunk/ui_audiotool.tcl @ 2271

Revision 2271, 88.5 KB (checked in by ucaccsp, 15 years ago)

Debugging code; fix indentation in places (someone's been using the MS
editor which changes tabs to sequences of 4 spaces!)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
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        puts "New version of tool ([tool_version $audio_tool]), resetting preferences"
2097        foreach i [array names attr audio*] {
2098            unset attr($i)
2099        }
2100    }
2101    unset audio_tool
2102
2103    # reception
2104    load_setting attr audioRepair       repair_var    "Repetition"
2105
2106    load_setting attr audioLimitPlayout limit_var     "0"
2107    load_setting attr audioMinPlayout   min_var       "0"
2108    load_setting attr audioMaxPlayout   max_var       "2000"
2109    load_setting attr audioLecture      lecture_var   "0"
2110    load_setting attr audio3dRendering  3d_audio_var   "0"
2111    load_setting attr audioAutoConvert  convert_var   "None"
2112    #security
2113   
2114    # ui bits
2115    load_setting attr audioPowermeters  meter_var     "1"
2116    load_setting attr audioLipSync      sync_var      "0"
2117    load_setting attr audioHelpOn       help_on       "1"
2118    load_setting attr audioMatrixOn     matrix_on     "0"
2119    load_setting attr audioPlistOn      plist_on      "1"
2120    load_setting attr audioFilesOn      files_on      "0"
2121
2122    # device config
2123    load_setting attr audioOutputGain   volume       "50"
2124    load_setting attr audioInputGain    gain         "50"
2125    load_setting attr audioOutputPort   output_port  "speaker"
2126    load_setting attr audioInputPort    input_port   "microphone"
2127    # we don't save the following but we can set them so if people
2128    # want to start with mic open then they add following attributes
2129    load_setting attr audioOutputMute   out_mute_var "0"
2130    load_setting attr audioInputMute    in_mute_var  "1"
2131    # transmission
2132    load_setting attr audioSilence           silence_var   "1"
2133    load_setting attr audioAGC               agc_var       "0"
2134    load_setting attr audioLoopback          audio_loop_var "0"
2135    load_setting attr audioEchoSuppress      echo_var      "0"
2136    load_setting attr audioFrequency         freq          "8-kHz"
2137    load_setting attr audioChannelsIn        ichannels     "Mono"
2138    load_setting attr audioPrimary           prenc         "GSM"
2139    load_setting attr audioUnits             upp           "2"
2140    load_setting attr audioChannelCoding     channel_var   "none"
2141    load_setting attr audioRedundancy        secenc        "GSM"
2142    load_setting attr audioRedundancyOffset  red_off       "1"
2143    load_setting attr audioInterleavingGap   int_gap       "4"
2144    load_setting attr audioInterleavingUnits int_units     "4"
2145    #device
2146    load_setting attr audioDevice            audio_device  "Unknown"
2147
2148    global prenc ichannels freq
2149    mbus_send "R" "tool.rat.codec" "[mbus_encode_str $prenc] [mbus_encode_str $ichannels] [mbus_encode_str $freq]"
2150
2151    global      in_mute_var   out_mute_var
2152    input_mute  $in_mute_var
2153    output_mute $out_mute_var
2154}
2155
2156proc check_rtcp_name {} {
2157    global rtcp_name
2158    if {$rtcp_name == ""} {
2159        toplevel .name
2160        wm title .name "RAT User Information"
2161        message .name.m -width 1000 -text {
2162            Please enter the following details, for transmission
2163            to other conference participants.
2164        }
2165        frame  .name.b
2166        label  .name.b.res -text "Name:"
2167        entry  .name.b.e -highlightthickness 0 -width 20 -relief sunken -textvariable rtcp_name
2168        button .name.d -text Done -command {save_settings; sync_engine_to_ui; destroy .name}
2169        bind   .name.b.e <Return> {save_settings; sync_engine_to_ui; destroy .name}
2170       
2171        pack .name.m -side top -fill x -expand 1
2172        pack .name.b -side top -fill x -expand 1
2173        pack .name.b.res -side left
2174        pack .name.b.e -side right -fill x -expand 1
2175        pack .name.d -side bottom -fill x -expand 1
2176        wm resizable .name 0 0
2177        update
2178        raise .name .
2179    }
2180}
2181
2182#
2183# Routines to display the "chart" of RTCP RR statistics...
2184#
2185
2186set chart_font    6x10
2187set chart_size    1
2188set chart_boxsize 15
2189set chart_xoffset 180
2190set chart_yoffset 17
2191
2192toplevel  .chart
2193wm protocol .chart WM_DELETE_WINDOW    {set matrix_on 0; chart_show}
2194canvas    .chart.c  -background white  -xscrollcommand {.chart.sb set} -yscrollcommand {.chart.sr set}
2195scrollbar .chart.sr -orient vertical   -command {.chart.c yview}
2196scrollbar .chart.sb -orient horizontal -command {.chart.c xview}
2197button    .chart.d  -text "Dismiss"    -command {set matrix_on 0; chart_show}
2198
2199pack .chart.d  -side bottom -expand 0 -anchor e -padx 2 -pady 2
2200pack .chart.sb -side bottom -fill x    -expand 0 -anchor s
2201pack .chart.sr -side right  -fill y    -expand 0 -anchor e
2202pack .chart.c  -side left   -fill both -expand 1 -anchor n
2203
2204# Add a few labels to the chart...
2205.chart.c create text 2 [expr ($chart_boxsize / 2) + 2] -anchor w -text "Sender:" -font $chart_font 
2206.chart.c create line $chart_xoffset [expr $chart_boxsize + 2] $chart_xoffset 2
2207.chart.c create line $chart_xoffset 2 2 2
2208
2209proc chart_enlarge {new_size} {
2210  global chart_size
2211  global chart_boxsize
2212  global chart_xoffset
2213  global chart_yoffset
2214  global chart_font
2215
2216  if {$new_size < $chart_size} {
2217    return
2218  }
2219 
2220  for {set i 0} {$i <= $new_size} {incr i} {
2221    set s1 $chart_xoffset
2222    set s2 [expr $chart_yoffset + ($chart_boxsize * $i)]
2223    set s3 [expr $chart_xoffset + ($chart_boxsize * $new_size)]
2224    set s4 [expr $chart_xoffset + ($chart_boxsize * $i)]
2225    set s5 $chart_yoffset
2226    set s6 [expr $chart_yoffset + ($chart_boxsize * $new_size)]
2227    .chart.c create line $s1 $s2 $s3 $s2
2228    .chart.c create line $s4 $s5 $s4 $s6 
2229  }
2230
2231  for {set i 0} {$i < $new_size} {incr i} {
2232    set s1 $chart_xoffset
2233    set s2 [expr $chart_yoffset + ($chart_boxsize * $i)]
2234    set s3 [expr $chart_xoffset + ($chart_boxsize * $new_size)]
2235    set s4 [expr $chart_xoffset + ($chart_boxsize * $i)]
2236    set s5 $chart_yoffset
2237    set s6 [expr $chart_yoffset + ($chart_boxsize * $new_size)]
2238    .chart.c create text [expr $chart_xoffset - 2] [expr $s2 + ($chart_boxsize / 2)] -text $i -anchor e -font $chart_font
2239    .chart.c create text [expr $s4 + ($chart_boxsize / 2)] [expr $chart_yoffset - 2] -text $i -anchor s -font $chart_font
2240  }
2241  .chart.c configure -scrollregion "0 0 [expr $s3 + 1] [expr $s6 + 1]"
2242  set chart_size $new_size
2243}
2244
2245proc chart_set {dest srce val} {
2246  global INDEX chart_size chart_boxsize chart_xoffset chart_yoffset
2247
2248  if {[array names INDEX $srce] != [list $srce]} {
2249    return
2250  }
2251  if {[array names INDEX $dest] != [list $dest]} {
2252    return
2253  }
2254  set x $INDEX($srce)
2255  set y $INDEX($dest)
2256
2257  if {($x > $chart_size) || ($x < 0)} return
2258  if {($y > $chart_size) || ($y < 0)} return
2259  if {($val > 101) || ($val < 0)}     return
2260
2261  set xv [expr ($x * $chart_boxsize) + $chart_xoffset + 1]
2262  set yv [expr ($y * $chart_boxsize) + $chart_yoffset + 1]
2263
2264  if {$val < 5} {
2265    set colour green
2266  } elseif {$val < 10} {
2267    set colour orange
2268  } elseif {$val <= 100} {
2269    set colour red
2270  } else {
2271    set colour white
2272  }
2273
2274  .chart.c create rectangle $xv $yv [expr $xv + $chart_boxsize - 2] [expr $yv + $chart_boxsize - 2] -fill $colour -outline $colour
2275}
2276
2277proc chart_label {cname} {
2278  global CNAME NAME INDEX chart_size chart_boxsize chart_xoffset chart_yoffset chart_font
2279
2280  set pos $INDEX($cname)
2281  set val $NAME($cname)
2282  if {[string length $val] == 0} {
2283    set val $CNAME($cname)
2284  }
2285
2286  if {($pos > $chart_size) || ($pos < 0)} return
2287
2288  set ypos [expr $chart_yoffset + ($chart_boxsize * $pos) + ($chart_boxsize / 2)]
2289  .chart.c delete cname_$cname
2290  .chart.c create text 2 $ypos -text [string range $val 0 25] -anchor w -font $chart_font -tag cname_$cname
2291}
2292
2293proc chart_redraw {size} {
2294  # This is not very efficient... [csp]
2295  global CNAME NAME INDEX chart_size chart_boxsize chart_xoffset chart_yoffset chart_font
2296
2297  .chart.c delete all
2298  set chart_size 0
2299  chart_enlarge $size
2300  set j 0
2301  foreach i [array names CNAME] {
2302    set INDEX($i) $j
2303    chart_label $i
2304    incr j
2305  }
2306}
2307
2308proc chart_show {} {
2309        global matrix_on
2310        if {$matrix_on} {
2311                wm deiconify .chart
2312        } else {
2313                wm withdraw .chart
2314        }
2315}
2316
2317wm withdraw .chart
2318wm title    .chart "Reception quality matrix"
2319wm geometry .chart 320x200
2320
2321chart_enlarge 1
2322
2323#
2324# End of RTCP RR chart routines
2325#
2326
2327#
2328# File Control Window
2329#
2330
2331catch {
2332    toplevel .file
2333    wm protocol .file WM_DELETE_WINDOW {set files_on 0; file_show}
2334        frame .file.play
2335        frame .file.rec
2336        pack  .file.play -side left
2337        pack  .file.rec  -side right
2338
2339        label .file.play.l -text "Playback"
2340        pack  .file.play.l -side top -fill x
2341        label .file.rec.l -text "Record"
2342        pack  .file.rec.l -side top -fill x
2343
2344        wm withdraw .file
2345        wm title        .file "RAT File Control"
2346
2347        foreach action { play rec } {
2348                frame  .file.$action.buttons
2349                pack   .file.$action.buttons
2350                button .file.$action.buttons.disk -bitmap disk -command "fileDialog $action"
2351                pack   .file.$action.buttons.disk -side left
2352                foreach cmd "$action pause stop" {
2353                        button .file.$action.buttons.$cmd -bitmap $cmd -state disabled -command file_$action\_$cmd
2354                        pack   .file.$action.buttons.$cmd -side left
2355                }
2356        }
2357} fwinerr
2358
2359if {$fwinerr != {}} {
2360        puts stderr $fwinerr
2361}
2362
2363proc fileDialog {cmdbox} {
2364    global win32 tcl_platform
2365   
2366        set defaultExtension au
2367        set defaultLocation  .
2368
2369    switch -glob $tcl_platform(os) {
2370        SunOS    {
2371                if [file exists /usr/demo/SOUND/sounds] { set defaultLocation /usr/demo/SOUND/sounds }
2372                }
2373        Windows* {
2374                if [file exists C:/Windows/Media]       { set defaultLocation C:/Windows/Media }
2375                set defaultExtension wav
2376                }
2377        }
2378   
2379    set types {
2380                {"NeXT/Sun Audio files" "au"}
2381                {"Microsoft RIFF files" "wav"}
2382                {"All files"            "*"}
2383    }
2384   
2385    if {![string compare $cmdbox "play"]} {
2386                catch { asFileBox .playfilebox  -defaultextension $defaultExtension -command file_open_$cmdbox -directory $defaultLocation -extensions $types } asferror
2387    } else {
2388                catch { asFileBox .recfilebox   -defaultextension $defaultExtension -command file_open_$cmdbox  -extensions $types -force_extension 1 } asferror
2389    }
2390       
2391        if {$asferror != ""} {
2392                puts stderr asferror
2393        }
2394}
2395
2396proc file_show {} {
2397    global files_on
2398   
2399    if {$files_on} {
2400                wm deiconify .file
2401    } else {
2402                wm withdraw .file
2403    }
2404}
2405
2406proc file_play_live {} {
2407# Request heart beat to determine if file is valid
2408        mbus_send "R" audio.file.play.live ""
2409}
2410
2411proc file_rec_live {} {
2412# Request heart beat to determine if file is valid
2413        mbus_send "R" audio.file.record.live ""
2414}
2415
2416proc file_open_play {path} {
2417    global play_file
2418
2419    mbus_send "R" "audio.file.play.open" [mbus_encode_str $path]
2420    mbus_send "R" "audio.file.play.pause" 1
2421    set play_file(state) paused
2422    set play_file(name) $path
2423   
2424    # Test whether file is still playing/valid
2425    after 200 file_play_live
2426}
2427
2428proc file_open_rec {path} {
2429    global rec_file
2430
2431    mbus_send "R" "audio.file.record.open" [mbus_encode_str $path]
2432    mbus_send "R" "audio.file.record.pause" 1
2433
2434    set rec_file(state) paused
2435    set rec_file(name)  $path
2436
2437    # Test whether file is still recording/valid
2438    after 200 file_rec_live
2439}
2440
2441proc file_enable_play { } {
2442        .file.play.buttons.play   configure -state normal
2443        .file.play.buttons.pause  configure -state disabled
2444        .file.play.buttons.stop   configure -state disabled
2445}       
2446
2447proc file_enable_record { } {
2448        .file.rec.buttons.rec configure -state normal
2449        .file.rec.buttons.pause  configure -state disabled
2450        .file.rec.buttons.stop   configure -state disabled
2451}
2452
2453proc file_play_play {} {
2454        global play_file
2455       
2456        catch {
2457                puts stderr $play_file(state)
2458                if {$play_file(state) == "paused"} {
2459                        mbus_send "R" "audio.file.play.pause" 0
2460                        puts stderr "unpaused"
2461                } else {
2462                        mbus_send "R" "audio.file.play.open" [mbus_encode_str $play_file(name)]
2463                        puts stderr "re-opening"
2464                }
2465                set play_file(state) play
2466        } pferr
2467
2468        if { $pferr != "play" } { puts stderr "pferr: $pferr" }
2469
2470        .file.play.buttons.play   configure -state disabled
2471        .file.play.buttons.pause  configure -state normal
2472        .file.play.buttons.stop   configure -state normal
2473       
2474        after 200 file_play_live
2475}
2476
2477proc file_play_pause {} {
2478        global play_file
2479       
2480        .file.play.buttons.play   configure -state normal
2481        .file.play.buttons.pause  configure -state disabled
2482        .file.play.buttons.stop   configure -state normal
2483
2484        set play_file(state) paused
2485        mbus_send "R" "audio.file.play.pause" 1
2486}
2487
2488proc file_play_stop {} {
2489        global play_file
2490       
2491        set play_file(state) end
2492        file_enable_play
2493        mbus_send "R" "audio.file.play.stop" ""
2494}
2495
2496proc file_rec_rec {} {
2497        global rec_file
2498       
2499        catch {
2500                puts stderr $rec_file(state)
2501                if {$rec_file(state) == "paused"} {
2502                        mbus_send "R" "audio.file.record.pause" 0
2503                } else {
2504                        mbus_send "R" "audio.file.record.open" [mbus_encode_str $rec_file(name)]
2505                }
2506                set rec_file(state) record
2507        } prerr
2508
2509        if { $prerr != "record" } { puts stderr "prerr: $prerr" }
2510
2511        .file.rec.buttons.rec    configure -state disabled
2512        .file.rec.buttons.pause  configure -state normal
2513        .file.rec.buttons.stop   configure -state normal
2514
2515        after 200 file_rec_live
2516}
2517
2518proc file_rec_pause {} {
2519        global rec_file
2520
2521        .file.rec.buttons.rec    configure -state normal
2522        .file.rec.buttons.pause  configure -state disabled
2523        .file.rec.buttons.stop   configure -state normal
2524
2525        set rec_file(state) paused
2526        mbus_send "R" "audio.file.rec.pause" 1
2527}
2528
2529proc file_rec_stop {} {
2530        global rec_file
2531       
2532        set rec_file(state) end
2533        file_enable_record
2534        mbus_send "R" "audio.file.record.stop" ""
2535}
2536
2537#
2538# End of File Window routines
2539#
2540
2541bind . <t> {mbus_send "R" "toggle.input.port" ""}
2542
2543proc show_help {window} {
2544        global help_text help_on help_id
2545        if {$help_on} {
2546                .help.text  configure -text $help_text($window)
2547                # Beware! Don't put the popup under the cursor! Else we get window enter
2548                # for .help and leave for $window, making us hide_help which removes the
2549                # help window, giving us a window enter for $window making us popup the
2550                # help again.....
2551                if {[winfo width $window] > [winfo height $window]} {
2552                    set xpos [expr [winfo pointerx $window] + 10]
2553                    set ypos [expr [winfo rooty    $window] + [winfo height $window] + 4]
2554                } else {
2555                    set xpos [expr [winfo rootx    $window] + [winfo width $window] + 4]
2556                    set ypos [expr [winfo pointery $window] + 10]
2557                }
2558               
2559                wm geometry  .help +$xpos+$ypos
2560                set help_id [after 100 wm deiconify .help]
2561                raise .help $window
2562        }
2563}
2564
2565proc hide_help {window} {
2566        global help_id help_on
2567        if {[info exists help_id]} {
2568                after cancel $help_id
2569        }
2570        wm withdraw .help
2571}
2572
2573proc add_help {window text} {
2574        global help_text
2575        set help_text($window)  $text
2576        bind $window <Enter>    "+show_help $window"
2577        bind $window <Leave>    "+hide_help $window"
2578}
2579
2580bind Entry   <KeyPress> "+hide_help %W"
2581toplevel .help       -bg black
2582label    .help.text  -bg lavender -justify left
2583pack .help.text -side top -anchor w -fill x
2584wm transient        .help .
2585wm withdraw         .help
2586wm overrideredirect .help true
2587
2588add_help .r.c.gain.s2   "This slider controls the volume\nof the sound you send."
2589add_help .r.c.gain.l2   "Click to change input device."
2590add_help .r.c.gain.t2   "If this button is not pushed in, you are are transmitting,\nand may be\
2591                         heard by other participants. Holding down the\nright mouse button in\
2592                         any RAT window will temporarily\ntoggle the state of this button,\
2593                         allowing for easy\npush-to-talk operation."
2594add_help .r.c.gain.b2   "Indicates the loudness of the\nsound you are sending. If this\nis\
2595                         moving, you may be heard by\nthe other participants."
2596
2597add_help .r.c.vol.s1    "This slider controls the volume\nof the sound you hear."
2598add_help .r.c.vol.l1    "Click to change output device."
2599add_help .r.c.vol.t1    "If pushed in, reception is muted."
2600add_help .r.c.vol.b1    "Indicates the loudness of the\nsound you are hearing."
2601
2602add_help .l.f           "Name of the session, and the IP address, port\n&\
2603                         TTL used to transmit the audio data."
2604add_help .l.t           "The participants in this session with you at the top.\nClick on a name\
2605                         with the left mouse button to display\ninformation on that participant,\
2606                         and with the middle\nbutton to mute that participant (the right button\nwill\
2607                         toggle the transmission mute button, as usual)."
2608
2609add_help .l.s1.opts     "Brings up another window allowing\nthe control of various options."
2610add_help .l.s1.about    "Brings up another window displaying\ncopyright & author information."
2611add_help .l.s1.quit     "Press to leave the session."
2612
2613# preferences help
2614add_help .prefs.m.f.m  "Click here to change the preference\ncategory."
2615set i .prefs.buttons
2616add_help $i.bye         "Cancel changes."
2617add_help $i.apply       "Apply changes."
2618add_help $i.save        "Save and apply changes."
2619
2620# user help
2621set i .prefs.pane.personal.a.f.f.ents
2622add_help $i.name        "Enter your name for transmission\nto other participants."
2623add_help $i.email       "Enter your email address for transmission\nto other participants."
2624add_help $i.phone       "Enter your phone number for transmission\nto other participants."
2625add_help $i.loc         "Enter your location for transmission\nto other participants."
2626
2627#audio help
2628set i .prefs.pane.audio
2629add_help $i.dd.device.mdev "Selects preferred audio device."
2630add_help $i.dd.sampling.freq.mb \
2631                        "Sets the sampling rate of the audio device.\nThis changes the available codecs."
2632add_help $i.dd.sampling.ch_in.mb \
2633                        "Changes between mono and stereo audio input."
2634add_help $i.cks.f.f.silence\
2635                         "Prevents silence from being transmitted when the speaker is silent\n\
2636                          and the input is unmuted."
2637add_help $i.cks.f.f.agc  "Enables automatic control of the volume\nof the sound you send."
2638add_help $i.cks.f.f.loop "Enables hardware for loopback of audio input."
2639add_help $i.cks.f.f.suppress \
2640                         "Mutes microphone when playing audio."
2641
2642# transmission help
2643set i .prefs.pane.transmission
2644
2645add_help $i.dd.units.m  "Sets the duration of each packet sent.\nThere is a fixed per-packet\
2646                         overhead, so\nmaking this larger will reduce the total\noverhead.\
2647                         The effects of packet loss are\nmore noticable with large packets."
2648add_help $i.dd.pri.m    "Changes the primary audio compression\nscheme. The list is arranged\
2649                         with high-\nquality, high-bandwidth choices at the\ntop, and\
2650                         poor-quality, lower-bandwidth\nchoices at the bottom."
2651add_help $i.cc.van.rb   "Sets no channel coding."
2652add_help $i.cc.red.rb   "Piggybacks earlier units of audio into packets\n\
2653                         to protect against packet loss. Some audio\n\
2654                         tools (eg: vat-4.0) are not able to receive\n\
2655                         audio sent with this option."
2656add_help $i.cc.red.fc.m \
2657                        "Sets the format of the piggybacked data."
2658add_help $i.cc.red.u.m \
2659                        "Sets the offset of the piggybacked data."
2660add_help $i.cc.int.fc.m \
2661                        "Sets the separation of adjacent units within\neach packet. Larger values correspond\
2662                         to longer\ndelays."
2663add_help $i.cc.int.zz.m "Number of compound units per packet."
2664add_help $i.cc.int.rb   "Enables interleaving which exchanges latency\n\
2665                         for protection against burst losses.  No other\n\
2666                         audio tools can decode this format (experimental)."
2667
2668# Reception Help
2669set i .prefs.pane.reception
2670add_help $i.r.m         "Sets the type of repair applied when packets are\nlost. The schemes\
2671                         are listed in order of increasing\ncomplexity and quality of repair."
2672add_help $i.r.ms        "Sets the type of sample rate conversion algorithm\n\
2673                         that will be applied to streams that differ in rate\n\
2674                         to the audio device rate."
2675add_help $i.o.f.cb      "Enforce playout delay limits set below.\nThis is not usually desirable."
2676add_help $i.o.f.fl.scmin   "Sets the minimum playout delay that will be\napplied to incoming\
2677                         audio streams."
2678add_help $i.o.f.fr.scmax   "Sets the maximum playout delay that will be\napplied to incoming\
2679                         audio streams."
2680add_help $i.c.f.f.lec   "If enabled, extra delay is added at both sender and receiver.\nThis allows\
2681                         the receiver to better cope with host scheduling\nproblems, and the sender\
2682                         to perform better silence suppression.\nAs the name suggests, this option\
2683                         is intended for scenarios such\nas transmitting a lecture, where interactivity\
2684                         is less important\nthan quality."
2685
2686# security...too obvious for balloon help!
2687add_help .prefs.pane.security.a.f.f.e "Due to government export restrictions\nhelp\
2688                                       for this option is not available."
2689
2690# interface...ditto!
2691set i .prefs.pane.interface
2692add_help $i.a.f.f.power "Disable display of audio powermeters. This\nis only\
2693                         useful if you have a slow machine"
2694add_help $i.a.f.f.video "Enable lip-synchronisation, if\nyou\
2695                         have a compatible video tool"
2696add_help $i.a.f.f.balloon "If you can see this, balloon help\nis enabled. If not, it isn't."
2697add_help $i.a.f.f.matrix  "Displays a chart showing the reception\nquality reported by all participants"
2698add_help $i.a.f.f.plist   "Hides the list of participants"
2699
2700add_help .chart         "This chart displays the reception quality reported\n by all session\
2701                         participants. Looking along a row\n gives the quality with which that\
2702                         participant was\n received by all other participants in the session:\n green\
2703                         is good quality, orange medium quality, and\n red poor quality audio."
2704
2705} script_error
2706
2707if { $script_error != "" } {
2708    puts "Error: \"$script_error\""
2709    destroy .
2710    exit -1
2711}
Note: See TracBrowser for help on using the browser.