~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/vic/cam-ctrl.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # cam-ctrl.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1998-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 #
 31 #  @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/vic/cam-ctrl.tcl,v 1.8 2002/02/03 04:39:54 lim Exp $
 32 
 33 
 34 #
 35 import CameraUI RendezvousManager
 36 
 37 # class for attaching camera controls to a UserWindow --
 38 # clicks on the UW are sent as camera cmds to addresses aquired
 39 # from the CameraManager, and
 40 # also attaches a button for accessing the full camera ctrl UI
 41 # below the UW.
 42 Class RemoteCamera
 43 
 44 # attaches camera controls to userWindow (w is the userWindow frame)
 45 RemoteCamera public init {userWindow w} {
 46     $self instvar uw_ addr_ camCli_ w_ as_ camMngr_ showUI_ isalloc_
 47     set uw_ $userWindow
 48     set w_ $w
 49 
 50     set camMngr_ [CameraManager info instances]
 51     if {$camMngr_ == ""} {
 52         puts "RemoteCamera::init: CameraManager should be allocated...?!?"
 53         #set camMngr_ [new CameraManager [$self get_option rendezSpec]]
 54         return
 55     }
 56 
 57     set cname "[[[$uw_ set as_] set src_] sdes cname]"
 58     set addr_ [$camMngr_ get_addr_for $cname]
 59     if {$addr_ == ""} {
 60         set isalloc_ 0
 61         return
 62     } else {
 63         set isalloc_ 1
 64     }
 65     bind $w.frame.video <ButtonPress-1> "$self click \"%x %y\""
 66     bind $w.frame.video <ButtonRelease-1> "$self clickup"
 67 
 68     frame $w.camFrame
 69     set camCli_ [new CameraUI $w.camFrame $addr_]
 70     set showUI_ 0  ; # frame remains unpacked until UI is asked for
 71 }
 72 
 73 # returns whether the remote camera control address is known,
 74 # and therefore, the agent to control it is allocated.
 75 RemoteCamera private isAllocated {} {
 76     $self instvar isalloc_
 77     return $isalloc_
 78 }
 79 
 80 # receive click on window -- send move command to camera
 81 RemoteCamera private click {xy} {
 82     $self instvar hei_ wid_ camCli_
 83     $self update_hei_wid
 84     set al [$camCli_ set al_]
 85     # normalize click h and w
 86     set x [lindex $xy 0]
 87     set y [lindex $xy 1]
 88     set normH [expr ($y*1.0)/$hei_]
 89     set normW [expr ($x*1.0)/$wid_]
 90     #puts "click: $normH x $normW"
 91 
 92     if {$normH > 0.6} {
 93         # down
 94         if {$normW > 0.6} {
 95             $al send move_downright
 96         } elseif {$normW < 0.4 } {
 97             $al send move_downleft
 98         } else {
 99             $al send move_down
100         }
101     } elseif {$normH < 0.4 } {
102         # up
103         if {$normW > 0.6} {
104             $al send move_upright
105         } elseif {$normW < 0.4 } {
106             $al send move_upleft
107         } else {
108             $al send move_up
109         }
110     } else {
111         # only L/R movement or zoom
112         if {$normW > 0.6} {
113             $al send move_right
114         } elseif {$normW < 0.4 } {
115             $al send move_left
116         } elseif {$normH > 0.5} {
117             # these next two zoom clauses are possibly unintuitive..
118             # maybe should leave them out... FIXME
119             $al send zoom_out
120         } else {
121             $al send zoom_in
122         }
123     }
124 }
125 
126 # stop when click in released
127 RemoteCamera private clickup {} {
128     $self instvar camCli_
129     set al [$camCli_ set al_]
130     $al send "move_stop"
131     $al send "zoom_stop"
132 }
133 
134 # get current height,width
135 RemoteCamera private update_hei_wid {} {
136     $self instvar uw_ hei_ wid_
137 
138     set vidWin [[$uw_ set vw_] window]
139     set hei_ [$vidWin height]
140     set wid_ [$vidWin width]
141 }
142 
143 # toggle camera control UI next to userWindow
144 RemoteCamera private toggleUI {} {
145     $self instvar showUI_ w_
146     if $showUI_ {
147         pack forget $w_.camFrame
148         set showUI_ 0
149     } else {
150         pack $w_.camFrame -fill both
151         set showUI_ 1
152     }
153 }
154 
155 ## ------------------------------------------------------------
156 
157 # an object that listens for information on
158 # camera control mappings (via the use of the RendezvousManager)
159 # and then stores them.
160 #
161 Class CameraManager -superclass Observer
162 
163 #
164 CameraManager public init {} {
165     $self next
166     $self instvar rcList_ rv_ camList_
167     set rcList_ ""
168 
169     set rv_ [new RendezvousManager]
170     $rv_ attach_observer $self
171 }
172 
173 #
174 CameraManager public destroy {} {
175     $self instvar rv_
176     $rv_ detach_observer $self
177     $self next
178 }
179 
180 #
181 CameraManager private add {camName camAddr} {
182     $self instvar camList_
183     # only print if new mapping
184     if {([array names camList_ $camName] == "") || \
185             ($camList_($camName) != $camAddr)} {
186         #puts "mapping $camName <--> $camAddr"
187     }
188     set camList_($camName) $camAddr
189 }
190 
191 #
192 CameraManager private rm {name} {
193     $self instvar camList_
194     if {[$self get $name] != ""} {
195         unset camList_($name)
196     }
197 }
198 
199 #
200 CameraManager private get {name} {
201     $self instvar camList_
202     #foreach i [array names camList_] {puts "$i : $camList_($i)"}
203     if {[array names camList_ $name] != ""} {
204         return $camList_($name)
205     } else {
206         return ""
207     }
208 }
209 
210 # try to match entire cname, then just address of machine
211 CameraManager private get_addr_for {src} {
212     #puts "get_addr_for $src"
213     set retVal [$self get $src]
214     if {$retVal == ""} {
215         set srcaddr [lindex [split $src "@"] 1]
216         set retVal [$self get $srcaddr]
217     }
218     #if {$retVal != ""} {puts "cam ctrl addr for $src is $retVal"}
219     return $retVal
220 
221 }
222 
223 
224 #
225 # listens for one of three message formats:
226 # <br>- camera: camCtrl:spec cname:cname
227 # <br>- camera: camName:camName videoIn:addr
228 # <br>- camera: camName:camName camCtrl:spec
229 # <p>
230 #
231 CameraManager private rendez_recv_camera {rvmsg} {
232     $self instvar camData_
233 
234     set data [$rvmsg get_msg]
235 
236     # clear updated "camName<-->videoIn" entries
237     set msgLine [lrange $data 1 end]
238     regsub -all ":" $msgLine " " datalist
239     set cn [lindex $datalist 1]
240     if {[lindex $datalist 0] == "camName"} {
241         if ![info exists camData_($cn)] {set camData_($cn) ""}
242         if {[lindex $datalist 2] == "videoIn"} {
243             #puts "$datalist"
244             set i [lsearch $camData_($cn) "videoIn"]
245             while {$i != -1} {
246                 set camData_($cn) [lreplace $camData_($cn) $i $i]
247                 set i [lsearch $camData_($cn) "videoIn"]
248             }
249             foreach i [array names camData_] {
250                 set ind [lsearch $camData_($i) [lindex $msgLine 1]]
251                 if {$ind != -1} {
252                     set camData_($i) [lreplace $camData_($i) $ind $ind]
253                 }
254             }
255         }
256     }
257 
258     #foreach i [array names camData_] {puts "$i : $camData_($i)"}
259 
260     # data of form "camCtrl:spec cname:cname" is exact match
261     if {([lindex $datalist 0] == "camCtrl") && \
262             ([lindex $datalist 2] == "cname")} {
263         set camAddr [lindex $datalist 1]
264         set cname [lindex $datalist 3]
265         $self add $cname $camAddr
266     }
267     # other msgs must be matched together
268     # first store them (sorted)...
269     if {[lindex $datalist 0] == "camName"} {
270         set cn [lindex $datalist 1]
271         set entry [lindex $msgLine 1]
272         if {[lsearch $camData_($cn) $entry] == -1} {
273             lappend camData_($cn) $entry
274             set camData_($cn) [lsort $camData_($cn)]
275         }
276         # ... then check for a match.
277         # (if you have both a videoIn and a camCtrl for a camName, add it)
278         set camdata $camData_($cn)
279         #puts "$camdata"
280         if {[llength $camdata] >= 2} {
281             regsub -all ":" $camdata " " cdl
282             set camAddr [lindex $cdl 1]
283             for {set i 1} {$i < [llength $camdata]} {incr i} {
284                 set cname [lindex $cdl [expr ($i*2)+1]]
285                 $self add $cname $camAddr
286             }
287         }
288     }
289 
290 }
291 
292 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.