1 # source.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/collaborator/source.tcl,v 1.15 2002/02/03 04:21:46 lim Exp $
32
33
34 import WidgetClass MultiSourceIcons VideoWidget Rank DragNDrop CompoundButton
35
36 Class MultiSource
37 WidgetClass UIMultiSource -configspec {
38 { -value value Value {} config_option }
39 { -select select Select 0 config_option }
40 { -highlight highlight Highlight 0 config_option }
41
42 { -relief relief Relief flat config_option }
43 { -normalbackground normalBackground NormalBackground \
44 WidgetDefault(-background) config_option }
45 { -normalforeground normalForeground NormalForeground \
46 WidgetDefault(-foreground) config_option }
47 { -normalrelief normalRelief NormalRelief flat config_option }
48 { -selectbackground selectBackground SelectBackground WidgetDefault \
49 config_option }
50 { -selectforeground selectForeground SelectForeground WidgetDefault \
51 config_option }
52 { -selectrelief selectRelief SelectRelief sunken config_option }
53 { -highlightrelief highlightRelief HighlightRelief raised \
54 config_option }
55 } -default {
56 { *activeColor white }
57 { *defaultColor WidgetDefault(-background) }
58 { *disabledColor WidgetDefault(-disabledforeground) }
59 }
60
61
62
63 WidgetClass UISource -default {
64 { *defaultColor WidgetDefault(-background) }
65 { *disabledColor WidgetDefault(-disabledforeground) }
66 }
67
68
69
70 UIMultiSource public init { args } {
71 $self instvar config_
72 set config_(-value) {}
73 set config_(-select) 0
74 set config_(-highlight) 0
75 set config_(-normalbackground) Black
76 set config_(-normalforeground) Black
77 set config_(-normalrelief) flat
78 set config_(-selectbackground) Black
79 set config_(-selectforeground) Black
80 set config_(-selectrelief) sunken
81 set config_(-highlightrelief) raised
82
83 eval [list $self] next $args
84 }
85
86
87 UIMultiSource public config_option { option args } {
88 $self instvar config_
89 if { [llength $args]==0 } {
90 return $config_($option)
91 } else {
92 set value [lindex $args 0]
93 set config_($option) $value
94 if { $option == "-relief" } {
95 $self widget_proc configure $option $value
96 }
97 }
98 }
99
100
101
102 WidgetClass UISource/RTP -superclass UISource
103 WidgetClass UISource/Audio -superclass UISource/RTP
104 WidgetClass UISource/Video -superclass UISource/RTP
105 WidgetClass UISource/Mb -superclass UISource
106 WidgetClass UISource/Mbv2 -superclass UISource
107 WidgetClass UISource/Unknown -superclass UISource
108
109
110 UISource/Audio set image_ MultiSourceIcons(audio)
111 UISource/Video set image_ MultiSourceIcons(video)
112 UISource/Mb set image_ MultiSourceIcons(mb)
113 UISource/Mbv2 set image_ MultiSourceIcons(mb)
114 UISource/Unknown set image_ MultiSourceIcons(unknown)
115
116
117 UISource public init { widget observer src msrc args } {
118 $self set src_ $src
119 $self set msrc_ $msrc
120 $self set observer_ $observer
121 eval $self next $widget $args
122 }
123
124
125 UISource public destroy { } {
126 $self next
127 }
128
129
130 UISource public src {} { return [$self set src_] }
131
132
133 UISource public create_root_widget {path} {
134 [$self info class] instvar image_
135 button $path -image $image_ -bd 1 -relief raised -padx 1000 \
136 -highlightthickness 0 -takefocus 0
137 $path configure -activebackground [option get $path defaultColor \
138 UISource]
139 }
140
141
142 UISource public msrc {msrc} {
143 $self set msrc_ $msrc
144 }
145
146
147 UISource public save_state { state } {
148 }
149
150
151 UISource public restore_state { state } {
152 }
153
154
155 UISource public tip {} {
156 return {}
157 }
158
159
160 UISource/Audio public tip {} {
161 return Audio
162 }
163
164
165 UISource/Video public tip {} {
166 return Video
167 }
168
169
170 UISource/Mb public tip {} {
171 return Mediaboard
172 }
173
174
175 UISource/Video public name { } {
176 $self instvar msrc_
177 return [$msrc_ name]
178 }
179
180
181 UISource/Video public save_state { state_var } {
182 upvar $state_var state
183 set state(have_thumbnail) [$self have_thumbnail]
184 }
185
186
187 UISource/Video public restore_state { state_var } {
188 $self instvar msrc_ src_
189 upvar $state_var state
190 if $state(have_thumbnail) {
191 $msrc_ add_thumbnail video $src_
192 }
193 }
194
195
196 UISource/RTP public destroy {} {
197 $self instvar info_win_ rtp_win_ decoder_win_
198 if [info exists info_win_] {
199 delete $info_win_
200 }
201 if [info exists rtp_win_] {
202 delete $rtp_win_
203 }
204 if [info exists decoder_win_] {
205 delete $decoder_win_
206 }
207 $self next
208 }
209
210
211 UISource/Video public destroy {} {
212 $self instvar src_ thumbnail_ thumbnail_path_ info_path_ observer_ src_
213
214 $observer_ detach_windows $src_
215 if [info exists thumbnail_] {
216 $self destroy_thumbnail
217 }
218 if [info exists info_path_] {
219 $self destroy_info
220 }
221
222 $self instvar scuba_win_
223 if [info exists scuba_win_] {
224 $self delete-scuba-window
225 }
226
227 $self next
228 }
229
230
231 UISource/Video public build_widget {path} {
232 $self tkvar mute_ color_
233 $self instvar observer_ src_ userwindows_
234 $path configure -command "tk_popup $path.menu \[winfo pointerx $path\]\
235 \[winfo pointery $path\]"
236
237 set userwindows_ {}
238 set mute_ [$observer_ mute_new_sources]
239 $src_ mute $mute_
240 set color_ 1
241
242 menu $path.menu
243 $path.menu add checkbutton -label "Mute" \
244 -variable [$self tkvarname mute_] \
245 -command "$self mute \$\{[$self tkvarname mute_]\}"
246 $path.menu add checkbutton -label "Color" \
247 -variable [$self tkvarname color_] \
248 -command "$self color \$\{[$self tkvarname color_]\}"
249 $path.menu add cascade -label "Info..." -menu $path.menu.info
250 $self build_info_menu $path.menu.info
251 }
252
253
254 UISource/Video public have_thumbnail {} {
255 $self instvar thumbnail_
256 return [info exists thumbnail_]
257 }
258
259
260 UISource/Video public create_thumbnail {path} {
261 $self instvar src_ thumbnail_ thumbnail_path_
262 set thumbnail_path_ $path.thumbnail$src_
263 frame $thumbnail_path_ -bd 1 -relief raised
264 set thumbnail_ [new VideoWidget $thumbnail_path_.src 80 60]
265 $thumbnail_ set is_slow_ 1
266 pack $thumbnail_path_.src -fill both -expand 1
267 pack $thumbnail_path_ -in $path -side left
268
269 $self bind_thumbnail $thumbnail_path_.src
270 $self attach_thumbnail
271 }
272
273
274 UISource/Video public destroy_thumbnail {} {
275 $self instvar src_ thumbnail_ thumbnail_path_ dragdrop_
276 if [info exists thumbnail_] {
277 $self detach_thumbnail
278 delete $dragdrop_
279 delete $thumbnail_
280 destroy $thumbnail_path_
281 unset thumbnail_
282 unset thumbnail_path_
283 unset dragdrop_
284 }
285 }
286
287
288 UISource/Video private bind_thumbnail t {
289 $self instvar dragdrop_
290 bind $t <Double-ButtonPress-1> "$self select_thumbnail"
291 set dragdrop_ [new DragNDrop $t "$self dragNdrop_thumbnail"]
292 $dragdrop_ proc select_widget w "$self build_dragdrop \$self \$w"
293 $dragdrop_ proc release_widget w "$self delete_dragdrop \$self \$w"
294 }
295
296
297 UISource/Video private build_dragdrop { dragdrop w } {
298 $self instvar src_
299 set vw [new VideoWidget $w.video 80 60]
300 pack $w.video -fill both -expand 1
301
302 $vw attach-decoder $src_ [UISource/Video set colorModel_] \
303 [UISource/Video set use_hw_decode_]
304 $vw set is_slow_ 1
305 $dragdrop set vw_ $vw
306 }
307
308
309 UISource/Video private delete_dragdrop { dragdrop w } {
310 $dragdrop instvar vw_
311 $self instvar src_
312 $vw_ detach-decoder $src_
313 destroy $w.video
314 delete $vw_
315 unset vw_
316 }
317
318
319 #
320 # Called when user double-clicks on thumbnail video window.
321 # Create a new window only if the window already
322 # isn't being displayed (in locked mode). In this
323 # case, delete the existing window (i.e., clicking
324 # on the thumbnail gives a toggle action, but not
325 # for voice-switched or browse-mode windows).
326 #
327 UISource/Video public select_thumbnail {} {
328 foreach uw [$self user_windows] {
329 if { [$uw attached-source] == "$self" && ![$uw is-switched] &&\
330 [[$uw info class] info heritage VideoWidget] \
331 == {} } {
332 delete $uw
333 return
334 }
335 }
336
337 $self create_user_window
338 }
339
340
341 #
342 # Create a UserWindow for this ActiveSource.
343 #
344 UISource/Video private create_user_window { } {
345 $self instvar observer_
346 new UserWindow $observer_ $self [$self yesno useCues] \
347 [$observer_ can_voiceswitch] {} 1
348 }
349
350
351 #
352 # Returns true if the represented source is h261 format.
353 #
354 UISource/Video public isCIF {} {
355 $self instvar src_
356 return [expr [string compare [$src_ format_name] h261] == 0]
357 }
358
359
360 UISource/Video private dragNdrop_thumbnail { dragndrop x y } {
361 $self instvar observer_
362 if ![[$observer_ video_container] drop_thumbnail $dragndrop $self \
363 $x $y] {
364 $dragndrop zoom_back
365 }
366 }
367
368
369 UISource/Video proc.public decoder_params { colorModel use_hw_decode } {
370 $self set colorModel_ $colorModel
371 $self set use_hw_decode_ $use_hw_decode
372 }
373
374
375 #
376 UISource/Video public attach_thumbnail {} {
377 $self instvar src_ thumbnail_
378 $thumbnail_ attach-decoder $src_ [UISource/Video set colorModel_] \
379 [UISource/Video set use_hw_decode_]
380 }
381
382 #
383 UISource/Video public detach_thumbnail {} {
384 $self instvar src_ thumbnail_
385 $thumbnail_ detach-decoder $src_
386 }
387
388
389 UISource/Video public create_info {path} {
390 $self instvar src_ msrc_ timer_id_ info_path_
391 $self tkvar ftext_ btext_ ltext_ info_
392 set ftext_ "0.0 f/s"
393 set btext_ "0.0 kb/s"
394 set ltext_ "(0%)"
395 set info_ [$msrc_ cname]
396
397 set path $path.info$src_
398 set info_path_ $path
399 frame $path -bd 2 -relief groove
400 frame $path.frame
401 label $path.info -textvariable [$self tkvarname info_] \
402 -anchor w -pady 0
403 label $path.ftext -textvariable [$self tkvarname ftext_] \
404 -anchor w -pady 0
405 label $path.btext -textvariable [$self tkvarname btext_] \
406 -anchor w -pady 0
407 label $path.ltext -textvariable [$self tkvarname ltext_] \
408 -anchor w -pady 0
409 pack $path.ftext $path.btext $path.ltext -fill both -expand 1 \
410 -pady 0 -side left -in $path.frame
411 pack $path.info -side top -pady 0 -fill x -expand 1
412 pack $path.frame -side top -fill x -expand 1
413 pack $path -fill both -expand 1
414
415 set timer_id_ [after 1000 "$self update_info"]
416 }
417
418
419 UISource/Video public destroy_info { } {
420 $self instvar info_path_ timer_id_
421 if ![info exists info_path_] return
422
423 $self tkvar info_ ftext_ btext_ ltext_
424 if [info exists timer_id_] {
425 after cancel $timer_id_
426 unset timer_id_
427 }
428
429 destroy $info_path_
430 unset info_path_
431 unset info_ ftext_ btext_ ltext_
432 }
433
434
435 UISource/Video private update_info {} {
436 $self tkvar ftext_
437 $self instvar src_ msrc_ timer_id_
438 if ![info exists ftext_] {
439 return
440 }
441
442 $self update_rate
443 set timer_id_ [after 1000 "$self update_info"]
444 }
445
446
447 #
448 # Using the specified video source, <i>src_</i>, as an index, update the
449 # global arrays bpshat(), fpshat(), shat(), lhat(), ltext(), ftext(), btext().
450 #
451 UISource/Video private update_rate {} {
452 $self instvar src_
453 $self tkvar ftext_ btext_ ltext_
454 global fpshat bpshat lhat shat
455
456 set key $src_
457 if [string match Session/* [$src_ info class]] {
458 set bpshat($key) [expr 8 * [$src_ set nb_]]
459 set fpshat($key) [$src_ set nf_]
460 } else {
461 # only compute loss statistic for network side
462 set p [$src_ layer-stat np_]
463 set s [$src_ ns]
464 set shat($key) $s
465 set lhat($key) [expr $s-$p]
466 if {$shat($key) <= 0.} {
467 set loss 0
468 } else {
469 set loss [expr 100*$lhat($key)/$shat($key)]
470 }
471 if {$loss < .1} {
472 set ltext_ (0%)
473 } elseif {$loss < 9.9} {
474 set ltext_ [format "(%.1f%%)" $loss]
475 } else {
476 set ltext_ [format "(%.0f%%)" $loss]
477 }
478 set bpshat($key) [expr 8 * [$src_ layer-stat nb_]]
479 set fpshat($key) [$src_ layer-stat nf_]
480 }
481
482 set fps $fpshat($key)
483 set bps $bpshat($key)
484
485 if { $fps < .1 } {
486 set fps "0 f/s"
487 } elseif { $fps < 10 } {
488 set fps [format "%.1f f/s" $fps]
489 } else {
490 set fps [format "%2.0f f/s" $fps]
491 }
492 if { $bps < 1 } {
493 set bps "0 bps"
494 } elseif { $bps < 1000 } {
495 set bps [format "%3.0f bps" $bps]
496 } elseif { $bps < 1000000 } {
497 set bps [format "%3.0f kb/s" [expr $bps / 1000]]
498 } else {
499 set bps [format "%.1f Mb/s" [expr $bps / 1000000]]
500 }
501 set ftext_ $fps
502 set btext_ $bps
503
504 # FIXME: need this to update the video ctrlmenu
505 $self instvar observer_
506 $observer_ instvar agent_
507 if { $src_ == [$agent_ local] } {
508 global ftext btext
509 set key [$agent_ set session_]
510 set ftext($key) $fps
511 set btext($key) $bps
512 }
513 }
514
515
516 UISource/Video public change_info { info } {
517 $self tkvar info_
518 set info_ $info
519 }
520
521
522 UISource/Video public get_info {} {
523 $self tkvar info_
524 if [info exists info_] { return $info_ } else { return "" }
525 }
526
527
528
529 #
530 # Create a menu for accessing information and data associated with the represented source: <br>
531 # <dd> "Site Info"
532 # <dd> "RTP Stats"
533 # <dd> "Decoder Stats"
534 # <dd> "Mtrace from"
535 # <dd> "Mtrace to"
536 # <dd> and possibly "Scuba Info"
537 #
538 UISource/RTP private build_info_menu { m } {
539 $self instvar observer_
540 menu $m
541 set f [$self get_option smallfont]
542 $m add command -label "Site Info" \
543 -command "$self create-info-window" -font $f
544 $m add command -label "RTP Stats"\
545 -command "$self create-rtp-window" -font $f
546 $m add command -label "Decoder Stats" \
547 -command "$self create-decoder-window" -font $f
548 if [in_multicast [[$observer_ agent] session-addr]] {
549 $m add command -label "Mtrace from" \
550 -command "$self create-mtrace-window from" -font $f
551 $m add command -label "Mtrace to" \
552 -command "$self create-mtrace-window to" -font $f
553 }
554 }
555
556
557 UISource/Video private build_info_menu { m } {
558 $self instvar observer_
559 $self next $m
560 if { [$observer_ scuba_session] != {} } {
561 set f [$self get_option smallfont]
562 $m add command -label "Scuba Info" -font $f \
563 -command "$self create-scuba-window"
564 }
565 }
566
567
568 #
569 # If a window exists for displaying the Scuba Votes for this source,
570 # delete it. Else, create one.
571 #
572 UISource/Video private create-scuba-window {} {
573 UISource/Video instvar scubaInfoCnt_
574 if ![info exists scubaInfoCnt_] { set scubaInfoCnt_ 0 }
575 $self instvar scuba_win_ src_ observer_
576 if [info exists scuba_win_] {
577 $self delete-scuba-window
578 } else {
579 set scuba_sess [$observer_ scuba_session]
580 set scuba_win_ [new ScubaInfoWindow \
581 .scubainfo_for_uisrc_video$scubaInfoCnt_ \
582 $src_ $self $scuba_sess]
583 incr scubaInfoCnt_
584 [$scuba_sess source-manager] attach $scuba_win_
585 $scuba_win_ timeout
586 }
587 }
588
589 #
590 # Delete the Scuba Votes window for this source.
591 #
592 UISource/Video private delete-scuba-window {} {
593 $self instvar scuba_win_ observer_
594 set scuba_sess [$observer_ scuba_session]
595 [$scuba_sess source-manager] detach $scuba_win_
596 delete $scuba_win_
597 unset scuba_win_
598 }
599
600
601 #
602 # If an InfoWindow exists for this source, delete it. Else, create one.
603 #
604 UISource/RTP instproc create-info-window {} {
605 $self instvar src_ info_win_
606 if [info exists info_win_] {
607 $self delete-info-window
608 } else {
609 set info_win_ [new InfoWindow .info$src_ $src_ $self]
610 }
611 }
612
613 #
614 # Delete the InfoWindow for this source.
615 #
616 UISource/RTP instproc delete-info-window {} {
617 $self instvar info_win_
618 delete $info_win_
619 unset info_win_
620 }
621
622 #
623 # For the represented source, return a string
624 # describing its network statistics.
625 #
626 UISource/RTP instproc stats {} {
627 $self instvar src_
628 return "Kilobits [expr [$src_ layer-stat nb_] >> (10-3)] \
629 Frames [$src_ layer-stat nf_] \
630 Packets [$src_ layer-stat np_] \
631 Missing [$src_ missing] \
632 Misordered [$src_ layer-stat nm_] \
633 Runts [$src_ layer-stat nrunt_] \
634 Dups [$src_ layer-stat ndup_] \
635 Bad-S-Len [$src_ set badsesslen_] \
636 Bad-S-Ver [$src_ set badsessver_] \
637 Bad-S-Opt [$src_ set badsessopt_] \
638 Bad-Sdes [$src_ set badsdes_] \
639 Bad-Bye [$src_ set badbye_]"
640 }
641
642 #
643 # For the represented source, return the decoder statistics.
644 #
645 UISource/RTP instproc decoder-stats {} {
646 $self instvar src_
647 set d [$src_ handler]
648 #FIXME
649 return [$d stats]
650 }
651
652 #
653 # If a window exists for displaying the RTP Statistics of this source, delete it. Else, create one.
654 #
655 UISource/RTP instproc create-rtp-window {} {
656 $self instvar src_ rtp_win_
657 if [info exists rtp_win_] {
658 $self delete-rtp-window
659 } else {
660 set rtp_win_ [new RtpStatWindow .rtp$src_ $src_ \
661 "RTP Statistics" \
662 "$self stats" \
663 "$self delete-rtp-window"]
664 }
665 }
666
667 #
668 # Delete the RTP Statisctics window for this source.
669 #
670 UISource/RTP instproc delete-rtp-window {} {
671 $self instvar rtp_win_
672 delete $rtp_win_
673 unset rtp_win_
674 }
675
676 #
677 # If a window exists for displaying the Decoder Statistics of this source, delete it. Else, create one.
678 #
679 UISource/RTP instproc create-decoder-window {} {
680 $self instvar src_ decoder_win_
681 if [info exists decoder_win_] {
682 $self delete-decoder-window
683 } else {
684 if { "[$src_ handler]" == "" } {
685 new ErrorWindow "no decoder stats yet"
686 return
687 }
688 set decoder_win_ [new RtpStatWindow .decoder$src_ $src_ \
689 "Decoder Statistics" \
690 "$self decoder-stats" \
691 "$self delete-decoder-window"]
692 }
693 }
694
695 #
696 # Delete the Decoder Statisctics window for this source.
697 #
698 UISource/RTP instproc delete-decoder-window {} {
699 $self instvar decoder_win_
700 if [info exists decoder_win_] {
701 delete $decoder_win_
702 unset decoder_win_
703 }
704 }
705
706
707 UISource public change_info { info } {
708 # FIXME
709 }
710
711
712 UISource public get_info {} {
713 # FIXME
714 return ""
715 }
716
717
718 UISource/Video public user_windows {} {
719 return [$self set userwindows_]
720 }
721
722
723 UISource/Video public detach_windows {} {
724 $self instvar userwindows_
725 foreach uw $userwindows_ {
726 $self detach-window $uw
727 }
728 }
729
730
731
732 #
733 # Bind a source to a window so that the video stream from the
734 # represented source appears in UserWindow <i>uw</i>.
735 #
736 UISource/Video public attach_window { uw } {
737 $self instvar src_ observer_
738 UISource/Video instvar colorModel_ use_hw_decode_
739 [$uw video-widget] attach-decoder $src_ $colorModel_ $use_hw_decode_
740 $self instvar userwindows_
741 lappend userwindows_ $uw
742 $uw set-name [$src_ getid]
743
744 set scuba_sess [$observer_ scuba_session]
745 if { $scuba_sess != {} } {
746 $scuba_sess scuba_focus $src_
747 }
748 }
749
750
751 #
752 # Discontinue the representation of this ActiveSource in UserWindow <i>uw</i>.
753 #
754 UISource/Video public detach_window uw {
755 $self instvar userwindows_ src_ observer_
756 set scuba_sess [$observer_ scuba_session]
757 if { $scuba_sess != {} } {
758 $scuba_sess scuba_unfocus $src_
759 }
760 [$uw video-widget] detach-decoder $src_
761 # there must be an easier way to do this
762 set k [lsearch -exact $userwindows_ $uw]
763 if { $k < 0 } {
764 puts "[$self get_option appname]: detach-window: FIXME"
765 exit 1
766 }
767 set userwindows_ [lreplace $userwindows_ $k $k]
768 }
769
770
771 # FIXME: required for UserWindow
772 UISource/Video public attach-window {w} {
773 $self attach_window $w
774 }
775 UISource/Video public detach-window {w} {
776 $self detach_window $w
777 }
778
779
780 UISource/Video public color { { c {} } } {
781 $self instvar src_ userwindows_ thumbnail_
782 $self tkvar color_
783 if { $c == {} } { return $color_ }
784 set h [$src_ handler]
785 if { $h != {} } {
786 $h color $c
787 foreach uw $userwindows_ {
788 [$uw video-widget] redraw
789 }
790 if [info exists thumbnail_] {
791 $thumbnail_ redraw
792 }
793 }
794 set color_ $c
795 }
796
797
798 UISource/Video public mute { { m {} } } {
799 $self instvar src_
800 $self tkvar mute_
801 if { $m == {} } { return $mute_ }
802 $src_ mute $m
803 set mute_ $m
804 }
805
806
807 UISource/Audio public mute { { m {} } } {
808 $self instvar src_
809 $self tkvar mute_
810 if { $m == {} } { return $mute_ }
811 $src_ mute $m
812 set mute_ $m
813 $self draw_indicator
814 }
815
816
817 UISource/Audio public create_root_widget {path} {
818 [$self info class] instvar image_
819 # need the container frame becoz the root widget cannot be
820 # another WidgetObject; this'll horribly confuse the
821 # WidgetClass library
822 frame $path
823 set path [CompoundButton $path.b -bd 1 -relief raised \
824 -highlightthickness 0]
825 $path add button icon -image $image_ -bd 0 -relief flat \
826 -highlightthickness 0 -takefocus 0
827 $path.icon configure -activebackground [option get $path defaultColor \
828 UISource]
829 $path add canvas indicator -width 0 -height 0 -bg \
830 [option get $path defaultColor UISource] \
831 -bd 0 -relief sunken
832 pack $path.icon -side left
833 pack $path.indicator -padx 6 -side left
834 pack $path -fill both -expand 1
835 $self set_subwidget indicator $path.indicator
836 $self set_subwidget icon $path.icon
837
838
839 $path configure -command "tk_popup $path.menu \[winfo pointerx $path\]\
840 \[winfo pointery $path\]"
841 menu $path.menu
842 $path.menu add checkbutton -label "Mute" \
843 -variable [$self tkvarname mute_] \
844 -command "$self mute \$\{[$self tkvarname mute_]\}"
845 $path.menu add cascade -label "Info..." -menu $path.menu.info
846 $self build_info_menu $path.menu.info
847 }
848
849
850 UISource/Audio public create_root_widget1 {path} {
851 frame $path -bd 1 -relief raised
852 [$self info class] instvar image_
853 button $path.icon -image $image_ -bd 0 -relief flat \
854 -highlightthickness 0 -takefocus 0
855 $path.icon configure -activebackground [option get $path defaultColor \
856 UISource]
857 frame $path.indicator -width 0 -height 0 -bg [option get $path \
858 defaultColor UISource] -bd 0 -relief sunken
859 pack $path.icon -side left
860 pack $path.indicator -padx 7 -side left
861 }
862
863
864 UISource/Audio public rank { {rank {}} } {
865 # FIXME
866 $self instvar rank_
867 if ![info exists rank_] { set rank_ 4 }
868 if { $rank == {} } { return $rank_ } else {
869 set rank_ $rank
870 $self draw_indicator
871 }
872 }
873
874
875 UISource/Audio private draw_indicator {} {
876 $self instvar src_ disabled_
877
878 set indicator [$self subwidget indicator]
879 if { [info exists disabled_] && $disabled_ } {
880 $indicator configure -width 10 -height 10 -bd 1 \
881 -bg [option get [$self info path] \
882 disabledColor UISource/Audio]
883 pack configure $indicator -padx 1
884 } elseif [$src_ mute] {
885 $indicator configure -width 9 -height 9 -bd 1 \
886 -bg red
887 pack configure $indicator -padx 1
888 } else {
889 switch [$self rank] {
890 0 {
891 $indicator configure -width 9 -height 9 \
892 -bg green -bd 1
893 pack configure $indicator -padx 1
894 }
895 1 {
896 $indicator configure -width 7 -height 7 \
897 -bg green -bd 1
898 pack configure $indicator -padx 2
899 }
900 2 {
901 $indicator configure -width 3 -height 3 \
902 -bg green -bd 1
903 pack configure $indicator -padx 5
904 }
905 default {
906 $indicator configure -width 0 -height 0 -bg \
907 [option get [$self info path]\
908 defaultColor UISource] -bd 0
909 pack configure $indicator -padx 6
910 }
911 }
912 }
913 }
914
915
916 UISource/Audio public disable {flag} {
917 $self instvar disabled_
918 set disabled_ $flag
919 $self draw_indicator
920 }
921
922
923 UISource public highlight {flag} {
924 $self instvar msrc_
925 if $flag { set relief sunken } else { set relief raised }
926 $self set_relief $relief
927 $msrc_ highlight $flag
928 }
929
930
931 UISource public set_relief {relief} {
932 [$self info path] configure -relief $relief
933 }
934
935
936 UISource/Audio public set_relief {relief} {
937 $self subwidget b configure -relief $relief
938 }
939
940
941 MultiSource public init {sm cname} {
942 $self next
943 $self instvar sm_ widget_ cname_ highlight_
944 set list [$sm list_ui]
945 $list insert end [list -id $self ""]
946 set widget_ [$list info widget -id $self]
947 set sm_ $sm
948 set cname_ $cname
949 set highlight_ 0
950
951 $self build_widget $widget_
952 }
953
954
955 MultiSource public destroy {} {
956 $self instvar sm_
957 set list [$sm_ list_ui]
958</