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

Open Mash Cross Reference
mash/tcl/cues/recv-cues.tcl

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

  1 # recv-cues.tcl --
  2 #
  3 #       An object for receiving cues in a collaborative meeting.
  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 #
 32 # An object for receiving cues in a collaborative meeting.
 33 #
 34 # Similar to CuesSender, this class makes a gui for the
 35 # cues, which is just a list of images of the cues. It
 36 # registers and listens for cues messages on the global
 37 # coordination bus. The client of this object needs to
 38 # pass in the bus.
 39 #
 40 # See also: CuesSender
 41 #
 42 # Examples of usage can be found in vat.
 43 #
 44 
 45 Class CuesReceiver
 46 
 47 #
 48 # Initialize the global coordination bus. All instances of
 49 # CuesReceiver (for a single application) share the same
 50 # bus. The object to use should be CoordBus_ and the associated
 51 # CBChannel/Site object. There are examples of them in
 52 # application-{vic,vat}.tcl.
 53 #
 54 CuesReceiver proc set_cb { cb } {
 55         # initialize global coordination bus
 56         CuesReceiver set glob_chan_ $cb
 57 
 58         # register for global coordination bus events
 59         $cb register AWARE_ear "$self recv"
 60         $cb register AWARE_hand "$self recv"
 61         $cb register AWARE_yes "$self recv"
 62         $cb register AWARE_no "$self recv"
 63         $cb register UNAWARE_ear "$self recv"
 64         $cb register UNAWARE_hand "$self recv"
 65         $cb register UNAWARE_yes "$self recv"
 66         $cb register UNAWARE_no "$self recv"
 67 }
 68 
 69 #
 70 # Called when received an event from the bus.
 71 # It dispatches the event to the right function. This
 72 # is either telling the gui to start or stop blinking
 73 # the specified cue.
 74 #
 75 CuesReceiver proc recv { list msg } {
 76         array set info $list
 77 
 78         set event [split $info(event) "_"]
 79         set cue [lindex $event 1]
 80         switch -- [lindex $event 0] {
 81                 AWARE { set fn start_blink }
 82                 UNAWARE { set fn stop_blink }
 83         }
 84 
 85         # dispatch the event to all instances of
 86         # receiver
 87         CuesReceiver instvar all_
 88         if [info exists all_] {
 89                 foreach cr $all_ {
 90                         $cr $fn $cue $msg
 91                 }
 92         }
 93 }
 94 
 95 #
 96 # Create a CuesReceiver object and the gui
 97 # path: the gui is construct using this path, the
 98 #       client should pass in the name of a frame
 99 # size: either lg (large, for something like switcher windows) or
100 #              sm (small, for something like vic thumbnails)
101 #
102 CuesReceiver instproc init { path size } {
103         # initialize some variables
104         # cname_: the current source displayed and associated to
105         #          the cues
106         $self instvar cname_ size_ cues_
107         set cname_ 0
108         set size_ $size
109         # FIXME change so client can specify
110         set cues_ "hand ear yes no"
111 
112         # add this new instance to a list
113         CuesReceiver instvar all_
114         lappend all_ $self
115 
116         # create the cues images
117         $self instvar top_ colors_
118         set top_ $path
119         foreach c $cues_ {
120                 $self set ${c}_l [label ${top_}.${c} \
121                                   -bitmap ${size_}_${c}]
122                 pack ${top_}.${c} -side left -padx 10
123         }
124 
125         # blink colors
126         # FIXME change so client can specify
127         set colors_(1) red
128         set colors_(0) gray
129 }
130 
131 CuesReceiver instproc destroy { } {
132         # remove from group
133         CuesReceiver instvar all_
134         set i [lsearch $all_ $self]
135         set all_ [lreplace $all_ $i $i]
136 
137         # cancel all scheduled events
138         $self instvar cues_ cnames_
139         foreach cue $cues_ {
140                 foreach cname $cnames_ {
141                         $self stop_blink $cue $cname
142                 }
143         }
144 
145         $self next
146 }
147 
148 #
149 # This method is used only in one special circumstance:
150 # for a window that share multiple videos for different
151 # participants. We want the cues to blink only if they
152 # are from the person currently showing in the window.
153 # The client call enable whenever the video changes.
154 # cname: the cname of the source currently displayed on
155 # the window
156 #
157 CuesReceiver instproc enable { cname } {
158         $self set cname_ $cname
159         $self refresh
160 }
161 
162 CuesReceiver instproc refresh { } {
163         $self instvar top_ cues_ colors_
164         foreach c $cues_ {
165                 ${top_}.${c} conf -background $colors_(0)
166         }
167 }
168 
169 #
170 # Start blinking the cue image for the person with
171 # cname
172 #
173 CuesReceiver instproc start_blink { cue cname } {
174         $self instvar ${cname}_info_ accum_ cnames_
175 
176         # no need to blink if this cname's cue is already blinking
177         if [info exists ${cname}_info_($cue)] {
178                 return
179         }
180 
181         set ${cname}_info_($cue) 1
182         set ${cname}_info_(${cue}_accum) 0
183         set ${cname}_info_(${cue}_after) 0
184         set ${cname}_info_(${cue}_color) 0
185 
186         if { ![info exists cnames_] || [lsearch cnames_ $cname] == -1 } {
187                 lappend cnames_ $cname
188         }
189 
190         $self blinklite 100 $cue $cname
191 }
192 
193 #
194 # Stop blinking the cue image for the person with
195 # cname
196 #
197 CuesReceiver instproc stop_blink { cue cname } {
198         $self instvar top_ colors_ ${cname}_info_
199 
200         if { [info exists ${cname}_info_($cue)] } {
201                 unset ${cname}_info_($cue)
202                 set w ${top_}.${cue}
203                 if [winfo exists $w] {
204                         $w conf -background $colors_(0)
205                 }
206         }
207         if { [info exists ${cname}_info_(${cue}_after)] } {
208                 after cancel [set ${cname}_info_(${cue}_after)]
209         }
210 }
211 
212 #
213 # Recursive function to continously blink the cue
214 # image until N seconds (FIXME now set to 30, probably
215 # should let the client decide)
216 #
217 CuesReceiver instproc blinklite { interval cue cname } {
218         $self instvar ${cname}_info_ colors_ cname_ top_
219 
220         # if stop_blink has been called, don't continue
221         if ![info exists ${cname}_info_($cue)] {
222                 return
223         }
224 
225         # if it has been blinking for more than 30 seconds, stop
226         if { [set ${cname}_info_(${cue}_accum)] >= 30000 } {
227                 $self stop_blink $cue $cname
228                 return
229         }
230 
231         set ${cname}_info_(${cue}_color) \
232                 [expr {([set ${cname}_info_(${cue}_color)] + 1) % 2}]
233 
234         set ${cname}_info_(${cue}_accum) \
235                 [expr [set ${cname}_info_(${cue}_accum)] + $interval]
236 
237         # only blink if it is enabled
238         if { "$cname_" == "$cname" } {
239                 ${top_}.${cue} conf \
240                         -background $colors_([set ${cname}_info_(${cue}_color)])
241         }
242 
243         set ${cname}_info_(${cue}_after) \
244                 [after $interval \
245                  "$self blinklite [expr int($interval * 1.05)] $cue $cname"]
246 }
247 
248 

~ [ 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.