1 # simple-video-tx.tcl --
2 #
3 # A simple video transmitter
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
37 Import enable
38 import Application AddressBlock VideoAgent VideoPipeline
39
40 Class SimpleVideoApp -superclass Application
41
42 SimpleVideoApp instproc init {} {
43 $self next sv
44 $self add_default defaultTTL 16
45 $self instvar agent_ vpipe_
46 set agent_ [new VideoAgent $self 224.1.2.3/12345]
47 set vpipe_ [new VideoPipeline $agent_]
48 }
49
50 SimpleVideoApp instproc run {} {
51 $self instvar agent_ vpipe_
52 # puts here the different options and (maybe) use
53
54 # get a list of all video-capture devices
55 set device_list [$vpipe_ input_devices]
56
57 # use the first one of the list
58 set device [lindex $device_list 0]
59
60 # select the video-compression format for this device to be ITU's H.261
61 $vpipe_ select $device h261
62
63 # select the quality factor for the video-compression format
64 $vpipe_ set_quality 10
65
66 # start the VideoPipeline
67 $vpipe_ start
68 }
69
70 SimpleVideoApp instproc enhance {} {
71 $self instvar agent_ vpipe_
72
73 # FIXME: this requires more information on how to know which arguments
74 # are valid for each method
75
76 $vpipe_ set_port Composite1
77 $vpipe_ set_norm ntsc
78
79 $vpipe_ set_quality 100
80 $vpipe_ set_fps 30
81 $vpipe_ set_bps 3000000
82
83 #$agent_ sessionbw 1000
84 #$agent_ local_bandwidth 1000
85
86 #set tap_ [$vpipe_ set tap_]
87 #$tap_ set_bps 30
88 #set grabber_ [$tap_ set grabber_]
89 #$tap_ set device_
90 #$grabber_ fps 30
91 #$grabber_ norm pal
92 #$grabber_ norm ntsc
93 }
94
95
96
97 set app [new SimpleVideoApp]
98 $app run
99 $app enhance
100 vwait forever
101
102
103 ###########
104
105 source [file join $env(TCLCL_IMPORT_DIRS) import.tcl]
106
107 Import enable
108 import Application AddressBlock VideoAgent VideoPipeline
109
110 Class SimpleVideoApp -superclass Application
111
112 Class MyAgent
113
114 SimpleVideoApp instproc init {} {
115 $self next sv
116 $self add_default defaultTTL 16
117 $self instvar agent_ vpipe_
118 set agent_ [new MyAgent]
119 set vpipe_ [new VideoPipeline $agent_]
120 }
121
122 MyAgent instproc get_local_srcid {args} {
123 puts "MyAgent::get_local_srcid called with $args"
124 }
125 MyAgent instproc get_transmitter {args} {
126 puts "MyAgent::get_transmitter called with $args"
127 return [new MyPacket]
128 }
129
130 Class MyPacket
131 MyPacket instproc recv {args} {
132 puts "MyPacket::recv called with $args"
133 }
134
135 set app [new SimpleVideoApp]
136 #
137 #SimpleVideoApp instproc run
138 #
139 set vpipe_ [$app set vpipe_]
140 set device_list [$vpipe_ input_devices]
141 set device [lindex $device_list 0]
142 $vpipe_ select $device h261
143 $vpipe_ set_quality 10
144 $vpipe_ start
145
146
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.