1 # example.tcl --
2 #
3 # Example of use of FX module: it joins a session, and applies
4 # an effect composing n sources to the first n sources it sees.
5 #
6 # This script creates the following structure:
7 #
8 # decoder -> dali renderer -> effect -> dali video-capture -> encoder
9 #
10 # Everything is implemented in C++, and tcl is used as glue.
11 #
12 #
13 # Copyright (c) 1997-2002 The Regents of the University of California.
14 # All rights reserved.
15 #
16 # Redistribution and use in source and binary forms, with or without
17 # modification, are permitted provided that the following conditions are met:
18 #
19 # A. Redistributions of source code must retain the above copyright notice,
20 # this list of conditions and the following disclaimer.
21 # B. Redistributions in binary form must reproduce the above copyright notice,
22 # this list of conditions and the following disclaimer in the documentation
23 # and/or other materials provided with the distribution.
24 # C. Neither the names of the copyright holders nor the names of its
25 # contributors may be used to endorse or promote products derived from this
26 # software without specific prior written permission.
27 #
28 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
29 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
30 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
31 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
32 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
33 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
34 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
35 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
36 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
37 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
38 #
39
40 if {[catch {source [file join $env(TCLCL_IMPORT_DIRS) import.tcl]} res]} {
41 if {[catch {source ../../../import.tcl} res]} {
42 puts "error sourcing the import.tcl initialization script: $res"
43 exit 1
44 }
45 }
46
47 Import enable
48 import Application AddressBlock VideoAgent TkWindow
49 import VideoPipeline
50 import Device
51
52
53
54 #
55 # EffectApplication
56 #
57 Class EffectApplication -superclass Application
58
59 EffectApplication instproc init {} {
60 $self next sv
61 $self instvar agent_ srcmgr_
62 $self instvar vpipe_
63
64 # this is the default ttl used by the NetworkManager object
65 $self add_default defaultTTL 16
66
67 # a VideoAgent object abstracts away the networking
68 #set spec 224.2.1.1/22334
69 set spec 224.1.2.3/12345
70 #set spec 233.0.25.25/22334
71 set agent_ [new EffectVideoAgent $self $spec]
72 puts "Listening to $spec"
73
74 # let's choose the type of output (h261,420), (jpeg,422), (jpeg,420), ...
75 #set encoder_type h261; set encoder_csss 420
76 set encoder_type jpeg; set encoder_csss 422
77
78
79 # the Module/VideoEffect/XXX object carries out the effect
80 # a. 1-input effects
81 #set effect_ [new Module/VideoEffect/Addition $encoder_csss]
82 #set effect_ [new Module/VideoEffect/Copy $encoder_csss]
83 #set effect_ [new Module/VideoEffect/EdgeDetect $encoder_csss]
84 #set effect_ [new Module/VideoEffect/FadeColor $encoder_csss]
85 #set effect_ [new Module/VideoEffect/PanScan $encoder_csss]
86 #set effect_ [new Module/VideoEffect/Whirlpool $encoder_csss]
87 #set effect_ [new Module/VideoEffect/ZeroCopy $encoder_csss]
88 set effect_ [new Module/VideoEffect/Titling $encoder_csss]
89 # b. 2-input effects
90 #set effect_ [new Module/VideoEffect/ChromaKey $encoder_csss]
91 #set effect_ [new Module/VideoEffect/Fade $encoder_csss]
92 #set effect_ [new Module/VideoEffect/Peel $encoder_csss]
93 #set effect_ [new Module/VideoEffect/Pip $encoder_csss]
94 # c. 3-input effects
95 #set effect_ [new Module/VideoEffect/Mosaic $encoder_csss]
96
97 # create a VideoPipeline to be able to send video
98 set vpipe_ [new VideoPipeline $agent_]
99 $vpipe_ set_quality 99
100
101 # use DaliVideoCapture/Uncompressed as VideoCapture (VideoTap) device
102 set device DaliVideoCapture/Uncompressed
103 # TBD: we need to create a non-used device to register it as a VideoTap,
104 # which is pretty dirty
105 new $device $encoder_csss
106
107 $vpipe_ select $device $encoder_type
108 $vpipe_ start
109
110 # attach the effect to the grabber input
111 set grabber_ [[$vpipe_ set tap_] set grabber_]
112 #$effect_ attach $grabber_
113 $effect_ target $grabber_
114
115 # another object (called EffectSourceManager) is in charge
116 # of listening to the VideoAgent events (sources joining or starting
117 # transmission) and responding to them
118 set srcmgr_ [new EffectSourceManager $agent_ $effect_]
119
120 # request the VideoAgent to send events to the Source Manager
121 $agent_ attach $srcmgr_
122 }
123
124
125
126 #
127 # EffectVideoAgent
128 #
129 Class EffectVideoAgent -superclass VideoAgent
130 EffectVideoAgent instproc init {args} {
131 eval $self next $args
132 }
133 EffectVideoAgent instproc create-decoder {args} {
134 puts "EffectVideoAgent::create-decoder{$args}"
135 eval $self next $args
136 }
137
138
139 #
140 # EffectSourceManager
141 #
142 Class EffectSourceManager superclass Observer
143
144 EffectSourceManager instproc init {agent effect} {
145 $self next
146 $self instvar agent_ effect_
147 $self instvar local_srcid_ local_addr_
148 $self instvar source_list_
149 $self instvar input_id_
150
151 # write up the VideoAgent and VideoEffect handlers
152 set agent_ $agent
153 set effect_ $effect
154
155 # write up the local srcid and addr
156 set local_srcid_ [[$agent_ local] srcid]
157 set local_addr_ [[$agent_ local] addr]
158
159 # reset the source list
160 set source_list_ ""
161
162 # initialize the effect input counter
163 set input_id_ 0
164 }
165
166 #
167 # EffectSourceManager::trigger_sdes
168 #
169 # trigger_sdes is an event raised by the VideoAgent when somebody
170 # joins our session
171 #
172 EffectSourceManager instproc trigger_sdes {src} {
173 $self instvar local_srcid_ local_addr_
174 $self instvar source_list_
175
176 # check we are not seeing our own source
177 set srcid [$src srcid]
178 if {$srcid == $local_srcid_} {
179 # it's our own source
180 return
181 }
182
183 # check we are not seeing our own address, which would mean this is the
184 # fx-produced stream
185 set addr [$src addr]
186 if {$addr == $local_addr_} {
187 # it's the fx-produced stream
188 return
189 }
190
191 # check we haven't seen this stream before
192 foreach source $source_list_ {
193 if {($srcid == [lindex $source 0]) && ($addr == [lindex $source 1])} {
194 # we've seen this stream before
195 return
196 }
197 }
198
199 lappend source_list_ [list $srcid $addr -1]
200 }
201
202 #
203 # EffectSourceManager::trigger_media
204 #
205 # trigger_media is an event raised by the VideoAgent when some source
206 # joined to our session starts transmitting
207 #
208 EffectSourceManager instproc trigger_media {src} {
209 $self instvar local_srcid_ local_addr_
210 $self instvar source_list_
211 $self instvar effect_
212 $self instvar input_id_
213
214 # check we are not seeing our own source
215 set srcid [$src srcid]
216 if {$srcid == $local_srcid_} {
217 # it's our own source
218 return
219 }
220
221 # check we are not seeing our own address, which would mean this is the
222 # fx-produced stream
223 set addr [$src addr]
224 if {$addr == $local_addr_} {
225 # it's the fx-produced stream
226 return
227 }
228
229 # check if we have seen this stream before
230 set stream_id -1
231 set i 0
232 foreach source $source_list_ {
233 if {($srcid == [lindex $source 0]) && ($addr == [lindex $source 1])} {
234 # we've seen this stream before
235 set stream_id $i
236 if {[lindex $source 2] != -1} {
237 # the stream has been already initialized
238 return
239 }
240 break
241 }
242 incr i
243 }
244
245 # if it's a new stream, add an entry for it
246 if {$stream_id == -1} {
247 # first time we see this stream
248 set stream_id [llength $source_list_]
249 lappend source_list_ [list $srcid $addr -1]
250 }
251
252 # check if we have too many inputs for this effect
253 if {$input_id_ >= [$effect_ get-inputs]} {
254 # we have too many inputs for the effect
255 puts "SourceManager: srcid $srcid from $addr ([$src sdes cname]) has\
256 been rejected (too many inputs)"
257 return
258 }
259
260 # new stream: get the new input id
261 set input_id $input_id_
262 incr input_id_
263
264 # fix the stream list
265 set source_list_ [lreplace $source_list_ $stream_id $stream_id \
266 [list $srcid $addr $input_id]]
267 puts "SourceManager: srcid $srcid from $addr ([$src sdes cname]) has\
268 joined the effect as input $input_id"
269
270 # we wait a little to give time for the VideoAgent to create and install
271 # a decoder, and for such decoder to get one packet so that it can
272 # realize the format, size, and color subsampling scheme of the video
273 # stream
274 after idle "$self really_activate $src $input_id"
275 }
276
277
278 #
279 # EffectSourceManager::really_activate
280 #
281 # when a source has started transmitting and the decoder is already
282 # installed, really_activate attaches a renderer object to the decoder's
283 # output and to the effect input
284 #
285 EffectSourceManager instproc really_activate {src input_id} {
286 $self instvar window_ decoder_ csss_ window_ renderer_
287 $self instvar effect_
288 $self instvar agent_
289
290 # get the decoder handler
291 set decoder_ [$src handler]
292 if {$decoder_ == ""} {
293 # cannot find a decoder
294 puts -nonewline "ESM::really_activate: couldn't find a decoder";
295 return
296 }
297 set csss_ [$decoder_ csss]
298
299 # create a receiver for the frames (the Renderer object)
300 set renderer_ [new Renderer/Dali [$decoder_ info class]]
301
302 # attach the renderer to the decoder's output
303 $decoder_ attach $renderer_
304
305 # attach the renderer as an effect input
306 $renderer_ attach $effect_ $input_id
307 }
308
309
310 # get rid of the main window
311 wm withdraw .
312
313 # create the main object
314 set app [new EffectApplication]
315
316 #vwait forever
317
318
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.