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

   # sc-extract.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 ScExtractSubprogram -superclass DaliSubprogram
  
  ScExtractSubprogram instproc init {args} {
      eval $self next $args;
  
      # Set up inputs
  
      $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_ width
      set pobj [new IntParameter];
  
      set parameter_info_(width,oname) $pobj;
      $pobj from 1
      $pobj to 20
      $pobj set 10
  
      lappend parameter_id_list_ height
      set pobj [new IntParameter];
  
      set parameter_info_(height,oname) $pobj;
      $pobj from 1
      $pobj to 15
      $pobj set 7
  
      lappend parameter_id_list_ xpos
      set pobj [new IntParameter];
  
      set parameter_info_(xpos,oname) $pobj;
      $pobj from 0
      $pobj to 19
      $pobj set 5
  
      lappend parameter_id_list_ ypos
      set pobj [new IntParameter];
  
      set parameter_info_(ypos,oname) $pobj;
      $pobj from 0
     $pobj to 14
     $pobj set 4
 }
 
 ScExtractSubprogram instproc trigger {} {
     $self instvar parameter_info_;
     $self instvar input_info_;
     $self instvar output_info_;
     $self instvar init_done_;
     $self instvar old_w_;
     $self instvar old_h_;
     $self instvar old_x_;
     $self instvar old_y_;
 
     set w_pobj $parameter_info_(width,oname);
     set h_pobj $parameter_info_(height,oname);
     set x_pobj $parameter_info_(xpos,oname);
     set y_pobj $parameter_info_(ypos,oname);
 
     set w [$w_pobj get];
     set h [$h_pobj get];
     set x [$x_pobj get];
     set y [$y_pobj get];
 
     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_w_ -1;
         set old_h_ -1;
         set old_x_ -1;
         set old_y_ -1;
 
         set init_done_ 1;
     }
 
     if {$w != $old_w_ || $h != $old_h_ ||  $x != $old_x_ ||  $y != $old_y_} {
         $out_frame copy_geometry $in_frame;
 
         $out_frame set w_ [expr $w * 16];
         $out_frame set h_ [expr $h * 16];
         $out_frame set xoff_ [expr $x * 16];
         $out_frame set yoff_ [expr $y * 16];
 
         $out_frame allocate;
 
         set old_w_ $w;
         set old_h_ $h;
         set old_x_ $x;
         set old_y_ $y;
     }
 
 
 
     set in_l [$in_frame get_lum_name];
     set in_cr [$in_frame get_cr_name];
     set in_cb [$in_frame get_cb_name];
 
     set out_l [$out_frame get_lum_name];
     set out_cr [$out_frame get_cr_name];
     set out_cb [$out_frame get_cb_name];
 
     set x [expr $x*2];
     set y [expr $y*2];
     set w [expr $w*2];
     set h [expr $h*2];
 
     set clip_out [sc_clip $in_l $x $y $w $h];
     sc_copy $clip_out $out_l;
     sc_free $clip_out;
 
     set x [expr $x / [$out_frame set h_subsample_]];
     set y [expr $y / [$out_frame set v_subsample_]];
     set w [expr $w / [$out_frame set h_subsample_]];
     set h [expr $h / [$out_frame set v_subsample_]];
 
     set clip_out [sc_clip $in_cr $x $y $w $h];
     sc_copy $clip_out $out_cr;
     sc_free $clip_out;
 
     set clip_out [sc_clip $in_cb $x $y $w $h];
     sc_copy $clip_out $out_cb;
     sc_free $clip_out;
 
     $out_frame set ts_ [$in_frame set ts_];
 
     set encoder $output_info_(o1,encoder);
 
 
     if {$encoder != ""} {
         $encoder recv $out_frame;
     }
    $self send_completion_token
 }