Open Mash Cross Reference
mash/tcl/psvp/temporal-interleaver.tcl

   # temporal-interleaver.tcl --
   #
   #       This file contains the TemporalInterleavor class
   #
   # Copyright (c) 1998-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
   # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  # The TemporalInterleavor object responds to graph interface communication
  # recieved through its recv_graph_comm method and sends graph
  # interface communication throught the send_graph_comm method.
  
  # Object fields
  #
  # output_id_list_ : list of output ids. The same ids are expected to be
  #                   used by individual execution subgraphs
  # output_info_ : array of info on output_ids. For each output id $o,
  #       ($o,spec) : multicast spec for where interleaved output data should
  #                   go.
  #       ($o,inter_obj) : interleaver object for incoming streams for this
  #                        output id
  #       ($o,vagent) : video agent for incoming streams for this output id
  #       ($o,in_spec) : spec for incoming streams for this output id
  #       ($o,out_vagent) : video agent for outgoing stream for this output id
  # vagent_array_ : array associated by "addr,port" indexes that holds the
  #                 name of video agents used by this object.
  # subgraph_list_ : list of subgraph identifiers. These identifiers are local
  #                  only
  # subgraph_info_ : array of info on subgraphs. For each subgraph $s,
  #      ($s,comm_obj) : graph comm object for talking to this subgraph
  #      ($s,spec)     : spec of subgraph
  # id_ : id of this object to be used in graph communication
  # comm_obj_ : object for graph comm (from above, NOT to subgraphs)
  # callback_array_ : holds comm callbacks with index <comm_obj>,<mid>
  
  import PsvpVideoAgent
  import GraphComm
  
  Class TemporalInterleaver
  
  TemporalInterleaver instproc init {id control_spec} {
      $self next;
  
      $self instvar output_id_list_;
      $self instvar output_info_;
      $self instvar vagent_array_;
      $self instvar subgraph_list_;
      $self instvar subgraph_info_;
      $self instvar id_;
      $self instvar comm_obj_;
      $self instvar callback_array_;
      $self instvar sid_;
  
      set output_id_list_ "";
  
      set id_ $id;
  
      set control_spec [split $control_spec "/"];
      set addr [lindex $control_spec 0];
      set port [lindex $control_spec 1];
      set ttl [lindex $control_spec 2];
  
      set comm_obj_ [new GraphComm/TemporalInterleaver $self $id_ $addr $port $ttl];
      $comm_obj_ create_parameter "latency";
      $comm_obj_ create_parameter_attr "latency" type
      $comm_obj_ create_parameter_attr "latency" domain
      $comm_obj_ create_parameter_attr "latency" value
  
      $comm_obj_ set_parameter_attr "latency" type real
      $comm_obj_ set_parameter_attr "latency" domain "(0.0,1.0)"
      $comm_obj_ set_parameter_attr "latency" value 1.0
  
      set sid_ -1;
      set subgraph_list_ "";
  
      $self instvar latency_control_;
  
     set latency_control_ 1.0;
 }
 
 TemporalInterleaver instproc del_subgraph sid {
     $self instvar subgraph_info_ subgraph_list_;
 
     delete $subgraph_info_($sid,comm_obj);
 
     unset subgraph_info_($sid,comm_obj);
     unset subgraph_info_($sid,spec);
 
     set idx [lsearch $subgraph_list_ $sid];
     set subgraph_list_ [lreplace $subgraph_list_ $idx $idx];
 
     if {$subgraph_list_ == ""} {
         # All the subgraphs are gone.
         # FIXME Need to handle this case.
     }
 }
 
 TemporalInterleaver instproc add_subgraph spec {
     $self instvar sid_ subgraph_list_ subgraph_info_;
     $self instvar output_info_ output_id_list_ id_;
 
     foreach s $subgraph_list_ {
         if {$subgraph_info_($s,spec) == $spec} {
             return;
         }
     }
 
     incr sid_
 
     lappend subgraph_list_ $sid_;
 
     set subgraph_info_($sid_,comm_obj) [new GraphComm/TIToSubgraph $self $id_ $spec];
 
     set subgraph_info_($sid_,spec) $spec;
 
     foreach o $output_id_list_ {
         $subgraph_info_($sid_,comm_obj) set_output_spec $o $output_info_($o,in_spec);
     }
 }
 
 TemporalInterleaver instproc setup_output {oid} {
     $self instvar subgraph_list_;
     $self instvar subgraph_info_;
     $self instvar vagent_array_;
 
     $self instvar output_id_list_;
     $self instvar output_info_ comm_obj_
 
     if {[lsearch $output_id_list_ $oid] != -1} {
         return;
     }
 
     lappend output_id_list_ $oid;
 
     $comm_obj_ create_output $oid;
 
     set output_info_($oid,spec) "";
 
     set spec [$self GenerateSpec];
     set spec_split [split $spec "/"];
     set addr [lindex $spec_split 0];
     set port [lindex $spec_split 1];
 
     set output_info_($oid,inter_obj) [new Module/Combine/Temporal];
 
     $self instvar latency_control_;
     $output_info_($oid,inter_obj) large_factor $latency_control_;
     $output_info_($oid,inter_obj) small_factor [expr 1.0 - $latency_control_];
 
     set vagent_array_($addr,$port) [new TemporalInterleaverVideoAgent $addr/$port $output_info_($oid,inter_obj)];
 
     # Major hack to handle trigger_sr
 
     $vagent_array_($addr,$port) proc trigger_sr {src} "$self trigger_sr \$src $oid; \$self next \$src";
 
     set output_info_($oid,vagent) $vagent_array_($addr,$port);
     set output_info_($oid,in_spec) $addr/$port
     set output_info_($oid,out_vagent) "";
 
     foreach s $subgraph_list_ {
         # Create transmitting video agents in each subgraph and
         # set spec accordingly
 
         $subgraph_info_($s,comm_obj) set_output_spec $oid $output_info_($oid,in_spec);
     }
 }
 
 TemporalInterleaver instproc trigger_sr {src oid} {
     $self instvar output_info_;
 
     if {[info exists output_info_($oid,out_vagent)]} {
         set in_layer [lindex [$src set layers_] 0];
         set out_layer [lindex [[$output_info_($oid,out_vagent) set local_] set layers_] 0];
 
         $out_layer set ref_mts_ [$in_layer set mts_];
         $out_layer set ref_ntp_sec_ [$in_layer set ntp_ts_sec_];
         $out_layer set ref_ntp_fsec_ [$in_layer set ntp_ts_fsec_];
     }
 }
 
 
 TemporalInterleaver instproc set_output_spec {out_id spec} {
     $self instvar output_info_;
 
     if {$output_info_($out_id,spec) == $spec} {
         return;
     }
 
     set inter_obj $output_info_($out_id,inter_obj);
 
     set spec_split [split $spec "/"];
 
     set addr [lindex $spec_split 0];
     set port [lindex $spec_split 1];
 
     set output_info_($out_id,out_vagent) [new PsvpVideoAgent $addr/$port];
     [$output_info_($out_id,out_vagent) get_transmitter] set loopback_ 0;
 
     $inter_obj ssrc [$output_info_($out_id,out_vagent) get_local_srcid];
 
     global kpatel_debug;
 
     if {[info exists kpatel_debug]} {
         set logger [new Module/RTPPktLogger];
         $logger target [$output_info_($out_id,out_vagent) get_transmitter];
         $inter_obj target $logger;
     } else {
         $inter_obj target [$output_info_($out_id,out_vagent) get_transmitter];
     }
 
     # Total hack FIXMEXX
     $output_info_($out_id,out_vagent) local_bandwidth 30000000
 
     set output_info_($out_id,spec) $spec;
 }
 
 
 Class GraphComm/TemporalInterleaver -superclass GraphComm
 
 GraphComm/TemporalInterleaver instproc init {inter id addr port ttl} {
     $self next $id $addr $port $ttl;
 
     $self instvar inter_;
 
     set inter_ $inter;
 }
 
 GraphComm/TemporalInterleaver instproc update_parameter_attr_value {pname attr value} {
     $self next $pname $attr $value;
 
     if {$pname == "latency"} {
         if {$attr == "value"} {
             $self instvar inter_;
             $inter_ instvar latency_control_;
 
             if {$value > 1.0} {
                 $self set_parameter_attr $pname $attr 1.0;
                 set latency_control_ 1.0;
             } elseif {$value < 0.0} {
                 $self set_parameter_attr $pname $attr 0.0;
                 set latency_control_ 0.0;
             } else {
                 set latency_control_ $value;
             }
 
             $inter_ large_factor $latency_control_;
             $inter_ small_factor [expr 1.0 - $latency_control_];
         }
     }
 }
 
 
 GraphComm/TemporalInterleaver instproc update_output_attr_value {output_name attr_name value} {
     $self next $output_name $attr_name $value;
 
     $self instvar inter_;
     $inter_ instvar output_info_ output_id_list_ subgraph_list_;
 
     if {[lsearch $output_id_list_ $output_name] == -1} {
         return;
     }
 
     if {$subgraph_list_ == ""} {
         return;
     }
 
     switch -exact -- $attr_name {
         spec {
             $inter_ set_output_spec $output_name $value
         }
         format {
             foreach s $subgraph_list_ {
                 $subgraph_info_($s,comm_obj) set_output_format $output_name $value;
             }
         }
         geometry {
             foreach s $subgraph_list_ {
                 $subgraph_info_($s,comm_obj) set_output_geometry $output_name $value
             }
         }
     }
 }
 
 GraphComm/TemporalInterleaver instproc recv_misc {data} {
     $self next $data;
 
     $self instvar inter_;
 
     set cmd [lindex $data 0];
 
     switch -exact -- $cmd {
         add_subgraph {
             $inter_ instvar subgraph_info_;
             $inter_ instvar callback_array_;
             $inter_ instvar subgraph_list_;
 
             set new_subgraph [lindex $data 1];
 
             foreach sid $subgraph_list_ {
                 if {$subgraph_info_($sid,spec) == $new_subgraph} {
                     return;
                 }
             }
 
             $inter_ add_subgraph $new_subgraph;
         }
         del_subgraph {
             $inter_ instvar subgraph_list_ subgraph_info_;
 
             set subgraph_to_del [lindex $data 1];
 
             set sid_to_del "";
             foreach s $subgraph_list_ {
                 if {$subgraph_info_($s,spec) == $subgraph_to_del} {
                     set sid_to_del $s;
                     break;
                 }
             }
 
             if {$sid_to_del == ""} {
                 return;
             }
             $inter_ del_subgraph $sid_to_del;
         }
     }
 }
 
 
 Class TemporalInterleaverVideoAgent -superclass VideoAgent
 
 TemporalInterleaverVideoAgent instproc init {spec combiner} {
     eval $self next $self $spec;
 
     $self instvar combiner_;
 
     set combiner_ $combiner;
 }
 
 TemporalInterleaverVideoAgent instproc create_decoder src {
     $self instvar combiner_;
 
     set d [$src handler];
     if {$d != ""} {
         delete $d;
     }
 
     return $combiner_;
 }
 
 TemporalInterleaverVideoAgent instproc deactivate src {
     puts "$src has been deactivated!!!!";
 }
 
 
 TemporalInterleaver instproc GenerateSpec {} {
     # OK, this is a REAL hack
 
     global spec_generator;
 
     if {![info exists spec_generator(init)]} {
         set gen_spec [split [$self get_option gen_spec] "."];
 
         set spec_generator(init) 1;
         set spec_generator(b1) [lindex $gen_spec 0];
         set spec_generator(b2) [lindex $gen_spec 1];
         set spec_generator(b3) [lindex $gen_spec 2];
         set spec_generator(b4) [lindex $gen_spec 3];
         set spec_generator(port) [expr (int(rand() * 5000)*2) + 10000]
     }
 
     incr spec_generator(b4);
 
     return "$spec_generator(b1).$spec_generator(b2).$spec_generator(b3).$spec_generator(b4)/$spec_generator(port)/16";
 }
 
 
 # Some routines to help with ui in tinter.tcl
 
 TemporalInterleaver instproc large_factor {value} {
 
     eval $self instvar [$self info vars];
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             $inter_obj large_factor $value;
         }
     }
 }
 
 TemporalInterleaver instproc small_factor {value} {
 
     eval $self instvar [$self info vars];
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             $inter_obj small_factor $value;
         }
     }
 }
 
 TemporalInterleaver instproc expected_tolerance_factor {value} {
 
     eval $self instvar [$self info vars];
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             $inter_obj expected_tolerance_factor $value;
         }
     }
 }
 
 TemporalInterleaver instproc catch_up_factor {value} {
 
     eval $self instvar [$self info vars];
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             $inter_obj catch_up_factor $value;
         }
     }
 }
 
 TemporalInterleaver instproc get_marked {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set marked_];
         }
     }
     return $res;
 }
 
 TemporalInterleaver instproc get_unmarked {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set unmarked_];
         }
     }
     return $res;
 }
 
 TemporalInterleaver instproc get_late {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set late_];
         }
     }
     return $res;
 }
 
 TemporalInterleaver instproc get_early_expected {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set early_expected_];
         }
     }
     return $res;
 }
 
 TemporalInterleaver instproc get_early_queued {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set early_queued_];
         }
     }
     return $res;
 }
 
 TemporalInterleaver instproc get_late_valid {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set late_valid_];
         }
     }
     return $res;
 }
 
 TemporalInterleaver instproc get_q_length {} {
     eval $self instvar [$self info vars];
     set res "";
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             lappend res [$inter_obj set q_length_];
         }
     }
     return $res;
 }
 
 
 TemporalInterleaver instproc reset_stats {} {
     $self instvar output_id_list_ output_info_
 
     foreach o $output_id_list_ {
         set inter_obj $output_info_($o,inter_obj);
         if {$inter_obj != ""} {
             $inter_obj reset_stats
         }
     }
 }
 
 Class GraphComm/TIToSubgraph -superclass GraphComm;
 
 GraphComm/TIToSubgraph instproc init {tinter id spec} {
     set spec [split $spec "/"];
 
     set addr [lindex $spec 0];
     set port [lindex $spec 1];
     set ttl [lindex $spec 2];
 
     $self next $id $addr $port $ttl;
 
     $self instvar tinter_;
 
     set tinter_ $tinter;
 }
 
 GraphComm/TIToSubgraph instproc set_output_spec {id spec} {
     $self create_output $id
     $self create_output_attr $id spec
     $self set_output_attr $id spec $spec;
 }
 
 GraphComm/TIToSubgraph instproc set_output_geometry {out_id geometry} {
     $self create_output $out_id;
     $self create_output_attr $out_id geometry;
     $self set_output_attr $out_id geometry $geometry;
 }
 
 GraphComm/TIToSubgraph instproc set_output_format {id format} {
     $self create_output $out_id;
     $self create_output_attr $out_id format;
     $self set_output_attr $out_id format $format;
 }
 
 GraphComm/TIToSubgraph instproc new_output {output_name} {
     $self next $output_name;
 
     $self instvar tinter_;
     $tinter_ setup_output $output_name;
 }