1 # ui-video.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/ui-video.tcl,v 1.7 2002/02/03 04:21:46 lim Exp $
32
33
34 import ScrolledWinMgr
35 Class VideoContainer
36
37
38 VideoContainer proc.invoke {} {
39 $self instvar sizes_
40 set sizes_(thumbnail) {80 60}
41 set sizes_(qcif) {176 144}
42 set sizes_(cif) {352 288}
43 set sizes_(scif) {704 576}
44 set sizes_(ntsc_16) {160 120}
45 set sizes_(ntsc_4) {320 240}
46 set sizes_(ntsc) {640 480}
47 }
48
49
50 VideoContainer public init { path num size init_orientation } {
51 $self instvar numVideos_ size_ orient_
52 set numVideos_ $num
53 set size_ [VideoContainer set sizes_($size)]
54 set orient_ $init_orientation
55
56 $self build_widget $path
57 }
58
59
60 VideoContainer public destroy { } {
61 $self instvar videos_ path_
62 set i 0
63 foreach v $videos_ {
64 $self throw_away $v
65 }
66 }
67
68
69 VideoContainer private build_widget { path } {
70 $self instvar numVideos_ videos_ size_ path_ bbox_ orient_ nextIdx_ \
71 win2vw_
72
73 set path_ $path
74 ScrolledWinMgr $path -scrollbar both
75 set bbox_ [$path holder]
76
77 set videos_ {}
78 set x 0
79 set y 0
80 if { $orient_ == "vertical" } {
81 set dx 0; set dy [expr [lindex $size_ 1] + 20]
82 } else {
83 set dx [expr [lindex $size_ 0] + 5]; set dy 0
84 }
85 for { set i 0 } { $i < $numVideos_ } { incr i } {
86 set v [eval new VideoWidget/Decorated $bbox_.video$i $size_ \
87 $self]
88 set win2vw_($bbox_.video$i) $v
89 $path add_window $bbox_.video$i $x $y
90 incr x $dx
91 incr y $dy
92 lappend videos_ $v
93 }
94 set nextIdx_ $numVideos_
95 }
96
97
98 VideoContainer private add { uisrc x y } {
99 $self instvar videos_ path_ size_ nextIdx_ bbox_ mappings_ win2vw_
100 set i [llength $videos_]
101 set v [eval new VideoWidget/Decorated $bbox_.video$nextIdx_ $size_ \
102 $self]
103 set win2vw_($bbox_.video$nextIdx_) $v
104 lappend videos_ $v
105 $v switch $uisrc
106 lappend mappings_([$uisrc src]) $v
107
108 $path_ add_window $bbox_.video$nextIdx_ $x $y
109 incr nextIdx_
110 }
111
112
113 VideoContainer public activate { uisrc } {
114 $self instvar videos_ mappings_
115 foreach v $videos_ {
116 if { [$v attached-source] == {} } {
117 $v switch $uisrc
118 lappend mappings_([$uisrc src]) $v
119 break
120 }
121 }
122 }
123
124
125 VideoContainer public deactivate { uisrc {othersrcs {}} } {
126 $self instvar mappings_
127 if [info exists mappings_([$uisrc src])] {
128 foreach mapped $mappings_([$uisrc src]) {
129 set new_src ""
130 foreach s $othersrcs {
131 if ![info exists mappings_([$s src])] {
132 set new_src $s
133 break
134 }
135 }
136
137 $mapped switch $new_src
138 if { $new_src != {} } {
139 lappend mappings_([$new_src src]) $mapped
140 }
141 }
142 unset mappings_([$uisrc src])
143 }
144 }
145
146
147 VideoContainer public change_name { uisrc name } {
148 $self instvar mappings_
149 if [info exists mappings_([$uisrc src])] {
150 foreach mapped $mappings_([$uisrc src]) {
151 $mapped change_label $name
152 }
153 }
154 }
155
156
157 VideoContainer public drop_thumbnail { dragdrop uisrc x y } {
158 $self instvar videos_ mappings_ bbox_ win2vw_
159
160 set bl [winfo rootx $bbox_]
161 set bt [winfo rooty $bbox_]
162 set br [expr $bl + [winfo width $bbox_] - 1]
163 set bb [expr $bt + [winfo height $bbox_] - 1]
164
165 # first sort the video list in top-to-bottom stacking order
166 set videos {}
167 foreach w [winfo children $bbox_] {
168 if [info exists win2vw_($w)] {
169 set videos [concat [list $win2vw_($w)] $videos]
170 }
171 }
172
173 foreach v $videos {
174 set w [$v path]
175 if ![winfo ismapped $w] continue
176
177 set l [winfo rootx $w]
178 set t [winfo rooty $w]
179 set r [expr $l + [winfo width $w] - 1]
180 set b [expr $t + [winfo height $w] - 1]
181
182 if { $bl > $l } { set l $bl }
183 if { $br < $r } { set r $br }
184 if { $bt > $t } { set t $bt }
185 if { $bb < $b } { set b $bb }
186
187 if { $l > $r || $t > $b } continue
188
189 if { $x >= $l && $x <= $r && $y >= $t && $y <= $b } {
190 set s [$v attached-source]
191 if { $s!={} && [info exists mappings_([$s src])] } {
192 set i [lsearch -exact $mappings_([$s src]) $v]
193 if { $i != -1 } {
194 set mappings_([$s src]) [lreplace \
195 $mappings_([$s src]) \
196 $i $i]
197 if { [llength $mappings_([$s src])] \
198 == 0 } {
199 unset mappings_([$s src])
200 }
201 }
202 }
203 $v switch $uisrc
204 lappend mappings_([$uisrc src]) $v
205 return 1
206 }
207 }
208
209 if { $x >= $bl && $x <= $br && $y >= $bt && $y <= $bb } {
210 # we are inside the canvas boundary
211 # let's just add a new video widget
212
213 set coords [$dragdrop get_nw_coords $x $y]
214 set x [lindex $coords 0]
215 set y [lindex $coords 1]
216
217 $self add $uisrc [$bbox_ canvasx [expr $x -$bl]] \
218 [$bbox_ canvasy [expr $y - $bt]]
219 return 1
220 }
221 return 0
222 }
223
224
225 VideoContainer public move_widget { vwd dragdrop x y } {
226 $self instvar videos_ mappings_ bbox_ path_
227
228 set bl [winfo rootx $bbox_]
229 set bt [winfo rooty $bbox_]
230 set br [expr $bl + [winfo width $bbox_] - 1]
231 set bb [expr $bt + [winfo height $bbox_] - 1]
232
233 set w [$vwd path]
234 set coords [$dragdrop get_nw_coords $x $y]
235 set l [lindex $coords 0]
236 set t [lindex $coords 1]
237 set r [expr $l + [winfo width $w] - 1]
238 set b [expr $t + [winfo height $w] - 1]
239
240 if { $bl > $l } { set l $bl }
241 if { $br < $r } { set r $br }
242 if { $bt > $t } { set t $bt }
243 if { $bb < $b } { set b $bb }
244
245 if { $l <= $r && $t <= $b } {
246 # we are inside the canvas boundary
247 # let's just add a new video widget
248
249 set l [lindex $coords 0]
250 set t [lindex $coords 1]
251 $path_ move_window [$vwd path] [$bbox_ canvasx [expr $l -$bl]]\
252 [$bbox_ canvasy [expr $t - $bt]]
253 } else {
254 # the drop location is outside the video container
255 # throw the source away
256
257 #$dragdrop zoom_back 25
258 $self throw_away $vwd
259 }
260 }
261
262
263 VideoContainer private throw_away { vwd } {
264 $self instvar mappings_ videos_ path_
265
266 set s [$vwd attached-source]
267 if { $s != "" } {
268 $vwd switch {}
269 if [info exists mappings_([$s src])] {
270 set i [lsearch -exact $mappings_([$s src]) $vwd]
271 if { $i != -1 } {
272 set mappings_([$s src]) [lreplace \
273 $mappings_([$s src]) $i $i]
274 if { [llength $mappings_([$s src])] == 0 } {
275 unset mappings_([$s src])
276 }
277 }
278 }
279 }
280
281 $path_ remove_window [$vwd path]
282 delete $vwd
283 set i [lsearch -exact $videos_ $vwd]
284 if { $i != -1 } {
285 set videos_ [lreplace $videos_ $i $i]
286 }
287 }
288
289
290 Class VideoWidget/Decorated -superclass VideoWidget
291
292
293 VideoWidget/Decorated public init { w width height vc } {
294 $self instvar widget_ label_ dragdrop_ videoContainer_
295 $self tkvar size_
296 set videoContainer_ $vc
297 set widget_ $w
298 frame $w -bd 1 -relief raised
299 $self next $w.video $width $height
300 label $w.label_frame -height 1
301 menubutton $w.label -text "Waiting for video" \
302 -menu $w.label.menu
303 set label_ "Waiting for video"
304 pack $w.video -anchor c
305 pack $w.label -fill both -expand 1 -in $w.label_frame
306 pack $w.label_frame -side bottom -anchor s -fill x
307 pack propagate $w.label_frame 0
308 $self set uisrc_ ""
309
310 menu $w.label.menu
311 $w.label.menu add cascade -label "Size" -menu $w.label.menu.size
312 $w.label.menu add command -label "Clear window" \
313 -command "$self switch {}"
314 $w.label.menu add command -label "Delete window" \
315 -command "$videoContainer_ throw_away $self"
316
317 set size_ ${width}x$height
318 set m [menu $w.label.menu.size]
319 $m add radiobutton -label QCIF -command "$self resize 176 144" \
320 -value 176x144 -variable [$self tkvarname size_]
321 $m add radiobutton -label CIF -command "$self resize 352 288" \
322 -value 352x288 -variable [$self tkvarname size_]
323 $m add radiobutton -label SCIF -command "$self resize 704 576" \
324 -value 704x576 -variable [$self tkvarname size_]
325
326 $m add separator
327 $m add radiobutton -label "1/16 NTSC" \
328 -command "$self resize 160 120" -value 160x120 \
329 -variable [$self tkvarname size_]
330 $m add radiobutton -label "1/4 NTSC" \
331 -command "$self resize 320 240" -value 320x240 \
332 -variable [$self tkvarname size_]
333 $m add radiobutton -label NTSC \
334 -command "$self resize 640 480" -value 640x480 \
335 -variable [$self tkvarname size_]
336
337 $m add separator
338 $m add radiobutton -label "1/16 PAL" \
339 -command "$self resize 192 144" -value 192x144 \
340 -variable [$self tkvarname size_]
341 $m add radiobutton -label "1/4 PAL" \
342 -command "$self resize 384 288" -value 384x288 \
343 -variable [$self tkvarname size_]
344 $m add radiobutton -label PAL \
345 -command "$self resize 768 576" -value 768x576 \
346 -variable [$self tkvarname size_]
347
348 set dragdrop_ [new DragNDrop $w.video \
349 "$videoContainer_ move_widget $self"]
350 }
351
352
353 VideoWidget/Decorated public destroy { } {
354 $self instvar widget_
355 set w $widget_
356 $self next
357 destroy $w
358 }
359
360
361 VideoWidget/Decorated public path { } {
362 $self instvar widget_
363 return $widget_
364 }
365
366
367 VideoWidget/Decorated public change_label { label } {
368 $self instvar widget_ label_
369 if { $label_ != $label } {
370 $widget_.label configure -text $label
371 set label_ $label
372 }
373 }
374
375
376 VideoWidget/Decorated public switch { uisrc } {
377 $self instvar uisrc_ dragdrop_ widget_
378 if { $uisrc_ == $uisrc } return
379 if { $uisrc_ != {} } {
380 $uisrc_ detach_window $self
381 }
382
383 set uisrc_ $uisrc
384 if { $uisrc_ != {} } {
385 bind $widget_.video <Double-ButtonPress-1> \
386 "$uisrc_ select_thumbnail"
387 $uisrc_ attach_window $self
388 $self change_label [$uisrc_ name]
389 } else {
390 bind $widget_.video <Double-ButtonPress-1> ""
391 $self change_label "Waiting for video"
392 }
393 $self redraw
394 }
395
396
397 VideoWidget/Decorated public attached-source { } {
398 $self instvar uisrc_
399 return $uisrc_
400 }
401
402
403 #
404 # Resize the VideoWindow being displayed in the UserWindow's VideoWidget.
405 #
406 VideoWidget/Decorated public resize { w h } {
407 $self instvar uisrc_
408 if { $uisrc_ != {} } { $uisrc_ detach_window $self }
409 [$self window] resize $w $h
410 #
411 # Force an update so the window gets mapped at
412 # the new size before we re-bind the window
413 # to the source.
414 #
415 update idletasks
416 if { $uisrc_ != {} } { $uisrc_ attach_window $self }
417 }
418
419
420
421 VideoWidget/Decorated public is-switched {} { return 0 }
422 VideoWidget/Decorated public video-widget {} { return $self }
423 VideoWidget/Decorated public set-name { name } { $self change_label $name }
424
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.