1 # whirlpool.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 import DaliSubprogram
32 import RealParameter
33
34 Class WhirlpoolSubprogram -superclass DaliSubprogram
35
36 WhirlpoolSubprogram instproc init {args} {
37 eval $self next $args;
38
39 # Set up inputs
40
41 $self instvar input_id_list_;
42 $self instvar input_info_;
43
44 lappend input_id_list_ i1
45
46 set input_info_(i1,spec) "";
47 set input_info_(i1,trigger) 0;
48 set input_info_(i1,buffertype) Uncompressed;
49 set input_info_(i1,buffername) [new VidRep/Uncompressed];
50 set input_info_(i1,decoder) "";
51 set input_info_(i1,primary_trigger) 1
52
53 # Set up outputs
54
55 $self instvar output_id_list_;
56 $self instvar output_info_;
57
58 lappend output_id_list_ o1;
59
60 set output_info_(o1,spec) "";
61 set output_info_(o1,buffertype) Uncompressed;
62 set output_info_(o1,buffername) [new VidRep/Uncompressed];
63 set output_info_(o1,encoder) "";
64 set output_info_(o1,format) JPEG;
65 set output_info_(o1,vagent) "";
66
67 # Set up which input will drive each output's synchronization
68 $self set_ntp_reference i1 o1
69
70 # Set up parameters
71
72 $self instvar parameter_id_list_;
73 $self instvar parameter_info_;
74
75 lappend parameter_id_list_ theta
76 set pobj [new RealParameter];
77
78 set parameter_info_(theta,oname) $pobj;
79 $pobj from 0.0
80 $pobj to 10.0
81 $pobj set 0.0
82
83 $self instvar comm_obj_;
84 $comm_obj_ setup;
85 }
86
87 WhirlpoolSubprogram instproc trigger {} {
88 $self instvar comm_obj_;
89
90 if {![$comm_obj_ parameter_attr_has_value theta value]} {
91 return;
92 }
93
94 $self instvar parameter_info_;
95 $self instvar input_info_;
96 $self instvar output_info_;
97 $self instvar init_done_;
98 $self instvar old_theta_;
99 $self instvar la lb lc ld le lf ca cb cc cd ce cf
100
101 set angle_obj $parameter_info_(theta,oname);
102 set angle [$angle_obj get];
103
104 set in_frame $input_info_(i1,buffername);
105 set out_frame $output_info_(o1,buffername);
106
107 if {![info exists init_done_]} {
108 if {[$in_frame set w_] == 0} {
109 return;
110 }
111 $out_frame copy_geometry $in_frame;
112 if {$output_info_(o1,format) == "JPEG"} {
113 $out_frame set h_subsample_ 2;
114 $out_frame set v_subsample_ 1;
115 } else {
116 $out_frame set h_subsample_ 2;
117 $out_frame set v_subsample_ 2;
118 }
119 $out_frame allocate;
120 set init_done_ 1;
121 set old_theta_ "";
122 }
123
124 if {$old_theta_ != $angle} {
125 set w [$in_frame set w_];
126 set h [$in_frame set h_];
127
128 set cos_angle [expr cos($angle)];
129 set sin_angle [expr sin($angle)];
130
131 set in_h_sub [expr 1.0*[$in_frame set h_subsample_]]
132 set in_v_sub [expr 1.0*[$in_frame set v_subsample_]]
133 set out_h_sub [expr 1.0*[$out_frame set h_subsample_]]
134 set out_v_sub [expr 1.0*[$out_frame set v_subsample_]]
135
136 set sf [expr 1.0 - ($angle/10.0)];
137
138 set la [expr $sf * $cos_angle];
139 set lb [expr -($sf * $sin_angle)];
140 set lc [expr ($w - ($sf * $w * $cos_angle) + ($sf * $h * $sin_angle)) / 2.0];
141 set ld [expr $sf * $sin_angle];
142 set le [expr $sf * $cos_angle];
143 set lf [expr ($h - ($h * $sf * $cos_angle) - ($sf * $w * $sin_angle)) / 2.0];
144
145 set ca [expr $la * $in_h_sub / $out_h_sub];
146 set cb [expr $lb * $in_v_sub / $out_h_sub];
147 set cc [expr $lc / $out_h_sub];
148 set cd [expr $ld * $in_h_sub / $out_v_sub];
149 set ce [expr $le * $in_v_sub / $out_v_sub];
150 set cf [expr $lf / $out_v_sub];
151
152 set old_theta_ $angle;
153 }
154
155 set in_l [$in_frame get_lum_name];
156 set in_cr [$in_frame get_cr_name];
157 set in_cb [$in_frame get_cb_name];
158
159 set out_l [$out_frame get_lum_name];
160 set out_cr [$out_frame get_cr_name];
161 set out_cb [$out_frame get_cb_name];
162
163 byte_set $out_l 0
164 byte_set $out_cr 128
165 byte_set $out_cb 128
166
167 byte_affine $in_l $out_l $la $lb $lc $ld $le $lf;
168 byte_affine $in_cr $out_cr $ca $cb $cc $cd $ce $cf;
169 byte_affine $in_cb $out_cb $ca $cb $cc $cd $ce $cf;
170
171 $out_frame set ts_ [$in_frame set ts_];
172
173 set encoder $output_info_(o1,encoder);
174
175 if {$encoder != ""} {
176 $encoder recv $out_frame;
177 }
178
179 $self send_completion_token
180
181 [[[[$input_info_(i1,decoder) set agent_] set network_] set net_(0)] set dn_] recv_flush
182 }
183
184
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.