Open Mash Cross Reference
mash/tcl/applications/camera-server/camera-srvr.tcl

   # camera-srvr.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1996-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.
  #
  # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/camera-server/camera-srvr.tcl,v 1.17 2002/02/03 04:21:42 lim Exp $
  
  
  import SerialChannel/Camera-Sony-EVID30 SerialChannel/Camera-Canon-VCC1 \
                  UDPServer Rendezvous
  
  # Camera messaging interface -- handles all transmission of state
  # announcements of the underlying agent. <p>
  #
  Class UDPServer/Camera -superclass UDPServer
  
  # only uses the port num and performs multiple unicasts to
  # all known clients <P> FIXME need to time them out; enable mcast
  #
  UDPServer/Camera public init {addrspec parent {mtu 1500}} {
      $self instvar parent_ pending_
      set parent_ $parent
      set pending_ -1
  
      eval [list $self] next $addrspec $mtu
  }
  
  # Receive a msg to the Camera Server.
  # <br>
  # format of received announcement is:
  #  "method args ..."
  #
  UDPServer/Camera private recv {addr port data size} {
      #puts "Msg: $addr\[$size\]: $data"
  
      $self instvar parent_ pending_
      set c [$parent_ set cam_]
  
      set theMethod [lindex $data 0]
      set theArgs [lrange $data 1 end]
  
      if {[lsearch [[$c info class] info instprocs] $theMethod] != -1} {
          # disallow list:
          if {$theMethod == "init"} {return}
          # check number of args
          set maxArgs [llength [[$c info class] info instargs $theMethod]]
          set reqArgs 0
          foreach i [[$c info class] info instargs $theMethod] {
                  if {[[$c info class] info instdefault $theMethod $i ""] == 0} {
                          incr reqArgs
                  }
          }
          if {[llength $theArgs] < $reqArgs || [llength $theArgs] > $maxArgs} {
              puts "Bad arg count to $theMethod"
              return
          }
          # okay, invoke the camera command
          #puts -nonewline "invoking: $c $theMethod $theArgs... "
          set reply [eval $c $theMethod $theArgs]
          # don't return reply; should be subset of full state update
  
          if {$pending_ != -1} {
              after cancel $pending_
          }
          # wait a bit to coalesce bursts of updates
          set pending_ [after 300 $self announce_state]
      } else {
          if {$theMethod == "update_state"} {
              $self announce_state
          } else {
              puts "msg with method '$theMethod' not found.  ignored."
          }
      }
  }
 
 #
 # a wrapper for sending a complete state update
 #
 UDPServer/Camera private announce_state {} {
     $self instvar parent_ pending_
 
     set c [$parent_ set cam_]
     set tmp "z: [$c set zoomPerc_]"
     append tmp " t: [$c set tiltPerc_]"
     append tmp " p: [$c set panPerc_]"
     append tmp " pre: "
     foreach i "[$c array names presets_]" {
         append tmp "$i [$c get_preset $i] "
     }
 
     $self announce "$tmp"
     after 40 $self announce [list "$tmp"]
     set pending_ -1
 }
 
 # a UI-less server for controlling local camera(s)
 #<br>
 # simple wrapper for accepting remote commands (method invocations)
 # and passing them on the the underlying camera object
 #
 Class CameraServer
 
 #
 # init takes 3 args: addrspec, type of camera (the class has to be
 # pre-imported), and the device name
 #
 CameraServer public init {addrspec {device /dev/cuac00} \
         {type SerialChannel/Camera-Sony-EVID30}} {
 
     $self instvar cam_ al_
 
     set al_ [new UDPServer/Camera $addrspec $self]
     set cam_ [new $type]
     # hack until -device $dev works in constructor
     $cam_ close
     $cam_ device $device
     $cam_ open
 }
 
 # start advertising cameras on rendezvous channel `rspec' with
 # `camctrladdr' as addr for controlling camera
 # (camera name is grabbed from the options)
 CameraServer public start_rendezvous_ads {rspec camctrladdr} {
     $self instvar advertiser_
     set advertiser_ [new Rendezvous $rspec]
     set camname [$self get_option camname]
     if ![invalid_addr $camname] {
         set m "camera: camCtrl:$camctrladdr cname:$camname"
     } else {
         set m "camera: camName:$camname camCtrl:$camctrladdr"
     }
     puts  "advertising '$m' to $rspec"
     $advertiser_ start $m
 
     set m "will-provide: mash-object=CameraServer ctrlspec=$camctrladdr"
     set uid [$self get_option uniqid]
     if {$uid != ""} {set m "$m uniqid=$uid"}
     $advertiser_ start $m
 }