Open Mash Cross Reference
mash/tcl/dc/rvc/agent-rvc.tcl

   # agent-rvc.tcl --
   #
   #       Derived from VideoAgent; used to transmit the video onto the network
   #
   # Copyright (c) 2000-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 VideoAgent
  import Observer
  import VideoPipeline
  
  #
  # Code for RvcObserver
  #
  Class RvcObserver -superclass Observer
  
  RvcObserver instproc init {app} {
  
      $self next
  
      $self instvar app_
  
      set app_ $app
  }
  
  #
  # Code for RvcAgent
  #
  Class RvcAgent -superclass VideoAgent
  
  RvcAgent instproc init {app spec} {
      $self next $app $spec
  
      $self instvar decoder_
  
      #
      # Make a single Null VideoDecoder for all to share.
      #
      set decoder_ [new Module/VideoDecoder/Null]
  
      #
      # Setup pipeline and stuff for capture.
      #
      $self instvar pipeline_
  
      set pipeline_ [new VideoPipeline $self]
  
      #
      # Setup stuff for formats and qualities for the grabber.
      #
      $self instvar device_
      set device_ "none"
  
      $self instvar qval_
      set qval_(h261) 95
      set qval_(nv) 80
      set qval_(nvdct) 80
      set qval_(pvh) 60
      set qval_(jpeg) 95
  
      #
      # Setup the default formats.
      #
      $self instvar devfmt_
  
      set videoFormat [$self get_option videoFormat]
      if { $videoFormat == "h.261" } {
          set videoFormat h261
      }
  
      set qval_($videoFormat) [$self get_option videoQuality]
  
      foreach d [$pipeline_ input_devices] {
          set fmtList [$pipeline_ available_formats $d]
  
          #
         # if videoFormat is part of fmtList, use it, otherwise
         # use the first format in the list.
         #
         if {[lsearch -exact $fmtList $videoFormat] >= 0} {
             set devfmt_($d) $videoFormat
         } else {
             set devfmt_($d) [lindex $fmtList 0]
         }
 
     }
 
     #
     # Setup the default ports.
     #
     $self instvar devport_
 
     set videoPort [$self get_option videoInputPort]
 
     foreach d [$pipeline_ input_devices] {
         set portList [$d get_attribute port]
         if [inList $videoPort $portList] {
             set devport_($d) $videoPort
         } else {
             set devport_($d) [lindex $portList 0]
         }
     }
 
     $self select_initial_device
 
     #
     # Do frame rate and bit rates.
     #
     $self instvar fps_ bps_
 
     set fps_ [$self get_option frameRate]
     set bps_ [$self get_option videoBandwidth]
 
     $self set_fps $fps_
     $self set_bps $bps_
 }
 
 
 RvcAgent instproc trigger_fir {} {
     $self instvar pipeline_
     $pipeline_ send_full_intra_frame
 }
 
 
 RvcAgent instproc destroy {} {
     $self instvar decoder_
     $self instvar pipeline_
 
     delete $decoder_ 
 
     $pipeline_ release_device
     delete $pipeline_ 
 }
 
 RvcAgent instproc current_inport_list {} {
 
     return [[$self current_device] get_attribute port]
 }
 
 RvcAgent instproc current_fps {} {
     $self instvar fps_
     return $fps_
 }
 
 RvcAgent instproc current_bps {} {
     $self instvar bps_
     return $bps_
 }
 
 RvcAgent instproc current_device {} {
     $self instvar device_
     return $device_
 }
 
 RvcAgent instproc current_fmt {} {
     $self instvar device_ devfmt_
     return $devfmt_($device_)
 }
 
 RvcAgent instproc current_inport {} {
     $self instvar device_ devport_
     return $devport_($device_)
 }
 
 RvcAgent instproc select_initial_device {} {
     $self instvar pipeline_ device_ devfmt_
     set L [$pipeline_ input_devices]
     set d [$self get_option defaultDevice]
 
     foreach v $L {
         if { [$v nickname] == "$d" && \
                 [$v attributes] != "disabled" } {
             $self set_device $v
             return
         }
     }
 
     #
     # Otherwise select the first available one.
     #
     set device [lindex $L 0]
     $self set_device $device
 }
 
 RvcAgent instproc set_fps fps {
     $self instvar pipeline_ fps_
 
     set fps_ $fps
     return [$pipeline_ set_fps $fps_]
 }
 
 RvcAgent instproc set_bps bps {
     $self instvar pipeline_ bps_
 
     $self local_bandwidth $bps
 
     set bps_ $bps
     $pipeline_ set_bps $bps_
 
     return [$pipeline_ set_bps $bps_]
 }
 
 RvcAgent instproc set_fmt fmt {
     $self instvar device_ devport_
 
     return [$self select_device $device_ $fmt $devport_($device_)]
 }
 
 RvcAgent instproc get_device_by_name deviceName {
     $self instvar pipeline_
     foreach d [$pipeline_ input_devices] {
         if {[$d nickname] == $deviceName} {
             return $d
         }
     }
     return ""
 }
 
 RvcAgent instproc set_device device {
     $self instvar devfmt_ devport_
 
     return [$self select_device $device $devfmt_($device) $devport_($device)]
 }
 
 RvcAgent instproc set_inport inport {
     $self instvar pipeline_ devport_ device_
     set devport_($device_) $inport
     $pipeline_ set_port $inport
 }
 
 
 RvcAgent instproc set_norm norm {
     $self instvar pipeline_ device_ 
     # $self instvar norm_
     # set norm_ $norm
 
     #
     # if the input $norm is supported by the current device, set it.
     # otherwise, warn and ignore the input. 
     #
     if {[lsearch -exact [$device_ get_attribute norm] $norm] >= 0} {
         $pipeline_ set_norm $norm
     } else {
         puts "WARNING: unsupported NORM $norm.  Supported values are [$device_ get_attribute norm]"
     }
 }
 
 
 RvcAgent instproc select_device {device fmt port} {
     $self instvar device_ pipeline_ devfmt_ devport_
 
     set running [$self running]
  
     #
     # If nothing changes, just return.  (This could happen 
     # at the beginning when RvcAgent is created.)
     #
     if {$device_ == $device && $devfmt_($device_) == $fmt &&
         $devport_($device_) == $port} {
         return
         }
 
     # Set new state.
     set device_ $device
     set devfmt_($device) $fmt
     set devport_($device) $port
 
     $pipeline_ release_device
     $pipeline_ select $device_ $devfmt_($device)
 
     $self instvar qval_
 
     if [info exists qval_($fmt)] {
         $self set_quality $qval_($fmt)
     }
 
     # Norm of devices gets reset everytime a device is release.  
     # If set_norm have been called on a device before, call it 
     # again (possibly on a different device).
     #if [info exists norm_] {
     #   $self set_norm $norm_
     #}
 
     $pipeline_ set_port $port
 
     if $running {
         $self start
     } 
 }
 
 RvcAgent instproc set_quality q {
     $self instvar qval_ device_ devfmt_
 
     if [info exists qval_($devfmt_($device_))] {
         set qval_($devfmt_($device_)) $q
 
         $self instvar pipeline_
         $pipeline_ set_quality $qval_($devfmt_($device_))
     }
 }
 
 RvcAgent instproc current_quality {} {
     $self instvar qval_ device_ devfmt_
 
     if [info exists qval_($devfmt_($device_))] {
         return $qval_($devfmt_($device_))
     }
     return 0
 }
 
 RvcAgent instproc input_devices {} {
     $self instvar pipeline_
 
     return [$pipeline_ input_devices]
 }
 
 RvcAgent instproc start {} {
 #    puts "rvc agent start got here"
 
     $self instvar pipeline_
 
     # turn off loopback.
     $self app_loopback 0
 
     # We might still need to loopback to the network, in case 
     # we are running a receiver at the same host.  However, this
     # is turned off by default.
     set options [$self options]
     $self net_loopback [$options get_option loopback]
 
     return [$pipeline_ start]
 }
 
 RvcAgent instproc stop {} {
     $self instvar pipeline_
 
     return [$pipeline_ stop]
 }
 
 RvcAgent instproc running {} {
     $self instvar pipeline_
 
     return [$pipeline_ running]
 }
 
 #
 # Don't create real decoders, since we don't care
 # about other sources!
 #
 RvcAgent instproc create_decoder src {
 
     $self instvar decoder_
 
     #puts "create_decoder called on $src"
     #puts "create_decoder called on [$src srcid]"
 
     # decoder_ is a Null VideoDecoder.
     return $decoder_
 }