Open Mash Cross Reference
mash/tcl/psvp/effects/sc-transcode-timing.tcl

   # sc-transcode-timing.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # 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.
  
  import DaliSubprogram
  import IntParameter
  
  Class ScXCodeTimingSubprogram -superclass DaliSubprogram
  
  ScXCodeTimingSubprogram instproc init {args} {
      eval $self next $args;
  
      $self instvar input_id_list_;
      $self instvar input_info_;
  
      lappend input_id_list_ i1
  
      set input_info_(i1,spec) "";
      set input_info_(i1,trigger) 0;
      set input_info_(i1,buffertype) Semicompressed;
      set input_info_(i1,buffername) [new VidRep/Semicompressed];
      set input_info_(i1,decoder) "";
  
      # Set up outputs
  
      $self instvar output_id_list_;
      $self instvar output_info_;
  
      lappend output_id_list_ o1;
  
      set output_info_(o1,spec) "";
      set output_info_(o1,buffertype) Semicompressed;
      set output_info_(o1,buffername) [new VidRep/Semicompressed];
      set output_info_(o1,encoder) "";
      set output_info_(o1,format) SC;
      set output_info_(o1,vagent) "";
  
      # Set up parameters
  
      $self instvar parameter_id_list_;
      $self instvar parameter_info_;
  
      lappend parameter_id_list_ quant
      set pobj [new IntParameter];
  
      set parameter_info_(quant,oname) $pobj;
      $pobj from 5
      $pobj to 95
      $pobj set 5
  
  }
  
  ScXCodeTimingSubprogram instproc trigger {} {
      $self instvar parameter_info_;
      $self instvar input_info_;
      $self instvar output_info_;
      $self instvar init_done_;
      $self instvar init_part2_;
      $self instvar old_q_;
      $self instvar cntr_;
  
  
      set in_frame $input_info_(i1,buffername);
      set out_frame $output_info_(o1,buffername);
  
      if {![info exists init_done_]} {
          if {[$in_frame set w_] == 0} {
              return;
          }
  
          set old_q_ -1;
  
          set cntr_ 0;
         set init_done_ 1;
     }
 
     incr cntr_;
 
     set q_pobj $parameter_info_(quant,oname);
     set q [$q_pobj get];
 
     if {$cntr_ > 100} {
         $q_pobj set [expr $q + 5];
     }
     set q [$q_pobj get];
 
     if {$q != $old_q_} {
         set encoder $output_info_(o1,encoder);
         if {$encoder != ""} {
             $encoder q $q;
         }
         set old_q_ $q;
         set cntr_ 0;
     }
 
     set encoder $output_info_(o1,encoder);
     if {$encoder == ""} {
         puts "No encoder"
         return;
     }
     $self instvar pkt_q_ sc_2_semi_ semi_2_jpeg_ bp2_ va_ fb2_;
 
     if {![info exists init_part2_]} {
 
         set init_part2_ 1;
 
         set fb2_ [new VidRep/Semicompressed];
 
         set pkt_q_ [new Module/PacketQ]
         set sc_2_semi [new Module/VideoDecoder/SCToSemicompressed]
         set semi_2_jpeg_ [new Module/VideoEncoder/SemicompressedToJPEG];
         set bp2_ [new BufferPool/RTP];
 
         set va_ [new VideoAgent $self 224.2.5.5/22334];
         $va_ local_bandwidth 30000000
 
         $bp2_ srcid [$va_ get_local_srcid];
 
         $semi_2_jpeg_ buffer-pool $bp2_;
         $semi_2_jpeg_ mtu [$self get_option mtu];
         $semi_2_jpeg_ target [$va_ get_transmitter];
 
         $sc_2_semi set_frame_buffer $fb2_;
         $sc_2_semi set_callback "$self back_trigger";
 
         $pkt_q_ target $sc_2_semi;
 
         $encoder target $pkt_q_;
     }
 
     $encoder recv $in_frame;
 
     $self instvar start_time_ last_size_;
 
     set last_size_ [$encoder set last_size_];
 
     set start_time_ [clock clicks];
 
     $pkt_q_ dump;
 }
 
 
 ScXCodeTimingSubprogram instproc back_trigger {} {
 
     $self instvar semi_2_jpeg_ fb2_;
 
     $semi_2_jpeg_ recv $fb2_;
 
     set end_time [clock clicks];
 
     $self instvar start_time_ old_q_ last_size_;
 
     puts "[$fb2_ set ts_] $old_q_ $last_size_ [expr ($end_time - $start_time_) / 1000.0]";
 }