1 # fx_client.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1999-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 proc fx_create {effect_type} {
32 set cntrl_handle [new FX_Client $effect_type];
33 return $cntrl_handle
34 }
35
36 proc fx_destroy ch {
37 delete $ch;
38 }
39
40 proc fx_set_input_callback {ch cb} {
41 $ch set_input_callback $cb;
42 }
43
44 proc fx_set_output_callback {ch cb} {
45 $ch set_output_callback $cb;
46 }
47
48 proc fx_set_parameter_callback {ch cb} {
49 $ch set_parameter_callback $cb;
50 }
51
52 proc fx_get_parameter_type {ch pname} {
53 return [$ch get_parameter_type $pname];
54 }
55
56 proc fx_get_parameter_domain {ch pname} {
57 return [$ch get_parameter_domain $pname];
58 }
59
60 proc fx_set_input_spec {ch iname spec} {
61 $ch set_input_spec $iname $spec
62 }
63
64 proc fx_set_output_spec {ch oname spec} {
65 $ch set_output_spec $oname $spec
66 }
67
68 proc fx_set_parameter_value {ch pname value} {
69 $ch set_parameter_value $pname $value
70 }
71
72 proc fx_status {ch {action ""}} {
73 if {$action == ""} {
74 return [$ch get_status];
75 } else {
76 return [$ch set_status $action]
77 }
78 }
79
80 ################################################
81
82 Class FX_Client
83
84 FX_Client instproc init {effect_type {num_nodes 4} {cntrl_spec ""}} {
85 $self instvar effect_type_ al_ num_nodes_ cntrl_spec_
86
87 set effect_type_ $effect_type;
88 set num_nodes_ $num_nodes;
89
90 if {$cntrl_spec != ""} {
91 set cntrl_spec_ $cntrl_spec;
92 } else {
93 set rnum_a [expr int(rand()*253)+1];
94 set rnum_b [expr int(rand()*253)+1];
95 set rnum_c [expr (int(rand()*5000)*2)+10000];
96
97 set cntrl_spec_ "224.3.${rnum_a}.${rnum_b}/${rnum_c}/16"
98 }
99
100 set as_spec [$self get_option megactrl];
101 if {$as_spec == ""} {
102 set as_spec 224.4.5.24/50000/16
103 }
104 set as_bw [$self get_option megabw];
105 if {$as_bw == ""} {
106 set as_bw 20000
107 }
108 set fx_service_location [$self get_option fx_service_location]
109 if {$fx_service_location == ""} {
110 set fx_service_location "http://www.cs.berkeley.edu/~kpatel/front_end"
111 }
112
113 set al_ [new AnnounceListenManager/AS/Client/FXClient $self $as_spec $as_bw $fx_service_location];
114
115 $al_ start
116
117 $self instvar input_callback_ output_callback_ parameter_callback_
118 set input_callback_ ""
119 set output_callback_ ""
120 set parameter_callback_ ""
121
122 $self instvar comm_obj_
123
124 set comm_obj_ [new GraphComm/FXClient $self [$al_ agent_instance] $cntrl_spec_]
125
126 $self instvar status_
127
128 set status_ "off"
129 }
130
131 FX_Client instproc set_primary_trigger {iname} {
132 $self instvar primary_trigger_inputs_ status_
133
134 set primary_trigger_inputs_ $iname;
135
136 if {$status_ == "on"} {
137 set auto_val 1;
138 } elseif {$status_ == "off"} {
139 set auto_val 0;
140 }
141
142 $self instvar comm_obj_
143
144 if {[info exists primary_trigger_inputs_]} {
145 $comm_obj_ create_input $primary_trigger_inputs_
146 $comm_obj_ create_input_attr $primary_trigger_inputs_ trigger
147 $comm_obj_ set_input_attr $primary_trigger_inputs_ trigger [list auto $auto_val]
148 }
149 }
150
151 FX_Client instproc get_status {} {
152 $self instvar status_
153
154 return $status_
155 }
156
157 FX_Client instproc set_status {new_status} {
158 $self instvar status_;
159
160 if {$status_ == $new_status} {
161 return;
162 }
163
164 set status_ $new_status
165
166 if {$status_ == "on"} {
167 set auto_val 1
168 } else {
169 set auto_val 0
170 }
171
172 $self instvar comm_obj_ primary_trigger_inputs_
173
174 if {[info exists primary_trigger_inputs_]} {
175 $comm_obj_ create_input $primary_trigger_inputs_
176 $comm_obj_ create_input_attr $primary_trigger_inputs_ trigger
177 $comm_obj_ set_input_attr $primary_trigger_inputs_ trigger [list auto $auto_val]
178 }
179 }
180
181 FX_Client instproc destroy {args} {
182 $self instvar al_;
183
184 delete $al_;
185
186 $self instvar comm_obj_;
187
188 delete $comm_obj_;
189
190 $self next;
191 }
192
193 FX_Client instproc set_input_callback {cb} {
194 $self instvar input_callback_;
195
196 set input_callback_ $cb;
197
198 if {$input_callback_ != ""} {
199 $self instvar comm_obj_;
200
201 foreach in [$comm_obj_ set input_names_] {
202 eval $input_callback_ $in
203 }
204 }
205 }
206
207 FX_Client instproc set_output_callback {cb} {
208 $self instvar output_callback_;
209
210 set output_callback_ $cb;
211
212 if {$output_callback_ != ""} {
213 $self instvar comm_obj_;
214
215 foreach out [$comm_obj_ set output_names_] {
216 eval $output_callback_ $out
217 }
218 }
219 }
220
221 FX_Client instproc set_parameter_callback {cb} {
222 $self instvar parameter_callback_;
223
224 set parameter_callback_ $cb;
225
226 if {$parameter_callback_ != ""} {
227 $self instvar comm_obj_;
228
229 catch "$comm_obj_ unset param_callback_done_"
230
231 foreach p [$comm_obj_ set parameter_names_] {
232 if {[$comm_obj_ parameter_attr_has_value $p "type"]} {
233 if {[$comm_obj_ parameter_attr_has_value $p "domain"]} {
234 $comm_obj_ set param_callback_done_($p) 1
235 eval $parameter_callback_ $p
236 }
237 }
238 }
239 }
240 }
241
242 FX_Client instproc get_parameter_type {pname} {
243 $self instvar comm_obj_;
244
245 return [$comm_obj_ get_parameter_attr_value $pname "type"]
246 }
247
248 FX_Client instproc get_parameter_domain {pname} {
249 $self instvar comm_obj_;
250
251 return [$comm_obj_ get_parameter_attr_value $pname "domain"]
252 }
253
254 FX_Client instproc set_input_spec {iname spec} {
255 $self instvar comm_obj_;
256
257 if {[lsearch [$comm_obj_ set input_names_] $iname] == -1} {
258 error "Trying to set spec for non-existant input $iname"
259 }
260
261 $comm_obj_ create_input $iname
262 $comm_obj_ create_input_attr $iname spec
263 $comm_obj_ set_input_attr $iname spec $spec
264 }
265
266 FX_Client instproc set_output_spec {oname spec} {
267 $self instvar comm_obj_;
268
269 if {[lsearch [$comm_obj_ set output_names_] $oname] == -1} {
270 error "Trying to set spec for non-existant output $oname"
271 }
272
273 $comm_obj_ create_output $oname
274 $comm_obj_ create_output_attr $oname spec
275 $comm_obj_ set_output_attr $oname spec $spec
276 }
277
278 FX_Client instproc set_parameter_value {pname value} {
279 $self instvar comm_obj_
280
281 if {[lsearch [$comm_obj_ set parameter_names_] $pname] == -1} {
282 error "Trying to set value for non-existant parameter $pname"
283 }
284
285 $comm_obj_ create_parameter $pname
286 $comm_obj_ create_parameter_attr $pname value
287 $comm_obj_ set_parameter_attr $pname value $value
288 }
289
290
291
292 ##################################################
293
294 import AnnounceListenManager/AS/Client
295
296 Class AnnounceListenManager/AS/Client/FXClient -superclass AnnounceListenManager/AS/Client
297
298 AnnounceListenManager/AS/Client/FXClient instproc init {agent args} {
299 $self instvar serv_inst_ agent_;
300
301 eval $self next $args
302
303 set rnum [expr int(rand() * 10000)];
304
305 set serv_inst_ "fx_$rnum";
306
307 set agent_ $agent;
308 }
309
310 AnnounceListenManager/AS/Client/FXClient instproc destroy {} {
311 $self announce_death
312
313 $self next
314 }
315
316 AnnounceListenManager/AS/Client/FXClient instproc service_name {} {
317 return FXForwardFrontEnd
318 }
319
320 AnnounceListenManager/AS/Client/FXClient instproc service_instance {} {
321 $self instvar serv_inst_;
322
323 return $serv_inst_;
324 }
325
326 AnnounceListenManager/AS/Client/FXClient instproc agent_instance {} {
327 return "${self}[pid]@[lookup_host_name [localaddr]]"
328 }
329
330 AnnounceListenManager/AS/Client/FXClient instproc agent_data {} {
331 $self instvar agent_
332
333 return "-subprogram [$agent_ set effect_type_] -num_nodes [$agent_ set num_nodes_] -cntrl_spec [$agent_ set cntrl_spec_]";
334 }
335
336 AnnounceListenManager/AS/Client/FXClient instproc register {args} {
337 }
338
339 AnnounceListenManager/AS/Client/FXClient instproc unregister {args} {
340 }
341
342 ##################################################
343
344 import GraphComm;
345
346 Class GraphComm/FXClient -superclass GraphComm
347
348 GraphComm/FXClient instproc init {agent src_id cntrl_spec} {
349 $self instvar agent_
350
351 set agent_ $agent;
352
353 set cntrl_spec [split $cntrl_spec "/"]
354
355 $self next $src_id [lindex $cntrl_spec 0] [lindex $cntrl_spec 1] [lindex $cntrl_spec 2];
356
357 }
358
359 GraphComm/FXClient instproc new_input {new_name} {
360 $self next $new_name;
361
362 $self instvar agent_;
363
364 if {[$agent_ set input_callback_] != ""} {
365 eval [$agent_ set input_callback_] $new_name
366 }
367 }
368
369 GraphComm/FXClient instproc new_output {new_name} {
370 $self next $new_name;
371
372 $self instvar agent_;
373
374 if {[$agent_ set output_callback_] != ""} {
375 eval [$agent_ set output_callback_] $new_name
376 }
377 }
378
379 GraphComm/FXClient instproc new_input_attribute {iname aname} {
380 $self next $iname $aname
381
382 if {$aname == "primary_trigger"} {
383 $self instvar agent_;
384
385 $agent_ set_primary_trigger $iname;
386 }
387 }
388
389 GraphComm/FXClient instproc update_parameter_attr_value {pname aname val} {
390 $self next $pname $aname $val;
391
392 $self instvar param_callback_done_
393
394 if {![info exists param_callback_done_($pname)]} {
395 if {[$self parameter_attr_has_value $pname "type"]} {
396 if {[$self parameter_attr_has_value $pname "domain"]} {
397
398 $self instvar agent_;
399
400
401 if {[$agent_ set parameter_callback_] != ""} {
402 set param_callback_done_($pname) 1
403 eval [$agent_ set parameter_callback_] $pname
404 }
405 }
406 }
407 }
408 }
409
410
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.