1 # ui-windows.tcl --
2 #
3 # UserWindows are toplevel windows containing a VideoWidget and a few
4 # menus (for resizing and selecting various switching modes).
5 #
6 # Copyright (c) 1993-2002 The Regents of the University of California.
7 # All rights reserved.
8 #
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions are met:
11 #
12 # A. Redistributions of source code must retain the above copyright notice,
13 # this list of conditions and the following disclaimer.
14 # B. Redistributions in binary form must reproduce the above copyright notice,
15 # this list of conditions and the following disclaimer in the documentation
16 # and/or other materials provided with the distribution.
17 # C. Neither the names of the copyright holders nor the names of its
18 # contributors may be used to endorse or promote products derived from this
19 # software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
22 # AND 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 FOR
25 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 #
32 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/vic/ui-windows.tcl,v 1.77 2003/11/19 20:02:10 aswan Exp $
33
34
35 import Switcher CuesReceiver RemoteCamera Configuration TkWindow
36
37 #
38 # UserWindows are toplevel windows containing a VideoWidget and a few menus
39 # (for resizing and selecting various switching modes).
40 # The source being decoded by the UserWindow's VideoWidget is set by doing an "ActiveSource attach-window UserWindow";
41 # therefore switching sources just involves re-attaching to a new ActiveSource.
42 #
43 Class UserWindow -superclass Switcher -configuration {
44 suppressUserName true
45 }
46
47 UserWindow instproc resize-actual { {scale 1} } {
48 $self instvar as_
49
50 set src [$as_ set src_]
51 set decoder [$src handler]
52
53 set w [expr int($scale * [$decoder width])]
54 set h [expr int($scale * [$decoder height])]
55 $self resize $w $h
56 }
57
58 UserWindow instproc resize-zoom {scale} {
59 $self instvar path_ vw_ as_
60 global size$path_
61
62 set w [expr int([[$vw_ window] width] * $scale)]
63 set h [expr int([[$vw_ window] height] * $scale)]
64
65 if {($w < 8) || ($h < 8)} {
66 return
67 }
68
69 set src [$as_ set src_]
70 set decoder [$src handler]
71 set actualWidth [$decoder width]
72 set actualHeight [$decoder height]
73
74 # Make sure the correct menu entry is selected.
75
76 if {($w == $actualWidth) && ($h == $actualHeight)} {
77 set size$path_ actual
78 } elseif {($w == $actualWidth / 2) && ($h == $actualHeight / 2)} {
79 set size$path_ half
80 } elseif {($w == $actualWidth * 2) && ($h == $actualHeight * 2)} {
81 set size$path_ double
82 } else {
83 set size$path_ ${w}x${h}
84 }
85
86 $self resize $w $h
87 }
88
89 #
90 # Resize the VideoWindow being displayed in the UserWindow's VideoWidget.
91 #
92 UserWindow instproc resize { w h } {
93 $self instvar vw_ as_
94
95 $as_ detach-window $self
96 [$vw_ window] resize $w $h
97 #
98 # Force an update so the window gets mapped at
99 # the new size before we re-bind the window
100 # to the source.
101 #
102 update idletasks
103
104 $as_ attach-window $self
105 }
106
107 #
108 # True if w is a top-level viewing window
109 #
110 proc viewing_window w {
111 if { [string range $w 0 2] == ".vw"} {
112 return 1
113 } else {
114 return 0
115 }
116 }
117
118 #
119 # Initialize some of the state variables and invoke the <i>create-window</i> method. <br>
120 # <dd> <i>asm</i>: the ActiveSourceManager that this UserWindow spouted from
121 # <dd> <i>as</i>: the ActiveSource to be displayed in the UserWindow
122 # <dd> <i>usecues</i>: boolean value to indicate whether or not to use cues
123 # <dd> <i>cb</i>: a coordination-bus
124 #
125 UserWindow instproc init { asm as usecues cb {w {}} {showMenus 0}} {
126 $self next $as
127 $self instvar asm_ usecues_
128 $self tkvar switched_ timed_ slow_ hw_ drop_even_
129 set asm_ $asm
130 set usecues_ $usecues
131 set switched_ 0
132 set timed_ 0
133 set slow_ 0
134 set hw_ 0
135 set drop_even_ 1
136 set blocky_ 0
137 if { $cb != "" && $cb != "" } {
138 $self create-window $w $as 1 $showMenus
139 } else {
140 $self create-window $w $as 0 $showMenus
141 }
142
143 # Register myself with the ActiveSourceManager's autoplace function.
144 $asm_ instvar autoplace_
145 if {[info exists autoplace_]} {
146 $asm_ autoplace register $as $self
147 }
148 }
149
150 #
151 # Destroy a viewing window but remember where it was
152 # and what size it was (and since this is the otcl destroy
153 # method, we also destroy the UserWindow data structure).
154 #
155 UserWindow instproc destroy {} {
156 $self instvar asm_ as_ path_ vw_
157 #FIXME
158 set w $path_.frame.video
159
160 $as_ detach-window $self
161
162 if {[winfo exists $w]} {
163 set x [winfo rootx $w]
164 set y [winfo rooty $w]
165 # adjust for virtual desktops
166 incr x [winfo vrootx $w]
167 incr y [winfo vrooty $w]
168 set top [winfo toplevel $w]
169 global userwin_x userwin_y userwin_size size$top
170 set userwin_x($as_) $x
171 set userwin_y($as_) $y
172 set userwin_size($as_) [set size$top]
173 destroy $top
174 }
175
176 $vw_ destroy
177
178 # Remove my ActiveSource from the ActiveSourceManager's autoplace
179 # function.
180 $asm_ instvar autoplace_
181 if {[info exists autoplace_]} {
182 $asm_ autoplace remove $as_
183 }
184
185 $self instvar cr_
186 if [info exists cr_] {
187 delete $cr_
188 }
189 $self next
190 }
191
192 #
193 # True if this UserWindow is employing a switching-mode to cycle through a set of sources.
194 #
195 UserWindow instproc is-switched {} {
196 $self tkvar switched_
197 return $switched_
198 }
199
200 #
201 # Delete and create a new renderer on window, <i>w</i> without
202 # changing anything else.
203 #
204 UserWindow instproc reallocate_renderer w {
205 # global win_src
206 # set src $win_src($w)
207 $self instvar as_
208 $as_ detach-window $self
209 $as_ attach-window $self
210 }
211
212 #
213 # VideoWidgets are embeddable frames of any size that can be used to display a video stream
214 # by attaching a decoder for the desired source.
215 #
216 Class VideoWidget -superclass TkWindow -configuration {
217 stampInterval 1000
218 }
219
220 #
221 # Create a VideoWidget, <i>w</i>, (as implemented in vw.cc) and
222 # initialize all the global state associated with a window. Use
223 # <i>width</i> and <i>height</i> to specify the resolution of the
224 # VideoWindow.
225 #
226 VideoWidget instproc init { w width height } {
227 #FIXME
228 $self next $w
229 $self instvar window_ is_slow_
230 set window_ [new VideoWindow $w $width $height]
231 #
232 # Use the window "name" as the variable for its mode
233 #
234 set is_slow_ 0
235 }
236
237 #
238 # Return the VideoWindow embedded within this VideoWidget.
239 #
240 VideoWidget instproc window {} {
241 return [$self set window_]
242 }
243
244 #
245 # Returns true if the update interval is set to slow.
246 #
247 VideoWidget instproc is-slow {} {
248 return [$self set is_slow_]
249 }
250
251 #
252 # Redraw the VideoWindow embedded within this VideoWidget.
253 #
254 VideoWidget instproc redraw {} {
255 [$self set window_] redraw
256 }
257
258 #
259 # Create colormodel methods that create the appropriate
260 # renderer for each supported visual/dither type.
261 #
262 foreach type { TrueColor/24 TrueColor/16 PseudoColor/8/Dither
263 PseudoColor/8/ED PseudoColor/8/Gray PseudoColor/8/Quant } {
264 set body "return \[new Renderer/$type \$self \$win \$dec \$heuristics]"
265 Colormodel/$type instproc alloc-renderer { win dec {heuristics 0} } $body
266 Renderer/$type set nb 0
267 }
268
269 #
270 # Create a renderer for this widget appropriate for the decoder of this
271 # <i>src</i> and set up the pipeline.
272 #
273 VideoWidget instproc attach-decoder { src colorModel useHW {useHeuristics 0} } {
274 set d [$src handler]
275 if {$d==""} {
276 global src_nickname
277 if ![info exists src_nickname($src)] {
278 set name [$src sdes cname]
279 } else {
280 set name $src_nickname($src)
281 }
282 puts stderr "can't attach-decoder: no handler for src $name;\
283 format is [$src format_name]"
284 return
285 }
286 $self instvar window_ target_ is_slow_
287 set target_ ""
288 if { $useHW } {
289 set fmt [$src format_name]
290 if { $fmt == "jpeg" } {
291 set fmt $fmt/[$d csss]
292 }
293 if ![catch "new assistor/$fmt" v] {
294 set target_ $v
295 $target_ window $window_
296 }
297 }
298 if { $target_ == "" } {
299 set target_ [$colorModel alloc-renderer $window_ [$d csss] $useHeuristics]
300 }
301 if $is_slow_ {
302 $target_ update-interval [$self get_option stampInterval]
303 }
304 $d attach $target_
305 }
306
307
308 #
309 # Return the target renderer object of this widget.
310 # Return "" if it does not exist (if attach-decoder hasn't been called yet.)
311 #
312 VideoWidget instproc get_renderer { } {
313 $self instvar target_
314 if {[info exists target_]} {
315 return $target_
316 } else {
317 return ""
318 }
319 }
320
321
322 #
323 # Turn on/off the use of image codec heuristics for the renderer
324 # associated with this VideoWidget.
325 #
326 VideoWidget instproc set_heuristics { v } {
327 $self instvar target_
328 $target_ heuristics $v
329 }
330
331 #
332 # Set the update interval for the video to be slow.
333 #
334 VideoWidget instproc set_slow {} {
335 $self instvar is_slow_ target_
336 set is_slow_ 1
337
338 if { [info exists target_] } {
339 $target_ update-interval [$self get_option stampInterval]
340 }
341 }
342
343 #
344 # Set the update interval for the video to be normal.
345 #
346 VideoWidget instproc set_normal {} {
347 $self instvar is_slow_ target_
348 set is_slow_ 0
349
350 if { [info exists target_] } {
351 $target_ update-interval 0
352 }
353 }
354
355 #
356 # Delete the VideoWidget.
357 #
358 VideoWidget instproc destroy {} {
359 $self instvar target_ window_
360 if [info exists target_] {
361 delete $target_
362 }
363 if [info exists window_] {
364 delete $window_
365 }
366 $self next
367 }
368
369 #
370 # Discontinue the representation of the source, <i>src</i>, within this VideoWidget.
371 #
372 VideoWidget instproc detach-decoder src {
373 $self instvar target_
374 set d [$src handler]
375 if {[info exists target_]} {
376 $d detach $target_
377 delete $target_
378 unset target_
379 }
380 }
381
382 #FIXME this should be derived from TopLevelWindow
383
384 #
385 # Given a widget path, <i>w</i>, embed a new window for viewing video.
386 # (If <i>w</i> does not yet exist, it is created as a toplevel window.)
387 #
388 UserWindow instproc create-window { w as useCB {showMenus 1}} {
389 set f [$self get_option smallfont]
390 set uid [uniqueID]
391 $self instvar asm_ usecues_ path_
392 if { $w=={} } {
393 set w .vw$uid
394 Application toplevel $w
395 } else {
396 frame $w
397 }
398
399 catch "wm resizable $w false false"
400 frame $w.frame
401 $self instvar vw_ as_ path_ controlMenu_
402 set as_ $as
403 set path_ $w
404
405 global size$w userwin_x userwin_y userwin_size
406
407 set size actual
408 if [info exists userwin_x($as)] {
409 if { [winfo toplevel $w]==$w } {
410 wm geometry $w +$userwin_x($as)+$userwin_y($as)
411 wm positionfrom $w user
412 }
413
414 set size $userwin_size($as)
415 }
416
417 set src [$as set src_]
418 set decoder [$src handler]
419 set width [$decoder width]
420 set height [$decoder height]
421
422 switch -regexp -- $size {
423 "half" {
424 set width [expr $width/2]
425 set height [expr $height/2]
426 }
427 "double" {
428 set width [expr $width*2]
429 set height [expr $height*2]
430 }
431 "actual" { }
432 "[0-9]+x[0-9]+" {
433 set L [split $size x]
434 set width [lindex $L 0]
435 set height [lindex $L 1]
436 }
437 default {
438 #puts "Ack! unknown size $size"
439 set size "actual"
440 }
441 }
442
443 set vw_ [new VideoWidget $w.frame.video $width $height]
444 set size$w $size
445
446 frame $w.bar
447 button $w.bar.dismiss -text Dismiss -font $f -width 8 \
448 -highlightthickness 0 -command "$self destroy"
449
450 set m $w.bar.mode.menu
451 menubutton $w.bar.mode -text Modes... -menu $m -relief raised \
452 -width 8 -font $f
453 menu $m
454
455 $m add checkbutton -label {Enable Smoothing} \
456 -command "$self set_heuristics" \
457 -font $f -variable [$self tkvarname enable_heuristics_]
458 $m add checkbutton -label {Save CPU} \
459 -command "$self set_slow" \
460 -font $f -variable [$self tkvarname slow_]
461 $m add checkbutton -label {Use Hardware} \
462 -command "$self reallocate_renderer $w.frame.video" \
463 -font $f -variable [$self tkvarname hw_]
464 $m add checkbutton -label "Drop Even Fields" \
465 -command "$self set_drop_even" \
466 -font $f -variable [$self tkvarname drop_even_]
467
468 $m add separator
469
470 $m add checkbutton -label {Voice switched} \
471 -command "$self set_switched" \
472 -font $f -variable [$self tkvarname switched_]
473 $m add checkbutton -label {Timer switched} \
474 -command "$self set_timed" \
475 -font $f -variable [$self tkvarname timed_]
476
477 #
478 # A menu for selecting participants to be switchable for
479 # voice- and timer-switched windows. Initially, all the
480 # participants are selected.
481 #
482
483 $m add cascade -label "Switch options..." -menu $m.opt \
484 -font $f
485
486 menu $m.opt -tearoff no
487
488 $self instvar switch_list_
489 global ${self}_switchname
490 foreach s [$asm_ active-sources] {
491 set ${self}_switchname($s) 1
492 lappend switch_list_ $s
493 $m.opt add checkbutton -label \
494 [[$asm_ get_activesource $s] name] \
495 -command "$self set_switch_list $s" \
496 -font $f -variable ${self}_switchname($s)
497 }
498
499 if !$useCB {
500 $m entryconfigure {Voice switched} -state disabled
501 }
502
503 set m $w.bar.size.menu
504 menubutton $w.bar.size -text Size... -menu $m -relief raised -width 8 \
505 -font $f
506 menu $m
507
508 $m add radiobutton -label "Half Size" \
509 -command "$self resize-actual 0.5" \
510 -font $f -value half -variable size$w
511 $m add radiobutton -label "Actual Size" \
512 -command "$self resize-actual" \
513 -font $f -value actual -variable size$w -accelerator =
514 $m add radiobutton -label "Double Size" \
515 -command "$self resize-actual 2" \
516 -font $f -value double -variable size$w
517
518 set submenu $m.advanced
519 menu $submenu
520 $m add cascade -label "Other" -font $f -menu $submenu
521
522 $m add separator
523 $m add command -label "Reduce" \
524 -command "$self resize-zoom 0.5" -font $f -accelerator -
525 $m add command -label "Enlarge" \
526 -command "$self resize-zoom 2" -font $f -accelerator +
527
528 $submenu add radiobutton -label QCIF -command "$self resize 176 144" \
529 -font $f -value 176x144 -variable size$w
530 $submenu add radiobutton -label CIF -command "$self resize 352 288" \
531 -font $f -value 352x288 -variable size$w
532 $submenu add radiobutton -label 4CIF -command "$self resize 704 576" \
533 -font $f -value 704x576 -variable size$w
534
535 $submenu add separator
536 $submenu add radiobutton -label "1/16 NTSC" \
537 -command "$self resize 160 120" \
538 -font $f -value 160x120 -variable size$w
539 $submenu add radiobutton -label "1/4 NTSC" \
540 -command "$self resize 320 240" \
541 -font $f -value 320x240 -variable size$w
542 $submenu add radiobutton -label NTSC \
543 -command "$self resize 640 480" \
544 -font $f -value 640x480 -variable size$w
545
546 $submenu add separator
547 $submenu add radiobutton -label "1/16 NTSC 601" \
548 -command "$self resize 180 120" \
549 -font $f -value 180x120 -variable size$w
550 $submenu add radiobutton -label "1/4 NTSC 601" \
551 -command "$self resize 360 240" \
552 -font $f -value 360x240 -variable size$w
553 $submenu add radiobutton -label "NTSC 601" \
554 -command "$self resize 720 480" \
555 -font $f -value 720x480 -variable size$w
556
557 $submenu add separator
558 $submenu add radiobutton -label "1/16 PAL" \
559 -command "$self resize 192 144" \
560 -font $f -value 192x144 -variable size$w
561 $submenu add radiobutton -label "1/4 PAL" \
562 -command "$self resize 384 288" \
563 -font $f -value 384x288 -variable size$w
564 $submenu add radiobutton -label PAL \
565 -command "$self resize 768 576" \
566 -font $f -value 768x576 -variable size$w
567
568
569 label $w.bar.label -text "" -anchor w -relief raised
570 pack $w.bar.label -expand 1 -side left -fill both
571
572 # install camera movement controls
573 if [$self yesno camctrl] {
574 $self instvar camCtrlAgent_
575 set camCtrlAgent_ [new RemoteCamera $self $w]
576 if ![$camCtrlAgent_ isAllocated] {
577 destroy $camCtrlAgent_
578 unset camCtrlAgent_
579 } else {
580 button $w.bar.camctrls -text CamCtrls -font $f \
581 -width 8 -highlightthickness 0 \
582 -command "$camCtrlAgent_ toggleUI"
583 pack $w.bar.camctrls -side left
584 }
585 }
586
587 pack $w.bar.size $w.bar.mode $w.bar.dismiss -side left -fill y
588
589 pack $w.frame.video -anchor c
590 pack $w.frame -expand 1 -fill both
591
592 #
593 # Build cues menu if specified by the user
594 #
595 if $usecues_ {
596 frame $w.cues -relief ridge -borderwidth 2
597 label $w.cues.l -font $f -text "Cues:"
598 pack $w.cues.l -side left -padx 10
599
600 $self instvar cr_
601 set cr_ [new CuesReceiver $w.cues lg]
602 $cr_ enable [[$as_ set src_] sdes cname]
603
604 pack $w.cues -fill x
605 }
606
607 if {$showMenus} {
608 pack $w.bar -fill x
609 }
610
611 bind $w <Enter> { focus %W }
612 #wm focusmodel $w active
613
614 bind $w <d> "$self destroy"
615 bind $w <q> "$self destroy"
616 $w.bar.dismiss configure -command "$self destroy"
617 wm protocol $w WM_DELETE_WINDOW "$self destroy"
618
619 bind $w <Return> "$self forward"
620 bind $w <space> "$self forward"
621 bind $w <greater> "$self forward"
622 bind $w <less> "$self reverse"
623 bind $w <comma> "$self reverse"
624
625 bind $w <equal> "$m invoke 1"
626 bind $w <minus> "$m invoke 5"
627 bind $w <plus> "$m invoke 6"
628
629 #
630 # Finally, bind the source to the window.
631 #
632 $as attach-window $self
633 }
634
635 #
636 # Return the widget path.
637 #
638 UserWindow instproc path {} {
639 $self instvar path_
640 return $path_
641 }
642
643 #
644 # Add and/or remove participants in the switchable list
645 #
646 UserWindow instproc set_switch_list s {
647 $self instvar switch_list_
648 global ${self}_switchname
649 if [set ${self}_switchname($s)] {
650 lappend switch_list_ $s
651 } else {
652 set i [lsearch $switch_list_ $s]
653 set switch_list_ [lreplace $switch_list_ $i $i]
654 }
655 }
656
657 #
658 # Rebuild the switchable list menu.
659 # This menu gets updated whenever the name of a participant
660 # changes, or someone gets activated or deactivated.
661 #
662 UserWindow instproc rebuild_switch_list_menu { } {
663 $self instvar path_ asm_ switch_list_
664 set m $path_.bar.mode.menu
665
666 #
667 # destroy the old menu first
668 destroy $m.opt
669
670 #
671 # rebuild options menu
672 # button down a name only if it was clicked before
673 # remove a name if it is no longer there
674 #
675 menu $m.opt -tearoff no
676
677 set new_all_list [$asm_ active-sources]
678
679 global ${self}_switchname
680
681 set new_switch_list {}
682 foreach s $new_all_list {
683 if { [lsearch $switch_list_ $s] != -1 } {
684 set ${self}_switchname($s) 1
685 lappend new_switch_list $s
686 } else {
687 set ${self}_switchname($s) 0
688 }
689 $m.opt add checkbutton -label \
690 [[$asm_ get_activesource $s] name] \
691 -command "$self set_switch_list $s" \
692 -font [$self get_option smallfont] \
693 -variable ${self}_switchname($s)
694 }
695 set switch_list_ $new_switch_list
696 }
697
698
699 #
700 # Return the VideoWidget being displayed in this UserWindow.
701 #
702 UserWindow instproc video-widget {} {
703 return [$self set vw_]
704 }
705
706 #
707 # Return the ActiveSource attached to this UserWindow.
708 #
709 UserWindow instproc attached-source {} {
710 return [$self set as_]
711 }
712
713 #
714 # Update the title of the UserWindow (a toplevel window) and its iconname to include <i>name</i>.
715 #
716 UserWindow instproc set-name name {
717 $self instvar path_
718 set w $path_
719 if ![$self yesno suppressUserName] {
720 $w.bar.label configure -text $name
721 }
722 #FIXME this should be in base class
723 #puts "todo: move to base class [winfo toplevel $w], $w"
724
725 if { [winfo toplevel $w]==$w } {
726 wm iconname $w vic:$name
727 wm title $w $name
728 }
729 }
730
731 #
732 # Switch the VideoWindow to display the source, <i>src</i>, in this UserWindow.
733 #
734 UserWindow instproc switch src {
735 $self instvar as_ asm_ usecues_
736
737 #FIXME map src to active source using UI's data structure
738 set as [$asm_ get_activesource $src]
739 if { $as_ != $as } {
740
741 #
742 # There is a new source in this window, so
743 # show this person's cues instead
744 #
745 if $usecues_ {
746 $self instvar cr_
747 $cr_ enable [$src sdes cname]
748 }
749
750 $as_ detach-window $self
751 set as_ $as
752 $as_ attach-window $self
753 }
754 }
755
756 #
757 # Returns the source following <i>src</i> in the switchable list.
758 #
759 UserWindow instproc next_active_src src {
760 # FIXME should change these guys to cycle through according
761 # to the order in the thumbnail display
762 $self instvar switch_list_ last_src_
763
764 #
765 # If voice- and timer- switched are both enabled
766 # then the next participant to switched should be
767 # based upon the last timer-switched person instead
768 # of the voice-switched one. This way, we won't starve
769 # a quite person for being switched
770 #
771
772 if { [$self enabled] && [info exists last_src_] } {
773 set src $last_src_
774 }
775 set i [lsearch $switch_list_ $src]
776 # (if we didn't find the list element, k will be -1 and incr'd to 0)
777 incr i
778 if { $i >= [llength $switch_list_] } {
779 set i 0
780 }
781 set next_src [lindex $switch_list_ $i]
782 set last_src_ $next_src
783 return $next_src
784 }
785
786 #
787 # Returns the source preceeding <i>src</i> in a list of ActiveSources.
788 #
789 UserWindow instproc prev_active_src src {
790 $self instvar asm_
791 set list [$asm_ active-sources]
792 set k [lsearch -exact $list $src]
793 if { $k < 0 } {
794 set k 0
795 } else {
796 if { $k == 0 } {
797 set k [llength $list]
798 }
799 incr k -1
800 }
801 return [lindex $list $k]
802 }
803
804 #
805 # Enable/disable switching for this UserWindow based on the <i>switched_</i> tkvar.
806 #
807 UserWindow instproc set_switched {} {
808 $self tkvar switched_
809 if $switched_ {
810 $self enable
811 } else {
812 $self disable
813 }
814 }
815
816 #
817 # Start/stop timer-switching this UserWindow based on the <i>timed_</i> tkvar.
818 #
819 UserWindow instproc set_timed {} {
820 $self tkvar timed_
821 if $timed_ {
822 $self set_timer
823 } else {
824 $self cancel_timer
825 }
826 }
827
828 #
829 # Set the speed of the VideoWidget updates based on the <i>slow_</i> tkvar.
830 #
831 UserWindow instproc set_slow {} {
832 $self tkvar slow_
833 $self instvar vw_
834 if $slow_ {
835 $vw_ set_slow
836 } else {
837 $vw_ set_normal
838 }
839 }
840
841 #
842 # Turn on/off use of image codec heuristics.
843 #
844 UserWindow instproc set_heuristics {} {
845 $self instvar vw_
846 $vw_ set_heuristics [$self use_heuristics]
847 }
848
849 UserWindow instproc set_drop_even {} {
850 $self tkvar drop_even_
851 $self instvar as_
852
853 set src [$as_ set src_]
854 set fmt [$src format_name]
855 if { $fmt == "jpeg" } {
856 set d [$src handler]
857 $d drop-even $drop_even_
858 }
859 }
860
861 #
862 # Returns whether or not image codec heuristics are enabled or
863 # disabled based on the <i>enable_heuristics_</i> tkvar.
864 #
865 UserWindow instproc use_heuristics {} {
866 $self tkvar enable_heuristics_
867 if $enable_heuristics_ {
868 return 1
869 } else {
870 return 0
871 }
872 }
873
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.