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

Open Mash Cross Reference
mash/tcl/vic/application-vic.tcl

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

  1 # application-vic.tcl --
  2 #
  3 #       Main vic object (VicApplication) definition.
  4 #
  5 # Copyright (c) 1996-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/application-vic.tcl,v 1.106 2004/05/27 00:13:54 larry Exp $
 32 
 33 
 34 import RTPApplication Configuration AddressBlock CoordinationBus \
 35         VideoHandler AudioAgent VicUI ExtOut \
 36         FontInitializer WidgetResourceInitializer
 37 
 38 #
 39 # The base class for the vic application.  Parses the command line
 40 # arguments, creates all the necessary agents and objects, configures
 41 # them, and splices them together.
 42 # Creates a frame using the provided <i>widgetPath</i> and packs the vic ui in it.
 43 #
 44 Class VicApplication -superclass RTPApplication
 45 
 46 #
 47 # The vic application constructor.  Parse the command line
 48 # options in argument <i>argv</i> and build the app.
 49 #
 50 VicApplication instproc init {widgetPath argv} {
 51         $self next vic
 52 
 53         # Initialization of variables and resource db options
 54         set o [$self options]
 55         $self init_args $o
 56         # Search for some good fonts for the user interface and intial
 57         # the configuration options accordingly.
 58         new FontInitializer $o
 59         option add *Font [$o get_option helv12b] startupFile
 60         $self init_resources $o
 61         $o load_preferences "rtp vic"
 62         set argv [$o parse_args $argv]
 63 
 64         # For ucl vic compatibility:
 65         # Sorry, but we need to usurp the Tk options database
 66         # for the user_hook file to get Vic.* options
 67         global defaultPort defaultFormat defaultNorm
 68 #       puts "***Sourcing user_hook"
 69         rename option builtin_option
 70         proc option args {
 71                 upvar self mySelf
 72                 set handled 0
 73                 if {[llength $args] > 2 && [lindex $args 0] == "add"} {
 74                         if [regexp {Vic\.(\S+)} [lindex $args 1] match opt] {
 75                                 set val [lindex $args 2]
 76                                 # Translate ucl options to openmash
 77                                 if { $opt == "device" } \
 78                                         { set opt "defaultDevice" }
 79                                 if { $opt == "bandwidth" } \
 80                                         { set val [expr $val * 1000] }
 81 #                               puts "***Add option $opt $val"
 82                                 $mySelf add_option $opt $val
 83                                 set handled 1
 84                         }
 85                 }
 86                 if !$handled {
 87 #                       puts "***Builtin option $args"
 88                         builtin_option $args
 89                 }
 90         }
 91 
 92         # Source the user's hook file if it exists. The function
 93         # user_hook, which may be defined in this file, will be
 94         # called at the end of init.
 95         if {[$o get_option userhookFile] != ""} {
 96                 if {[file isfile [$o get_option userhookFile]] && \
 97                         [file readable [$o get_option userhookFile]]} {
 98                         source [$o get_option userhookFile]
 99                 } else {
100                         puts stderr "Unable to source \"[$o get_option userhookFile]\". Not a file or not readable."
101                 }
102         }
103 
104         # Put back the builtin proc option
105         rename option ""
106         rename builtin_option option
107 
108         set spec [$self check_hostspec $argv [$self get_option megaVideoSession]]
109         $self check_rtp_sdes
110         . config -height 200 -width 200
111 
112         # Backward compat. -B flag is kb/s.
113         set t [$self get_option maxbw]
114         if { $t > 0 } {
115                 $o add_option maxbw [expr 1000*$t]
116         }
117 
118         #XXX need to do this to size the bandwidth slider in the GUI
119         set ab [SessionAddress parse $spec]
120         if { $ab != "" } {
121                 $o add_option maxbw [$ab maxbw]
122                 delete $ab
123         }
124 
125         # Create a Coordination Bus
126         if [catch {$self init_confbus} msg] {
127                 $self warn "Error initializing conference bus: $msg"
128         }
129 
130         # Create a VideoAgent, VideoPipeline, and possibly
131         # set them up to use SCUBA
132         $self instvar agent_ vpipe_ handler_ scuba_sess_
133         set handler_ [new VideoHandler $spec]
134         set agent_ [$handler_ agent]
135         set vpipe_ [$handler_ vpipe]
136         if { [$self get_option useScuba] != "" } {
137                 set scuba_sess_ [$handler_ set scuba_sess_]
138         }
139 
140         # Create the user interface for this application.
141         $self instvar ui_
142         set ui_ [$self init_ui $widgetPath $spec]
143 
144         #
145         # More local coordination bus events
146         # - receive a switch session message from a vrm-eventlistener
147         #   on the same machine
148         #
149         $self instvar local_chan_ glob_chan_
150         set cb $local_chan_
151         if { $cb != "" } {
152                 $cb register SET_SESSION "$self set_session"
153         }
154 
155         # Add audio to this app.
156         set aspec [$self get_option audioSessionSpec]
157         if { $aspec != "" } {
158                 $self instvar audioUI_ audioAgent_
159                 set audioAgent_ [new AudioAgent $self $aspec]
160                 set audioUI_ [$ui_ create-audio-ui $audioAgent_]
161                 $audioAgent_ attach $audioUI_
162                 $o add_option geometry 330x350
163         }
164 
165         $self user_hook
166 
167         # If transmitting on startup, select the initial device
168         # and start transmitting
169         if { [$self get_option TransmitOnStartup]!={} } {
170                 $self selectInitialDevice
171         }
172 }
173 
174 VicApplication instproc set_session args {
175         $self instvar ui_
176         # Get session spec from args
177         set spec [lindex $args end]
178         # Check for valid spec
179         set err "CoordinationBus SET_SESSION: Invalid session specification"
180         if {$spec != ""} {
181                 # we need to create the AddressBlock with a valid spec or it will 
182                 # exit mash by calling "$self fatal", which cannot be catched 
183                 # because it ends up calling "exit 1" at Log::fatal{} 
184                 # (mash/tcl/common/log.tcl).
185                 set ab [new AddressBlock 224.1.1.1/11111]
186                 set err [$ab parse $spec]
187                 delete $ab
188         }
189         if {$err != ""} {
190                 Log warn $err
191                 return 0
192         }
193         # Switch to new session
194 #       puts "Switch to session $spec"
195         $ui_ switch-agent $spec
196 }
197 
198 #
199 # Build the main vic user interface and pack it into a newly created
200 # window in the default top-level window.  Call init_confbus before this
201 # method, so that instvars local_chan_ and glob_chan_ are set.
202 # Creates a frame using the provided <i>widgetPath</i> and packs the vic ui in it.
203 #
204 VicApplication instproc init_ui { widgetPath spec } {
205         $self instvar agent_ vpipe_ scuba_sess_
206         $self instvar local_chan_ glob_chan_
207 
208         frame $widgetPath
209         set ui [new VicUI $widgetPath $local_chan_ $glob_chan_ $agent_ $vpipe_ "$self exit" $spec [$self get_option useScrollbars] [$self get_option autoPlace]]
210         pack $widgetPath -expand 1 -fill both
211         update idletasks
212 
213         if { [$self get_option useScuba] != "" } {
214                 $ui set scuba_sess_ $scuba_sess_
215         }
216 
217         return $ui
218 }
219 
220 #
221 # A hook to gracefully shut down vic.  Shuts down the
222 # underlying video agent and terminates the application.
223 #
224 VicApplication instproc exit {} {
225         $self instvar vpipe_
226         $self instvar agent_
227 
228         $vpipe_ destroy
229         $agent_ shutdown
230         exit 0
231 }
232 
233 #
234 # Register all of the command line options understood
235 # by vic with the generic command-line parser.
236 #
237 VicApplication private init_args o {
238         $o register_option -a audioSessionSpec
239         $o register_option -b netBufferSize
240         $o register_option -B maxbw
241         $o register_option -C conferenceName
242         $o register_option -c dither
243         $o register_option -D defaultDevice
244         $o register_option -f videoFormat
245         $o register_option -F maxfps
246         $o register_option -I confBusChannel
247         $o register_option -K sessionKey
248         $o register_option -M colorFile
249         $o register_option -m mtu
250         $o register_option -o outfile
251         $o register_option -q jpegQfactor
252         $o register_option -t defaultTTL
253         $o register_option -T softJPEGthresh
254         $o register_option -U stampInterval
255         $o register_option -u userhookFile
256         $o register_option -V visual
257         $o register_option -N rtpName
258         $o register_list_option -map rtpMap
259 
260         # -S 0 will not suppress anything, 1 will suppress blue, 
261         #  2 will supress blue and black, and 3 
262         #  will use aggressive suppression of both blue and black
263         $o register_option -S suppress
264 
265         # Specify options for codecs.
266         # e.g., -codec h263:modQ -codec h263:rfc2429 sets the
267         # options for modified quantization coding (see annex T
268         # of H.263 standard) and RFC 2429 framing (h263-1998)
269         $o register_list_option -codec codecOpts 
270 
271         $o register_boolean_option -H useHardwareDecode
272         $o register_boolean_option -P privateColormap
273         $o register_boolean_option -scroll useScrollbars
274         $o register_boolean_option -auto autoPlace
275 
276         $o add_default rtptvCompat 0
277         $o register_boolean_option -rtptv rtptvCompat
278 
279         # MeGa resources
280         $o register_option -rport megaRecvVideoPort
281         $o register_option -ofmt megaVideoFormat
282         $o register_option -usemega megaVideoSession
283         $o register_option -megactrl megaVideoCtrl
284         $o register_option -sspec videoSessionSpec
285         $o register_option -maxsbw maxVideoSessionBW
286         $o register_option -sbw videoSessionBW
287         $o register_option -sloc videoServiceLocation
288          
289         $o register_boolean_option -scuba useScuba
290         # For MeGa use only.
291         $o register_boolean_option -localscuba localScubaScope
292         # cues option
293         $o register_boolean_option -useCues useCues
294 
295         $o register_boolean_option -useRLM useRLM
296 
297         # use camera controls
298         $o register_boolean_option -camctrl camctrl
299 
300         # the local rendezvous address (if specified)
301         $o register_option -rendez rendez
302 
303         $o register_boolean_option -fx specialFX
304         $o add_default specialFX 0
305 }
306 
307 #
308 # FIXME: move this out.
309 #
310 VicApplication instproc reset { ab } {
311         $self instvar handler_ ui_
312         if ![info exists handler_] {return}
313         $handler_ reset $ab
314         if ![info exists ui_] {return}
315         $ui_ reset
316 }
317 
318 #
319 # Initialize the configuration data base with all of the default
320 # options assumed by vic.  These can be overridden.
321 #
322 VicApplication private init_resources o {
323         global tcl_platform
324         new WidgetResourceInitializer
325 
326         # used by TopLevelWindow and for VicUI's window-title
327         $o add_default iconPrefix vic:
328 
329         # used when creating new CoordinationBus; get and set by AddressBlock
330         $o add_default defaultTTL 16
331 
332         # WAS used by init_confbus
333         $o add_default confBusChannel 0
334 
335         # used by ControlMenu; get and possibly set by AddressBlock
336         $o add_default videoFormat h.261
337 
338         # used by VideoPipeline; set by ControlMenu
339         $o add_default useJPEGforH261 false
340 
341         # used by MetworkMananger; only apps that set this are vic and mui.  maybe it should be add_option
342         $o add_default useLayersWindow 1
343 
344         $o add_default useRLM 0
345         $o add_default camctrl 0
346         $o add_default suppress 0
347         $o add_default jvColors 32
348         $o add_default softJPEGthresh -1
349         $o add_default softJPEGcthresh 6
350 
351         # used by VicApplication and ControlMenu
352         # (scuba) default session bandwidth (kb/s).
353         $o add_default maxVideoSessionBW 1000000
354 
355         # used by the Info window and ControlMenu
356         if {$tcl_platform(platform) != "windows"} {
357                 option add Vic.background gray85 startupFile
358                 option add Vic.foreground black startupFile
359                 option add Vic.disabledForeground gray40 startupFile
360                 $o add_default background gray85
361                 $o add_default foreground black
362                 $o add_default disabledForeground gray40
363         } else {
364                 set b [button .b____dummy____$self]
365                 $o add_default background [$b cget -background]
366                 $o add_default foreground [$b cget -foreground]
367                 $o add_default disabledForeground [$b cget -disabledforeground]
368                 destroy $b
369         }
370 
371         # used by VicUI.
372         $o add_default useScrollbars false
373         $o add_default autoPlace false
374         $o add_default transmitOnStartup 0
375 }
376 
377 #
378 # Create a global bus for communication between tools
379 # on different machines, and a local bus for tools on
380 # the same machine.
381 #
382 VicApplication instproc init_confbus {} {
383         #set channel [$self get_option confBusChannel]
384         #$self instvar cb_
385         #if { $channel != "" && $channel != 0 } {
386         #       set cb_ [new CoordinationBus -channel $channel]
387         #} else {
388         #       set cb_ ""
389         #}
390 
391         set channel [$self get_option confBusChannel]
392         if {$channel == ""} {set channel 2}
393 
394         $self instvar local_chan_ glob_chan_
395         set local_chan_ [new CoordinationBus -channel $channel]
396 
397         incr channel
398         set ttl [$self get_option defaultTTL]
399         set glob_chan_ [new CoordinationBus -channel $channel -ttl $ttl]
400 }
401 
402 

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