root/vic/branches/mpeg4/tcl/ui-main.tcl @ 3988

Revision 3988, 26.7 KB (checked in by piers, 7 years ago)

Updates for correct running under Aqua Tcl/Tk on OSX:
- Removed -colormap option from a number of 'toplevel' calls - doesn't seem to be required and worked on Linux ok.
- Tested with ActiveState?'s Tcl ActiveTcl?8.4.14.0.272572-macosx-universal-threaded.dmg
- Won't work with standard OSX 10.4 Aqua enabled Tcl/Tk as the TKPutImage function is not available.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1#
2# Copyright (c) 1993-1995 Regents of the University of California.
3# All rights reserved.
4#
5# Redistribution and use in source and binary forms, with or without
6# modification, are permitted provided that the following conditions
7# are met:
8# 1. Redistributions of source code must retain the above copyright
9#    notice, this list of conditions and the following disclaimer.
10# 2. Redistributions in binary form must reproduce the above copyright
11#    notice, this list of conditions and the following disclaimer in the
12#    documentation and/or other materials provided with the distribution.
13# 3. All advertising materials mentioning features or use of this software
14#    must display the following acknowledgement:
15#       This product includes software developed by the Network Research
16#       Group at Lawrence Berkeley National Laboratory.
17# 4. Neither the name of the University nor of the Laboratory may be used
18#    to endorse or promote products derived from this software without
19#    specific prior written permission.
20#
21# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
22# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
25# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
30# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
31# SUCH DAMAGE.
32#
33# @(#) $Header$ (LBL)
34#
35
36set updated 0
37
38# Added adios procedure that closes logFrameRate file on exit
39# then calls c++ routine to send RTCP bye message
40#
41proc adios {} {
42
43        if {[yesno logFrameRate]} {
44                global logFrameChannel
45                close $logFrameChannel
46        }
47        # just call C++ based routine that sends a RTCP bye: SessionManager->send_bye()
48        adios_rtcp
49}
50
51proc session args {
52        global V
53        eval $V(session) $args
54}
55
56proc build.bar w {
57
58    global title
59
60    frame $w.bar  -borderwidth 0
61    if {[string equal [tk windowingsystem] "aqua"]} {
62        global V
63        set net $V(data-net)
64        label $w.bar.title -text "TTL: [$net ttl]" -font [smallfont] \
65                -justify left
66        button $w.bar.quit -text Quit \
67                -font [smallfont] \
68                -command adios
69        button $w.bar.menu -text Menu  \
70                -font [smallfont] \
71                -command "toggle_window .menu"
72        button $w.bar.help -text Help \
73                -font [smallfont] \
74                -command "toggle_window .help"
75    } else {
76        global V
77        set net $V(data-net)
78        label $w.bar.title -text "TTL: [$net ttl]" -font [smallfont] \
79                -relief flat -justify left
80        button $w.bar.quit -text Quit -relief raised \
81                -font [smallfont] -command adios \
82                -highlightthickness 1
83        button $w.bar.menu -text Menu -relief raised \
84                -font [smallfont] -highlightthickness 1 \
85                -command "toggle_window .menu"
86        button $w.bar.help -text Help -relief raised \
87                -font [smallfont] -highlightthickness 1 \
88                -command "toggle_window .help"
89    }                               
90    pack $w.bar.title -side left -fill both -expand 1
91    pack $w.bar.menu $w.bar.help $w.bar.quit -side left -padx 1 -pady 1
92}
93
94#
95# Look through the list of available visuals, and choose
96# the best one that vic supports.
97#
98proc lookup_visual {} {
99        set vlist [winfo visualsavailable .]
100        if { [lsearch -exact $vlist "truecolor 24"] >= 0 || \
101                 [lsearch -exact $vlist "truecolor 32"] >= 0 } {
102                set visual "truecolor 24"
103        } elseif { [lsearch -exact $vlist "truecolor 16"] >= 0 } {
104                set visual "truecolor 16"
105        } elseif { [lsearch -exact $vlist "pseudocolor 8"] >= 0 } {
106                set visual "pseudocolor 8"
107        } elseif { [lsearch -exact $vlist "staticgray 1"] >= 0 } {
108                set visual "staticgray 1"
109        } else {
110                puts stderr "vic: no support for your display type"
111                exit 1
112        }
113}
114
115#
116# initialize the visual, colormap, and dither global variables
117# based on  X resources, available visuals, etc.  Create the
118# specified window as a frame widget and set its visual.  We pick
119# the visual only once and startup -- the user cannot change it
120# interactively.  The user can change the dithering algorithms
121# interactively constrained to the selected visual
122# Sets the colormap global variable to $w since this window
123# will always have the reference colormap.
124#
125proc init_visual w {
126        global V
127
128        set V(colormap) $w
129        set dither [option get . dither Vic]
130        if { $dither == "best" } {
131                set dither ed
132        }   
133        set V(gamma) [option get . gamma Vic]
134        if { $dither == "dither" } {
135                set dither od
136        }
137        if { [lsearch -exact "od ed gray quantize" $dither] < 0 } {
138                puts stderr "vic: unknown dither: $dither"
139                exit 1
140        }
141        set visual [option get . visual Vic]
142        if { $visual == "" } {
143                set visual [lookup_visual]
144        } elseif { $visual == "pseudocolor" } {
145                set visual "pseudocolor 8"
146        }
147        set cmap ""
148        if [yesno privateColormap] {
149                set cmap "-colormap new"
150        }
151        if [catch "frame $w -visual {$visual} $cmap"] {
152                puts stderr "$V(app): bad visual: $visual"
153                exit 1
154        }
155        if { [winfo depth $w] == 8 } {
156                set V(dither) $dither
157        }
158        set V(visual) $visual
159}
160
161#
162# initialize the colormodel based on the visual, dither, and colormap
163# global variables.  if we run out of colors, free the colormodel
164# and return false (leaving it up to the caller to fix things)
165# otherwise, return true.  Set the global variable colorModel
166# to the corresponding tcl object.
167#
168proc init_color {} {
169        global V
170        if [info exists V(colorModel)] {
171                delete $V(colorModel)
172                unset V(colorModel)
173        }
174        set v [winfo visual $V(colormap)]
175        set d [winfo depth $V(colormap)]
176        if { $d == 8 } {
177                set id $v/$d/$V(dither)
178        } else {
179                set id $v/$d
180        }
181        set cm [new colormodel $id]
182        if { $cm == "" } {
183                puts stderr "vic: unsupported visual type: $v"
184                exit 1
185        }
186        $cm visual $V(colormap)
187        $cm gamma $V(gamma)
188        #XXX revert to gray?
189        if ![$cm alloc-colors] {
190                delete $cm
191                return 0
192        }
193        set V(colorModel) $cm
194        return 1
195}
196
197#
198# Build the user-interface.
199#
200proc init_gui {} {
201        global V
202        init_visual .top
203        if ![init_color] {
204                if { [winfo depth .top] != 8 } {
205                        puts stderr "vic: internal error: no colors"
206                        exit 2
207                }
208                puts stderr \
209                    "vic: warning: ran out of colors; using private colormap"
210                destroy .top
211                frame .top -visual $V(visual) -colormap new
212                if ![init_color] {
213                        puts stderr "vic: internal error: no colors"
214                        exit 2
215                }
216        }
217   
218        build.srclist
219
220        set_rate_vars $V(session)
221
222        #
223        # emulate implicit keyboard focus
224        #
225        bind . <Enter> { focus %W }
226        #wm focusmodel . active
227        bind . <q> { adios }
228        bind . <Control-c> { adios }
229        bind . <Control-d> { adios }
230
231        foreach i { 1 2 3 4 } {
232                bind . <Key-$i> "redecorate $i"
233        }
234
235        build.bar .top
236        pack .top.bar -fill x -side bottom
237        pack .top -expand 1 -fill both
238
239        label .top.label -text "Waiting for video..."
240        pack .top.label -before .top.bar -anchor c -expand 1
241
242        #
243        # Withdraw window so that user-placement is deferred
244        # until after initial geometry is computed
245        #
246        set geom [option get . geometry Vic]
247        wm withdraw .
248        # added to catch window close action
249        wm protocol . WM_DELETE_WINDOW adios
250        wm geometry . $geom
251        update idletasks
252        set minwidth [winfo reqwidth .]
253        set minheight [winfo reqheight .]
254        #XXX
255        if { $minwidth < 200 } {
256                set minwidth 200
257        }
258        if { $minheight < 100 } {
259                set minheight 100
260        }
261        wm minsize . $minwidth $minheight
262        wm deiconify .
263
264        set V(curcol) 0
265        set V(currow) 0
266        set V(ncol) [option get . tile Vic]
267
268        set V(muteNewSources) [yesno muteNewSources]
269
270        after 1000 periodic_update
271}
272
273proc add_active src {
274        global active
275        set active($src) 1
276        if { [array size active] == 1 } {
277                pack forget .top.label
278
279                set w .top.grid
280                global V
281                set V(grid) $w
282                frame $w
283                pack $w -fill both -anchor n
284        }
285}
286
287proc rm_active src {
288        global active V
289        unset active($src)
290        if { ![yesno relateInterface] && [array size active] == 0 } {
291                pack forget $V(grid)
292                destroy $V(grid)
293                pack .top.label -before .top.bar -anchor c -expand 1
294        }
295}
296
297proc periodic_update { } {
298        if [have grabber] {
299                global V
300                update_rate $V(session)
301        }
302        update idletasks
303        after 1000 periodic_update
304}
305
306proc set_rate_vars src {
307        global fpshat bpshat lhat shat
308        if [info exists fpshat($src)] {
309                unset fpshat($src)
310                unset bpshat($src)
311                unset lhat($src)
312                unset shat($src)
313        }
314        set gain [option get . filterGain Vic]
315        set fpshat($src) 0
316        rate_variable fpshat($src) $gain
317        set bpshat($src) 0
318        rate_variable bpshat($src) $gain
319        set lhat($src) 0
320        rate_variable lhat($src) $gain
321        set shat($src) 0
322        rate_variable shat($src) $gain
323
324#XXX set guys in stat window too!
325}
326       
327#
328# Called when use clicks on thumbnail video window.
329# Create a new window only if the window already
330# isn't being displayed (in locked mode).  In this
331# case, delete the existing window (i.e., clicking
332# on the thumbnail gives a toggle action, but not
333# for voice-switched or browse-mode windows).
334#
335proc select_thumbnail { w src } {
336        global win_src
337        set srcid [$src srcid]
338        foreach w [winfo children .] {
339                # this is fragile
340                set vw $w.frame.video
341                if { [winfo exists $vw] && $srcid == [$win_src($vw) srcid] && \
342                        ![is_switched $vw] } {
343                        destroy_userwin $vw
344                        return
345                }
346        }
347        open_window $src
348}
349
350proc update_source_info src {
351        global src_info src_nickname src_name numLayers numDecoderLayers
352        #
353        # Figure out best presentation from available information.
354        #
355        set name [$src sdes name]
356        set cname [$src sdes cname]
357        set addr [$src addr]
358        set fmt [rtp_format $src]
359        if { $fmt == "pvh" } {
360                if [info exists numDecoderLayers($src)] {
361                        set fmt $fmt\($numDecoderLayers($src)\)
362                } else {
363                        set fmt $fmt\($numLayers\)
364                }
365        }
366        if { $name == "" } {
367                if { $cname == "" } {
368                        set src_nickname($src) $addr
369                        set info $addr/$fmt
370
371                } else {
372                        set src_nickname($src) $cname
373                        set info "$addr/$fmt"
374                }
375        } elseif [cname_redundant $name $cname] {
376                set src_nickname($src) $name
377                set info $addr/$fmt
378        } else {
379                set src_nickname($src) $name
380                set info $cname/$fmt
381        }
382                set src_info($src) $cname/$fmt
383
384        set msg [$src sdes note]
385        if { $msg != "" } {
386                set info $msg
387        }
388        set src_info($src) $info
389       
390        # only call change_name when name really changes
391        if { ![info exists src_name($src)] || "$src_name($src)" != "$name" } {
392                set src_name($src) $name
393                change_name $src
394        }
395}
396
397#
398# This is a hack to get rid of ugly borer when displaying CIF sized
399# images in a NTSC sized windows.
400proc adjust_voff { win d } {
401        set ow [$win width]
402        set oh [$win height]
403        set iw [$d width]
404        set ih [$d height]
405        $win voff 0
406        if { $ow == 320 && $oh == 240 } {
407                if { $iw == 352 && $ih == 288 } {
408                        $win voff 8
409                } elseif { $iw == 176 && $ih == 144 } {
410                }
411        } elseif { $ow == 640 && $oh == 480 } {
412                if { $iw == 352 && $ih == 288 } {
413                        $win voff 16
414                }
415        }
416}
417
418#
419# create a renderer for window $w and attach it to $src
420#
421proc attach_renderer { src w {enable_xv false}} {
422        global win_target win_is_slow win_use_hw V
423        set d [$src handler]
424        set target ""
425        if { ! [info exists win_use_hw($w) ] } {
426                set win_use_hw($w) "software"
427        }
428        if { $win_use_hw($w) == "magic" } {
429                set fmt [rtp_format $src]
430                if { $fmt == "jpeg" } {
431                        set fmt $fmt/[$d decimation]
432                }
433                set target [new assistor $fmt]
434                if { $target != "" } {
435                        $target window $w
436                } else {
437                        set win_use_hw($w) software
438                }
439        } else { if { $win_use_hw($w) != "software" } {
440                set fmt [rtp_format $src]
441                if { $fmt == "jpeg" } {
442                        set fmt $fmt/[$d decimation]
443                }
444                set target [new assistor $win_use_hw($w)/$fmt]
445                if { $target != "" } {
446                        $target window $w
447                } else {
448                        set win_use_hw($w) software
449                }
450        }}
451
452        if { $target == "" } {
453                set target [$V(colorModel) renderer $w [$d decimation]]
454        }
455        if $win_is_slow($w) {
456                $target update-interval [option get . stampInterval Vic]
457        }
458        $target enable_xv $enable_xv
459        adjust_voff $w $d
460        $d attach $target
461        set win_target($w) $target
462}
463
464proc detach_renderer { src w } {
465        global win_target
466        set d [$src handler]
467        $d detach $win_target($w)
468        delete $win_target($w)
469        unset win_target($w)
470}
471
472#
473# bind a source to a window so that the video stream from
474# source $src appears in window $w
475#
476proc attach_window { src w {enable_xv false}} {
477        attach_renderer $src $w $enable_xv
478        global win_src win_list
479        set win_src($w) $src
480        lappend win_list($src) $w
481        if [viewing_window $w] {
482                windowname [winfo toplevel $w] [getid $src]
483        }
484}
485
486proc detach_window { src w } {
487        global win_src win_list
488        detach_renderer $src $w
489        unset win_src($w)
490        # there must be an easier way to do this
491        set k [lsearch -exact $win_list($src) $w]
492        if { $k < 0 } {
493                puts "vic: detach_window: XXX"
494                exit 1
495        }
496        set win_list($src) [lreplace $win_list($src) $k $k]
497}
498
499proc window_highlight { w color } {
500        if { $w != "" } {
501                $w configure -background $color
502                foreach child [winfo children $w] {
503                        window_highlight $child $color
504                }
505        }
506}
507
508proc set_background { w color } {
509        $w configure -background $color
510}
511
512proc build.src { w src color } {
513        set f [smallfont]
514        set stamp $w.stamp
515        frame $stamp -relief ridge -borderwidth 2
516        bind $stamp <Enter> "%W configure -background gray90"
517        if {[string equal [tk windowingsystem] "aqua"]} {
518                bind $stamp <Enter> "%W configure -background CornflowerBlue"
519        } else {
520                bind $stamp <Enter> "%W configure -background gray90"
521        }   
522        bind $stamp <Leave> "%W configure -background [resource background]"
523        create_video_widget $stamp.video 80 60
524        global win_is_slow
525        set win_is_slow($stamp.video) 1
526
527        # disable xvideo fro stamp video
528        attach_window $src $stamp.video false
529       
530        if {[string equal [tk windowingsystem] "aqua"]} {
531                pack $stamp.video -side left -padx 2 -pady 2
532                pack $stamp -side left -anchor nw -padx {4 2} -pady 2
533                frame $w.r -padx 2
534        } else {
535                pack $stamp.video -side left -anchor c -padx 2
536                pack $stamp -side left -fill y
537                frame $w.r
538        }
539               
540        frame $w.r.cw -relief groove -borderwidth 2
541
542        pack $w.r.cw -side left -expand 1 -fill both -anchor w -padx 0
543
544
545        if {[string equal [tk windowingsystem] "aqua"]} {
546                label $w.r.cw.name -textvariable src_nickname($src) -font $f \
547                        -padx 2 -pady 1 -borderwidth 0 -anchor w
548                label $w.r.cw.addr -textvariable src_info($src) -font $f \
549                        -padx 2 -pady 1 -borderwidth 0 -anchor w
550        } else {
551                label $w.r.cw.name -textvariable src_nickname($src) -font $f \
552                        -pady 1 -borderwidth 0 -anchor w
553                label $w.r.cw.addr -textvariable src_info($src) -font $f \
554                        -pady 1 -borderwidth 0 -anchor w
555        }         
556
557
558        global ftext btext ltext
559        set ftext($src) "0.0 f/s"
560        set btext($src) "0.0 kb/s"
561        set ltext($src) "(0%)"
562        frame $w.r.cw.rateinfo
563        label $w.r.cw.rateinfo.fps -textvariable ftext($src) -width 6 \
564                -font $f -pady 0 -borderwidth 0
565        label $w.r.cw.rateinfo.bps -textvariable btext($src) -width 8 \
566                -font $f -pady 0 -borderwidth 0
567        label $w.r.cw.rateinfo.loss -textvariable ltext($src) -width 6 \
568                -font $f -pady 0 -borderwidth 0
569
570        frame $w.r.ctrl -borderwidth 0
571
572        global mutebutton V
573        set mutebutton($src) $V(muteNewSources)
574        $src mute $mutebutton($src)
575
576        if {[string equal [tk windowingsystem] "aqua"]} {
577                checkbutton $w.r.ctrl.mute -text mute -borderwidth 2 \
578                        -font $f -width 4 \
579                        -command "$src mute \$mutebutton($src)" \
580                        -variable mutebutton($src)
581
582                checkbutton $w.r.ctrl.color -text color -borderwidth 2 \
583                        -font $f -width 4 \
584                        -command "\[$src handler\] color \$colorbutton($src)" \
585                        -variable colorbutton($src)
586        } else {
587                checkbutton $w.r.ctrl.mute -text mute -borderwidth 2 \
588                        -highlightthickness 1 \
589                        -relief groove -font $f -width 4 \
590                        -command "$src mute \$mutebutton($src)" \
591                        -variable mutebutton($src)
592
593                checkbutton $w.r.ctrl.color -text color -borderwidth 2 \
594                        -highlightthickness 1 \
595                        -relief groove -font $f -width 4 \
596                        -command "\[$src handler\] color \$colorbutton($src)" \
597                        -variable colorbutton($src)
598        }
599             
600        set m $w.r.ctrl.info.menu$src
601        if {[string equal [tk windowingsystem] "aqua"]} {
602                menubutton $w.r.ctrl.info -text info -borderwidth 2 \
603                        -font $f -pady 4 -menu $m
604        } else {
605                menubutton $w.r.ctrl.info -text info... -borderwidth 2 \
606                        -highlightthickness 1 \
607                        -relief groove -font $f -width 5 \
608                        -menu $m
609        }     
610        build_info_menu $src $m
611
612        if {[string equal [tk windowingsystem] "aqua"]} {
613                pack $w.r.ctrl.mute -side left -expand 1
614                pack $w.r.ctrl.color -side left -expand 1
615                pack $w.r.ctrl.info -side left -fill x -expand 1
616        } else {
617                pack $w.r.ctrl.mute -side left -fill x -expand 1
618                pack $w.r.ctrl.color -side left -fill x -expand 1
619                pack $w.r.ctrl.info -side left -fill x -expand 1
620#               pack $w.r.ctrl.options -side left -fill x -expand 1
621        }
622
623        global colorbutton
624        set colorbutton($src) 1
625
626        pack $w.r.cw.rateinfo.fps $w.r.cw.rateinfo.bps $w.r.cw.rateinfo.loss \
627                -side left -anchor w
628        pack $w.r.cw.name $w.r.cw.addr $w.r.cw.rateinfo -anchor w -fill x
629
630        pack $w.r.cw -fill x -side top
631        pack $w.r.ctrl -fill x -side top
632        pack $w.r -side left -expand 1 -fill x
633       
634        bind $stamp.video <1> "select_thumbnail $w $src"
635        bind $stamp.video <Enter> { focus %W }
636        bind $stamp.video <d> "$src deactivate"
637
638        return $stamp.video
639}
640
641proc bump { } {
642        global V
643        incr V(curcol)
644        if { $V(curcol) == $V(ncol) } {
645                set V(curcol) 0
646                incr V(currow)
647        }
648}
649
650proc redecorate n {
651        global V
652        set V(curcol) 0
653        set V(currow) 0
654        set V(ncol) $n
655
656        if ![info exists V(grid)] {
657                return
658        }
659        set w $V(grid)
660        set list [session active]
661        foreach src $list {
662                grid $w.$src -row $V(currow) -column $V(curcol) -sticky we
663                grid columnconfigure $w $V(curcol) -weight 1
664                bump
665        }
666}
667
668proc create_decoder src {
669        global numLayers
670
671        set format [rtp_format $src]
672        set decoder [new decoder $format]
673        if { $decoder == "" } {
674                # don't support this format
675                set decoder [new decoder null]
676        }
677##LL
678        if { $format == "pvh" } {
679                $decoder maxChannel $numLayers
680        }
681        $src handler $decoder
682        return $decoder
683}
684
685proc set_busy src {}
686
687#
688# Add a src to the active senders list.  E.g., make a postage
689# stamp window appear, stats, etc. so that the user can select
690# the video stream.
691#
692proc activate src {
693        global V
694
695        if [yesno relateInterface] {
696                set V(decoder) [create_decoder $src]
697                after idle "really_activate_relate $src"
698        } else {
699                set V(decoder) [create_decoder $src]
700        #
701        # give decoder a chance see a packet so it can
702        # determine the output geometry and color decimation.
703        # we shouldn't have to do this (e.g., resize will
704        # take care of a geomtry change), but currently
705        # decoders can't trigger a renderer realloation
706        # when the decimation changes.XXX fix this
707        #
708                after idle "really_activate $src"
709        }
710}
711
712proc really_activate src {
713
714        add_active $src
715
716        global V
717        set w $V(grid).$src
718        frame $w -relief groove -borderwidth 0 \
719                -visual $V(visual)
720        #XXX color
721        build.src $w $src 1
722        grid $w -row $V(currow) -column $V(curcol) -sticky we
723        grid columnconfigure $V(grid) $V(curcol) -weight 1
724
725        update_decoder $src
726        after 1000 "update_src $src"
727
728        bump
729}
730
731proc update_decoder src {
732        set_rate_vars $src
733        update_source_info $src
734
735        # check for Decoder control window
736        set w .decoder_control$src
737        if [winfo exists $w] {
738#               destroy $w     
739
740                #update
741                set fmt [rtp_format $src]
742                if [winfo exists $w.tb] {
743
744                        if { $fmt != "pvh" } {
745                                pack forget $w.tb
746                        } else {
747                                pack $w.tb -before $w.dismiss  -fill x
748                        }
749                } else {
750                        if { $fmt == "pvh" } {
751
752                                global numDecoderLayers numLayers decoderLayerValue
753
754                                frame $w.tb
755                                set f [smallfont]
756
757                                if ![info exists numDecoderLayers($src)] {
758                                        set numDecoderLayers($src) $numLayers
759                                }
760
761                                label $w.tb.value -text 0 -font $f -width 3
762                                scale $w.tb.scale -font $f -orient horizontal \
763                                        -showvalue 0 -from 0 -to $numLayers \
764                                        -variable numDecoderLayers($src) \
765                                        -width 12 -relief groove \
766                                        -command "set_numDecoderLayers $src"
767
768
769                                set decoderLayerValue($src) $w.tb.value
770
771                                $decoderLayerValue($src) configure -text $numDecoderLayers($src)
772
773                                pack $w.tb.scale -side left -fill x -expand 1
774                                pack $w.tb.value -side left
775                                pack $w.tb -before $w.dismiss  -fill x
776                                #create_decoder_control_window $src
777                        }
778                }
779        }
780
781}
782
783proc change_format src {
784        global win_list
785
786        if ![info exists win_list($src)] {
787                #
788                # if we get a change format before really_activate
789                # was called (i.e., so we don't even have a thumbnail yet),
790                # don't do anything
791                #
792                return
793        }   
794        set L $win_list($src)
795        detach_renderers $src
796        set extoutList [extout_detach_src $src]
797        set d [$src handler]
798        delete $d
799        set d [create_decoder $src]
800        update_decoder $src
801        global colorbutton
802        $d color $colorbutton($src)
803
804        foreach w $L {
805                attach_renderer $src $w
806                $w redraw
807        }
808        extout_attach_src $src $extoutList
809}
810
811#
812# Called when the video stream state changes in a way that would
813# affect the choice of renderer.  For example, when a jpeg stream
814# changes from type-0 to type-1 we might have to revert from
815# hardware to software decoding, or we might have to reallocate
816# a 422 renderer as a 411 renderer.  This never needs to happen
817# for most stream types (i.e., because the decimation factor is fixed).
818#
819proc decoder_changed d {
820        foreach src [session active] {
821                if { [$src handler] == "$d" } {
822                        global active
823                        if ![info exists active($src)] {
824                                return
825                        }
826                        #XXX redundant with change_format
827                        global win_list
828                        set L $win_list($src)
829                        detach_renderers $src
830                        set extoutList [extout_detach_src $src]
831                        foreach w $L {
832                                attach_renderer $src $w
833                                $w redraw
834                        }
835                        extout_attach_src $src $extoutList
836
837                        return
838                }
839        }
840}
841
842#XXX
843proc detach_renderers src {
844        global win_list
845        foreach w $win_list($src) {
846                detach_renderer $src $w
847        }
848}
849
850proc change_name src {
851        global win_list nametag srclist
852        set name [$src sdes name]
853        # update viewing window names to reflect new name
854        if [info exists win_list($src)] {
855                foreach w $win_list($src) {
856                        if [viewing_window $w] {
857                                windowname [winfo toplevel $w] $name
858                        }
859                }
860        }
861        # change name in source list if it exists
862        if [info exists srclist] {
863                $srclist itemconfigure $nametag($src) -text $name
864        }
865}
866
867#
868# Remove a src from the active senders list.
869#
870proc deactivate src {
871        global ftext btext ltext fpshat bpshat lhat shat win_list V
872
873        #catch this if using relate interface
874        if [yesno relateInterface] {deactivate_relate $src} else {
875        if [info exists win_list($src)] {
876                foreach w $win_list($src) {
877                        if [viewing_window $w] {
878                                #XXX should check if we're voice-switched
879                                # and if so, bump window
880                                destroy_userwin $w
881                        } else {
882                                # thumbnail - just detach
883                                detach_window $src $w
884                        }
885                }
886        }
887
888        set w $V(grid).$src
889        if [winfo exists $w] {
890                grid forget $w
891                destroy $w
892                rm_active $src
893        }
894        destroy_decoder_stats $src
895
896        delete [$src handler]
897
898        unset ftext($src)
899        unset btext($src)
900        unset ltext($src)
901        unset fpshat($src)
902        unset bpshat($src)
903        unset lhat($src)
904        unset shat($src)
905        }
906}
907
908proc update_rate src {
909        global ftext btext ltext fpshat bpshat lhat shat V
910
911        set key $src
912        if { "$src" != "$V(session)" } {
913                # only compute loss statistic for network side
914                set p [$src np]
915                set s [$src ns]
916                set shat($key) $s
917                set lhat($key) [expr $s-$p]
918                if {$shat($key) <= 0.} {
919                        set loss 0
920                } else {
921                        set loss [expr 100*$lhat($key)/$shat($key)]
922                }
923                if {$loss < .1} {
924                        set ltext($key) (0%)
925                } elseif {$loss < 9.9} {
926                        set ltext($key) [format "(%.1f%%)" $loss]
927                } else {
928                        set ltext($key) [format "(%.0f%%)" $loss]
929                }
930        }
931        set bpshat($key) [$src nb]
932        set fpshat($key) [$src nf]
933
934        set fps $fpshat($key)
935        set bps $bpshat($key)
936       
937        # csp
938        catch {
939        if {[resource logFrameRate] == "true"} {
940                global logFrameChannel
941                puts $logFrameChannel "[$src sdes cname] [clock seconds] $fps $bps $loss"
942        }
943        }
944
945        if { $fps < .1 } {
946                set fps "0 f/s"
947        } elseif { $fps < 10 } {
948                set fps [format "%.1f f/s" $fps]
949        } else {
950                set fps [format "%2.0f f/s" $fps]
951        }
952        if { $bps < 1 } {
953                set bps "0 bps"
954        } elseif { $bps < 1000 } {
955                set bps [format "%3.0f bps" $bps]
956        } elseif { $bps < 1000000 } {
957                set bps [format "%3.0f kb/s" [expr $bps / 1000]]
958        } else {
959                set bps [format "%.1f Mb/s" [expr $bps / 1000000]]
960        }
961        set ftext($key) $fps
962        set btext($key) $bps
963}
964
965proc update_src src {
966        global ftext updated
967        if ![info exists ftext($src)] {
968                return
969        }
970        if {$updated==1} {return}
971        update_rate $src
972        #XXX
973        update_source_info $src
974        after 1000 "catch {update_src $src}"
975}
976
977proc build.help { } {
978        create_help_window .help {
979"Transmit video by clicking on the ``Transmit'' button \
980in the ``Menu'' window.  You need video capture hardware to do this."
981
982"Incoming video streams appear in the main vic window.  \
983If you see the message ``Waiting for video...'', then no one is transmitting \
984video to the conference address you're running on.  Otherwise, you'll \
985see a thumbnail sized image and accompanying information for each source. \
986Click on the thumbnail to open a larger viewing window.  You can tile the \
987thumbnails in multiple columns using the ``Tile'' menu in the ``Menu'' window."
988"Clicking on the ``mute'' button for a given source will \
989turn off decoding.  It is usually a good idea to do \
990this for your own, looped-back transmission."
991
992"The transmission rate is controlled with the bit-rate \
993and frame-rate sliders in the ``Transmission'' panel of the ``Menu'' window.  \
994The more restrictive setting limits the transmission rate."
995
996"The video windows need not be fixed to a given source. \
997The ``Mode...'' menu attached to a viewing window allows you to specify \
998voice-switched and/or timer-switched modes.   In timer-switched mode, the \
999window automatically cycles through (unmuted) sources, while in \
1000oice-switched mode, the window switches to whomever is talking \
1001(using cues from vat).  You can have more than one voice-switched window, \
1002which results in a simple LRU allocation of the windows to most recent \
1003speakers.  See the man page for more details."
1004
1005"If the user interface looks peculiar, you might \
1006have X resources that conflict with tk.  A common problem is \
1007defining ``*background'' and/or ``*foreground''."
1008
1009"Bugs and suggestions to vic@ee.lbl.gov.  Thanks."
1010        }
1011}
1012
1013#
1014# what we want printed in the info window for our format etc.
1015# (i.e., info window code is app independent but this info isn't,
1016#  so we have this hackish callback)
1017#
1018proc info_text src {
1019        set d [$src handler]
1020        set fmt [rtp_format $src]
1021        if { "$d" != "" } {
1022                    set fmt "$fmt [$d info] ([$d width]x[$d height])"
1023        }
1024        return "$fmt"
1025}
Note: See TracBrowser for help on using the browser.