1 # simple-video-trans.tcl --
2 #
3 # A simple video transcoder
4 #
5 # Copyright (c) 1997-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
32 if {[catch {source [file join $env(TCLCL_IMPORT_DIRS) import.tcl]} res]} {
33 puts "error sourcing the import.tcl initialization script: $res"
34 }
35
36 Import enable
37 import Application AddressBlock VideoAgent TkWindow
38 import VideoWidget
39
40
41 #
42 # SimpleVideoTransApp
43 #
44 Class SimpleVideoTransApp -superclass Application
45
46 SimpleVideoTransApp instproc init {} {
47 $self next sv
48 $self add_default defaultTTL 16
49 $self instvar agent_ srcmgr_
50
51 # a VideoAgent object abstracts away the networking
52 set agent_ [new VideoAgent $self 224.1.2.3/12346]
53
54 # another object (called SimpleVideoTransSourceManager) is in charge of
55 # listening to the VideoAgent and responding to its events
56 set srcmgr_ [new SimpleVideoTransSourceManager $agent_]
57 $agent_ attach $srcmgr_
58 }
59
60
61 #
62 # SimpleVideoTransSourceManager
63 #
64 Class SimpleVideoTransSourceManager superclass Observer
65
66 SimpleVideoTransSourceManager instproc init {agent} {
67 $self next
68 $self instvar agent_ target_
69
70 set agent_ $agent
71 set target_ ""
72 }
73
74 #
75 # SimpleVideoTransSourceManager::trigger_sdes
76 #
77 # trigger_sdes is an event raised by the VideoAgent when somebody
78 # joins our session
79 #
80 SimpleVideoTransSourceManager instproc trigger_sdes {src} {
81 puts "trigger_sdes: [$src sdes cname] ([$src sdes name]) joined the session"
82 }
83
84 #
85 # SimpleVideoTransSourceManager::trigger_media
86 #
87 # trigger_media is an event raised by the VideoAgent when some source
88 # joined to our session starts transmitting
89 #
90 SimpleVideoTransSourceManager instproc trigger_media {src} {
91
92 # we wait a little to give time to the VideoAgent to create
93 # and install a decoder and for such decoder to get one packet
94 # so that it can realize the format, size, and color subsampling
95 # scheme
96 after idle "$self really_activate $src"
97 }
98 SimpleVideoTransSourceManager instproc really_activate {src} {
99
100 $self instvar window_ target_ decoder_ csss_ window_ renderer_
101
102 puts "trigger_media: [$src sdes cname] ([$src sdes name]) is transmitting"
103
104 # get the decoder handler
105 set decoder_ [$src handler]
106 if {$decoder_ == ""} {
107 puts "\tcouldn't find a decoder"
108 return
109 } else {
110 puts "\tVideoAgent created a decoder [$decoder_ info class]"
111 }
112
113 # create a receiver for the frames (the Renderer object) and attach
114 # it to the decoder's output
115 set renderer_ [new Renderer/Null]
116 $decoder_ attach $renderer_
117 }
118
119 # get rid of the main window
120 wm withdraw .
121 set app [new SimpleVideoTransApp]
122
123
124 # ///////////////////////////////
125 # to get the display propierties
126 #import VisualFrame
127 #set vframe_ [new VisualFrame .top]
128 #[$vframe_ set colorModel_] info class; # returns Colormodel/TrueColor/24
129
130
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.