~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/psvp/dali-subprogram.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # dali-subprogram.tcl --
  2 #
  3 #       This file contains the Dali subprogram base class.
  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 # The DaliSubprogram object responds to graph interface communication
 32 # recieved through its recv_graph_comm method and
 33 # sends graph interface communication through the send_graph_comm
 34 # method.
 35 
 36 # Object fields
 37 #
 38 #   input_id_list_    : list of input ids
 39 #   output_id_list_   : list of output ids
 40 #   input_info_       : array of info on input_ids. For each input id $i,
 41 #         ($i,spec)       : multicast spec for input data
 42 #         ($i,trigger)    : 0/1 indicating if input is execution trigger
 43 #         ($i,buffertype) : indicates what type of buffer this Dali subprogram
 44 #                           expects the input to be dumped into
 45 #         ($i,buffername) : indicates the name of the buffer object of the
 46 #                           type indicated above
 47 #         ($i,decoder)    : decoder object for input
 48 #   output_id_list_ of output ids
 49 #   output_info_      : array of info on output_ids. For each output id $o,
 50 #         ($o,spec)      : multicast spec of where output goes
 51 #         ($o,buffertype): indicates type of above buffer
 52 #         ($o,encoder)   : name of encoder object.
 53 #         ($o,format)    : format of output
 54 #         ($o,vagent)    : name of video agent used as a transmitter
 55 #         ($o,bp)        : name of buffer pool
 56 #   parameter_id_list_: list of parameter ids
 57 #   parameter_info_   : array on info on parameters. For each parameter $p,
 58 #         ($p,oname)     : name of parameter object.
 59 #   vagent_array_        : array associated by "addr,port" indexes that holds
 60 #                          the name of video agents used by this object.
 61 #   tvector_             : list of pairs (id,ts) indicating that trigger is
 62 #                          waiting for frame with timestamp ts to appear on
 63 #                          on id.
 64 
 65 # Object methods
 66 #   init : initialization
 67 #   recv_graph_comm : handles incoming graph interface communication
 68 #   send_graph_comm : handles outgoing graph interface communication
 69 #   set_input_spec : handles changes to input spec
 70 #   set_output_spec : handles changes to output spec
 71 #   set_output_format : handles changes to output format
 72 #   trigger : executes Dali code to produce 1 frame of output
 73 #   set_output_geometry : handles changes to output geometry
 74 
 75 import PsvpVideoAgent
 76 import GraphComm
 77 
 78 Class DaliSubprogram
 79 
 80 DaliSubprogram instproc init {id control_spec} {
 81     $self next
 82 
 83     $self instvar input_id_list_;
 84     $self instvar input_info_;
 85     $self instvar output_id_list_;
 86     $self instvar output_info_;
 87     $self instvar parameter_id_list_;
 88     $self instvar parameter_info_;
 89     $self instvar vagent_array_;
 90     $self instvar comm_obj_;
 91     $self instvar id_;
 92 
 93     set input_id_list_ "";
 94     set output_id_list_ "";
 95     set parameter_id_list_ "";
 96 
 97     set id_ $id;
 98 
 99     set control_spec [split $control_spec "/"];
100     set ctrl_addr [lindex $control_spec 0];
101     set ctrl_port [lindex $control_spec 1];
102     set ctrl_ttl [lindex $control_spec 2];
103 
104     set comm_obj_ [new GraphComm/DaliSubprogram $self $id_ $ctrl_addr $ctrl_port $ctrl_ttl];
105 }
106 
107 
108 DaliSubprogram instproc send_debug_mesg {mesg} {
109     $self instvar comm_obj_;
110 
111     $comm_obj_ send_debug $mesg
112 }
113 
114 DaliSubprogram instproc send_completion_token {} {
115     $self instvar comm_obj_;
116 
117     $comm_obj_ send_trigger_command "trigger_completion_token";
118 }
119 
120 DaliSubprogram instproc set_input_spec {id spec} {
121     $self instvar input_info_
122     $self instvar vagent_array_;
123 
124     # If alread set properly, ignore.
125 
126     if {$input_info_($id,spec) == $spec} {
127         return;
128     }
129 
130     # If input already associated with a spec, delete
131     # decoder no longer needed.
132 
133     if {$input_info_($id,spec) != ""} {
134         set decoder $input_info_($id,decoder);
135         if {$decoder != ""} {
136 
137             # Redefine src's trigger_sr proc to do nothing
138 
139             set src [$decoder set src_];
140             $src proc trigger_sr {args} {};
141 
142             # Use video agent to delete decoder
143 
144             set vagent [$decoder set agent_];
145             $vagent delete_decoder $decoder;
146             set input_info_($id,decoder) "";
147         }
148         set input_info_($id,spec) "";
149     }
150 
151     set spec_split [split $spec "/"];
152 
153     set addr [lindex $spec_split 0];
154     set port [lindex $spec_split 1];
155     set srcid [lindex $spec_split 2];
156 
157     # Find video agent handling this addr/port creating
158     # one if none exists.
159 
160     if {![info exists vagent_array_($addr,$port)]} {
161         set vagent_array_($addr,$port) [new PsvpVideoAgent $addr/$port];
162     }
163     set vagent $vagent_array_($addr,$port);
164 
165     # Retrieve source associated with target srcid
166 
167     set src [$vagent get_source_by_id $srcid];
168 
169     # If no source yet, establish callback with video
170     # agent for when source does appear
171 
172     if {$src == ""} {
173         $vagent set_create_decoder_callback $srcid "$self set_input_spec_cb $id $spec";
174     } else {
175 
176         # Create appropriate decoder for input source format and
177         # target buffer type.
178 
179         set fmt_name [$vagent classmap [$src format_name]];
180 
181         set btype $input_info_($id,buffertype);
182 
183         set bname $input_info_($id,buffername);
184 
185         set decoder [new Module/VideoDecoder/${fmt_name}To${btype}];
186 
187         if {$decoder == ""} {
188             # No such decoder. Create a NULL decoder and associate that.
189             set decoder [new Module/VideoDecoder/Null];
190         } else {
191             $decoder set_frame_buffer $bname;
192             if {$input_info_($id,trigger) != 0} {
193                 $decoder set_callback "$self trigger";
194             }
195         }
196 
197         # Instruct video agent to set up decoder as target for source
198 
199         $vagent set_src_decoder $src $decoder;
200 
201         # Update input info array
202 
203         set input_info_($id,decoder) $decoder;
204 
205         # Remap sources trigger_sr to call ours with correct associated id
206         $src proc trigger_sr {args} "$self trigger_sr $src $id";
207 
208     }
209     set input_info_($id,spec) $spec;
210 }
211 
212 DaliSubprogram instproc set_input_spec_cb {id spec src} {
213     $self instvar input_info_
214     $self instvar vagent_array_
215 
216     # Check to make sure spec is still good.
217 
218     if {$input_info_($id,spec) != $spec} {
219         puts "$input_info_($id,spec) != $spec !!!";
220         return;
221     }
222 
223     if {$input_info_($id,decoder) != ""} {
224         puts "$input_info_($id,decoder) != {} !!!";
225         return;
226     }
227 
228     # Find videoagent and source
229 
230     set spec_split [split $spec "/"];
231 
232     set addr [lindex $spec_split 0];
233     set port [lindex $spec_split 1];
234     set srcid [lindex $spec_split 2];
235 
236     set vagent $vagent_array_($addr,$port);
237 
238     # Setup decoder.
239 
240     set fmt_name [$vagent classmap [$src format_name]];
241 
242     set btype $input_info_($id,buffertype);
243 
244     set bname $input_info_($id,buffername);
245 
246     set decoder [new Module/VideoDecoder/${fmt_name}To${btype}];
247 
248     if {$decoder == ""} {
249         # No such decoder. Create a NULL decoder and associate that.
250         set decoder [new Module/VideoDecoder/Null];
251     } else {
252         $decoder set_frame_buffer $bname;
253         if {$input_info_($id,trigger) != 0} {
254             $decoder set_callback "$self trigger";
255         }
256     }
257 
258     # Update input info array
259 
260     set input_info_($id,decoder) $decoder;
261 
262     # Remap sources trigger_sr to call ours with correct associated id
263     $src proc trigger_sr {args} "$self trigger_sr $src $id";
264 
265     return $decoder;
266 }
267 
268 DaliSubprogram instproc set_output_spec {id spec} {
269     $self instvar output_info_
270     $self instvar vagent_array_
271 
272     # If already set properly, ignore.
273 
274     if {$output_info_($id,spec) == $spec} {
275         return;
276     }
277 
278     # If out spec already set, unset it.
279 
280     if {$output_info_($id,spec) != ""} {
281         set encoder $output_info_($id,encoder);
282         if {$encoder != ""} {
283             delete $encoder;
284         }
285         set bp $output_info_($id,bp);
286         if {$bp != ""} {
287             delete $bp;
288         }
289         set output_info_($id,encoder) "";
290         set output_info_($id,spec) "";
291         set output_info_($id,vagent) "";
292         set output_info_($id,bp) "";
293     }
294 
295     # Find video agent for addr/port
296 
297     set spec_split [split $spec "/"];
298 
299     set addr [lindex $spec_split 0];
300     set port [lindex $spec_split 1];
301 
302     if {![info exists vagent_array_($addr,$port)]} {
303         set vagent_array_($addr,$port) [new PsvpVideoAgent $addr/$port];
304         [$vagent_array_($addr,$port) get_transmitter] set loopback_ 0;
305     }
306     set vagent $vagent_array_($addr,$port);
307 
308     # Create encoder for buffertype and target format
309 
310     set format $output_info_($id,format);
311     set btype $output_info_($id,buffertype);
312 
313     set encoder [new Module/VideoEncoder/${btype}To${format}];
314 
315     # Set video agent transmitter as encoder target
316 
317     set bp "";
318 
319     if {$encoder != ""} {
320         set ssrc [$vagent get_local_srcid];
321         set bp [new BufferPool/RTP];
322         $bp srcid $ssrc;
323 
324         $encoder buffer-pool $bp;
325         $encoder mtu [$self get_option mtu];
326 
327         global kpatel_debug;
328 
329         if {[info exists kpatel_debug]} {
330             set logger [new Module/RTPPktLogger];
331             $logger target [$vagent get_transmitter];
332             $encoder target $logger;
333         } else {
334             $encoder target [$vagent get_transmitter];
335         }
336 
337         # Total hack FIXME
338         $vagent local_bandwidth 30000000
339     }
340 
341     # Update variables
342 
343     set output_info_($id,spec) $spec;
344     set output_info_($id,encoder) $encoder;
345     set output_info_($id,vagent) $vagent;
346     set output_info_($id,bp) $bp;
347 }
348 
349 DaliSubprogram instproc set_output_format {id format} {
350     $self instvar output_info_
351 
352     if {$output_info_($id,format) == $format} {
353         return;
354     }
355 
356     set output_info_($id,format) $format;
357 
358     if {$output_info_($id,spec) == ""} {
359         return;
360     }
361 
362     if {$output_info_($id,encoder) != ""} {
363         delete $output_info_($id,encoder);
364     }
365     set output_info_($id,encoder) "";
366 
367     if {$output_info_($id,bp) != ""} {
368         delete $output_info_($id,bp);
369     }
370     set output_info_($id,bp) "";
371 
372     set btype $output_info_($id,buffertype);
373 
374     set encoder [new Module/VideoEncoder/${btype}To${format}];
375     set bp "";
376 
377     if {$encoder != ""} {
378         set ssrc [$output_info_($id,vagent) get_local_srcid];
379         set bp [new BufferPool/RTP];
380         $bp srcid $ssrc;
381 
382         $encoder buffer-pool $bp;
383         $encoder mtu [$self get_option mtu];
384         $encoder target [$output_info_($id,vagent) get_transmitter]
385 
386         # Total hack FIXME
387         $vagent local_bandwidth 30000000
388     }
389 
390     set output_info_($id,encoder) $encoder;
391     set output_info_($id,bp) $bp;
392 
393 }
394 
395 DaliSubprogram instproc trigger_vector {vector} {
396     $self instvar id_;
397     $self instvar tvector_ input_info_ input_id_list_;
398     $self instvar tvector_queue_;
399 
400     #    puts "$id_ :: $vector";
401 
402     if {[info exists tvector_]} {
403         # Got called while already processing a trigger
404         # vector. For now, send debug message and do
405         # nothing.
406 
407 #       $self send_debug_mesg "Trigger_vector queued";
408 #       lappend tvector_queue_ $vector;
409 
410         # Got called while already processing a trigger
411         # vector. Save this one in a queue to process
412         # when done. Currently, q length is just one (i.e.,
413         # save most recent.)
414 
415         set tvector_queue_ [list $vector];
416 
417         return;
418     }
419 
420     set tvector_ "";
421 
422     foreach entry $vector {
423         set id [lindex $entry 0];
424         set ts [lindex $entry 1];
425 
426         set cur_ts [$input_info_($id,buffername) set ts_];
427         if {$cur_ts > $ts} {
428             # Missed
429             foreach id $input_id_list_ {
430                 if {$input_info_($id,decoder) != "" } {
431                     $input_info_($id,decoder) set_callback "";
432                     $input_info_($id,decoder) delay_off;
433                 }
434             }
435             unset tvector_;
436             $self send_debug_mesg "Missed timestamp for input $id";
437             $self check_tvector_queue
438             return;
439         } elseif {$cur_ts == $ts} {
440             # Right on, set delay.
441             if {$input_info_($id,decoder) != "" } {
442                 $input_info_($id,decoder) delay_on;
443             }
444         } else {
445             # Waiting.
446             if {$input_info_($id,decoder) == ""} {
447                 # Big problem!!!
448                 foreach id $input_id_list_ {
449                     if {$input_info_($id,decoder) != "" } {
450                         $input_info_($id,decoder) set_callback "";
451                         $input_info_($id,decoder) delay_off;
452                     }
453                 }
454                 $self send_debug_mesg "No decoder for input $id";
455                 unset tvector_;
456                 $self check_tvector_queue
457                 return;
458             } else {
459                 # Set callback
460                 $input_info_($id,decoder) set_callback "$self check_vector $id $ts";
461                 lappend tvector_ [list $id $ts];
462             }
463         }
464     }
465     if {$tvector_ == ""} {
466         # Ready to go.
467         $self trigger;
468         foreach id $input_id_list_ {
469             if {$input_info_($id,decoder) != "" } {
470                 $input_info_($id,decoder) set_callback "";
471                 $input_info_($id,decoder) delay_off;
472             }
473         }
474         unset tvector_;
475         $self check_tvector_queue
476     }
477 }
478 
479 DaliSubprogram instproc check_tvector_queue {} {
480     $self instvar tvector_queue_;
481 
482     if {[info exists tvector_queue_]} {
483         if {[llength $tvector_queue_] == 0} {
484             unset tvector_queue_;
485         } else {
486             set next_tvector [lindex $tvector_queue_ 0];
487             set tvector_queue_ [lrange $tvector_queue_ 1 end];
488             $self send_debug_mesg "Processing trigger vector from queue";
489             $self trigger_vector $next_tvector;
490             return;
491         }
492     }
493 }
494 
495 DaliSubprogram instproc check_vector {id ts} {
496     $self instvar input_info_ tvector_ input_id_list_
497 
498     set cur_ts [$input_info_($id,buffername) set ts_];
499 
500     if {$cur_ts > $ts} {
501         # Missed
502         foreach id $input_id_list_ {
503             if {$input_info_($id,decoder) != "" } {
504                 $input_info_($id,decoder) set_callback "";
505                 $input_info_($id,decoder) delay_off;
506             }
507         }
508         unset tvector_;
509         $self send_debug_mesg "Check vector missed on input $id";
510         $self check_tvector_queue;
511         return;
512 
513     } elseif {$cur_ts == $ts} {
514         # Right on
515         set new_tvector "";
516         foreach entry $tvector_ {
517             set eid [lindex $entry 0];
518             if {$eid != $id} {
519                 lappend new_tvector $entry;
520             }
521         }
522         set tvector_ $new_tvector;
523 
524         $input_info_($id,decoder) set_callback "";
525         $input_info_($id,decoder) delay_on;
526 
527         if {$tvector_ == ""} {
528             # Ready to go.
529             $self trigger;
530             foreach id $input_id_list_ {
531                 if {$input_info_($id,decoder) != "" } {
532                     $input_info_($id,decoder) set_callback "";
533                     $input_info_($id,decoder) delay_off;
534                 }
535             }
536             unset tvector_;
537             $self check_tvector_queue;
538         }
539     }
540 }
541 
542 DaliSubprogram instproc rated_trigger {in_id} {
543     $self instvar input_info_;
544 
545     set period $input_info_($in_id,rate_trigger_period);
546     set offset $input_info_($in_id,rate_trigger_offset);
547 
548     set bname $input_info_($in_id,buffername);
549 
550     set ts [expr [$bname set ts_]];
551 
552     # No unsigned ints in Tcl, so must be very careful here.
553 
554     if {$offset == 0} {
555         # Offset has been reset since last time
556 #       puts "Offset reset, ts = $ts";
557 
558         $self trigger;
559         if {$ts < 0} {
560             set input_info_($in_id,rate_trigger_offset) [expr int($ts / $period) * $period];
561         } else {
562             set input_info_($in_id,rate_trigger_offset) [expr (int($ts / $period)+1) * $period];
563         }
564     } elseif {$ts > $offset} {
565 #       puts "$ts ([expr $ts]) > $offset";
566         $self trigger;
567         set input_info_($in_id,rate_trigger_offset) [expr (int(($ts - $offset) / $period) + 1) * $period + $offset];
568     } else {
569 #       puts "$ts ([expr $ts]) < $offset";
570     }
571 }
572 
573 
574 DaliSubprogram instproc trigger {} {
575     puts "No default trigger action";
576 }
577 
578 DaliSubprogram instproc set_output_geometry {out_id geometry} {
579     puts "No default output geometry action";
580 }
581 
582 DaliSubprogram instproc set_ntp_reference {in_id out_id} {
583     $self instvar output_info_;
584 
585     set output_info_($out_id,synch_master) $in_id;
586 }
587 
588 DaliSubprogram instproc trigger_sr {src in_id} {
589     $self instvar output_info_ output_id_list_;
590 
591     foreach o $output_id_list_ {
592         if {[info exists output_info_($o,synch_master)]} {
593             if {$output_info_($o,synch_master) == $in_id} {
594                 catch {
595                     set in_layer [lindex [$src set layers_] 0];
596                     set out_layer [lindex [[$output_info_($o,vagent) set local_] set layers_] 0];
597                     $out_layer set ref_mts_ [$in_layer set mts_];
598                     $out_layer set ref_ntp_sec_ [$in_layer set ntp_ts_sec_];
599                     $out_layer set ref_ntp_fsec_ [$in_layer set ntp_ts_fsec_];
600                 }
601             }
602         }
603     }
604 }
605 
606 Class GraphComm/DaliSubprogram -superclass GraphComm;
607 
608 GraphComm/DaliSubprogram instproc init {subprog args} {
609     eval $self next $args
610 
611     $self instvar subprog_;
612 
613     set subprog_ $subprog;
614 }
615 
616 GraphComm/DaliSubprogram instproc update_input_attr_value {in_id attr_name attr_value} {
617     $self instvar subprog_;
618 
619     $self next $in_id $attr_name $attr_value;
620 
621     switch -exact -- $attr_name {
622         spec {
623             $subprog_ instvar input_id_list_;
624 
625             if {[lsearch $input_id_list_ $in_id] != -1} {
626                 $subprog_ set_input_spec $in_id $attr_value;
627             }
628         }
629         trigger {
630             $subprog_ instvar input_id_list_ input_info_;
631 
632             if {[lsearch $input_id_list_ $in_id] != -1} {
633                 switch -exact -- [lindex $attr_value 0] {
634                     auto {
635                         set trigger_flag [lindex $attr_value 1];
636                         set input_info_($in_id,trigger) $trigger_flag;
637 
638                         if {$input_info_($in_id,decoder) != ""} {
639                             if {$input_info_($in_id,trigger) != 0} {
640                                 $input_info_($in_id,decoder) set_callback "$subprog_ trigger";
641                             } else {
642                                 $input_info_($in_id,decoder) set_callback "";
643                             }
644                         }
645                     }
646                     rate_limited {
647                         set trigger_flag [lindex $attr_value 1];
648                         if {$trigger_flag == 1} {
649                             set trigger_offset [lindex $attr_value 2];
650                             set trigger_period [lindex $attr_value 3];
651                         } else {
652                             set trigger_offset 0;
653                             set trigger_period 0;
654                         }
655 
656                         if {$trigger_offset != ""} {
657                             # Reset offset
658                             set input_info_($in_id,rate_trigger_offset) $trigger_offset;
659                         }
660                         set input_info_($in_id,rate_trigger_period) $trigger_period;
661 
662                         set input_info_($in_id,trigger) $trigger_flag;
663 
664                         if {$input_info_($in_id,decoder) != ""} {
665                             if {$input_info_($in_id,trigger) != 0} {
666                                 $input_info_($in_id,decoder) set_callback "$subprog_ rated_trigger $in_id";
667                             } else {
668                                 $input_info_($in_id,decoder) set_callback "";
669                             }
670                         }
671                     }
672                 }
673             }
674         }
675     }
676 }
677 
678 GraphComm/DaliSubprogram instproc update_output_attr_value {out_id attr_name attr_value} {
679     $self instvar subprog_;
680 
681     $self next $out_id $attr_name $attr_value;
682 
683     $subprog_ instvar output_id_list_ output_info_;
684 
685     if {[lsearch $output_id_list_ $out_id] == -1} {
686         return;
687     }
688 
689     switch -exact -- $attr_name {
690         spec {
691             $subprog_ set_output_spec $out_id $attr_value;
692         }
693         format {
694             $subprog_ set_output_format $out_id $attr_value;
695         }
696         geometry {
697             $subprog_ set_output_geometry $out_id $attr_value;
698         }
699     }
700 }
701 
702 GraphComm/DaliSubprogram instproc recv_trigger_command {cmd} {
703     $self instvar subprog_;
704 
705     set cmd_type [lindex $cmd 0];
706 
707     switch -exact -- $cmd_type {
708         trigger {
709             $subprog_ trigger;
710         }
711         trigger_vector {
712             set vector [lindex $cmd 1];
713             $subprog_ trigger_vector $vector;
714         }
715     }
716 }
717 
718 GraphComm/DaliSubprogram instproc update_parameter_attr_value {param_id attr_name attr_value} {
719 
720     $self instvar subprog_;
721 
722     $self next $param_id $attr_name $attr_value;
723 
724     $subprog_ instvar parameter_id_list_ parameter_info_;
725 
726     if {[lsearch $parameter_id_list_ $param_id] == -1} {
727         return;
728     }
729 
730     switch -exact -- $attr_name {
731         value {
732             set pobj $parameter_info_($param_id,oname);
733             if {[$pobj get] != $attr_value} {
734                 $pobj set $attr_value;
735             }
736         }
737     }
738 }
739 
740 GraphComm/DaliSubprogram instproc setup {} {
741     $self instvar subprog_;
742 
743     $subprog_ instvar input_id_list_;
744 
745     foreach i $input_id_list_ {
746         $subprog_ instvar input_info_
747 
748         $self create_input $i;
749 
750         if {[info exists input_info_($i,primary_trigger)]} {
751             $self create_input_attr $i "primary_trigger"
752         }
753     }
754 
755     $subprog_ instvar output_id_list_;
756 
757     foreach o $output_id_list_ {
758         $self create_output $o;
759     }
760 
761     $subprog_ instvar parameter_id_list_
762     $subprog_ instvar parameter_info_;
763 
764     foreach p $parameter_id_list_ {
765         $self create_parameter $p;
766 
767         set pobj $parameter_info_($p,oname);
768 
769         $self create_parameter_attr $p type
770         $self create_parameter_attr $p domain
771         $self create_parameter_attr $p value
772 
773         $self set_parameter_attr $p type [$pobj type];
774         $self set_parameter_attr $p domain [$pobj domain];
775     }
776 }
777 
778 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.