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

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

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

  1 # application-mb.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1997-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/mb/application-mb.tcl,v 1.71 2002/02/03 04:27:17 lim Exp $
 32 
 33 
 34 import RTPApplication MTrace Tcl_Player Tcl_Recorder \
 35         AddressBlock NetworkManager \
 36         MBDebugDlg MBUI MBPSInterp MB_Manager MBPageMgr FontInitializer MBNet
 37 
 38 # The mediaboard application.
 39 Class MBApp -superclass RTPApplication
 40 
 41 #
 42 # Initialize the global variables we need
 43 # Creates a frame using the provided <i>widgetPath</i> and packs the mediaboard into it.
 44 #
 45 MBApp public init { widgetPath argv } {
 46         $self instvar mbui_
 47 
 48         $self next mb
 49 
 50         set o [$self options]
 51         $self init_args $o
 52         $self init_resources $o
 53         $self init_fonts $o
 54         $o load_preferences "mb"
 55         set argv [$o parse_args $argv]
 56         #FIXME check for extra args?
 57 
 58         MTrace init {trcMB}
 59         $self check_rtp_sdes
 60 
 61         $self init_variables
 62         $self init_UI $widgetPath
 63         $self instvar mgr_
 64         set mbnet [new MBNet $mbui_ $mgr_]
 65         $self instvar session_ mbAgent_
 66         set session_ [$mbnet session]
 67         set mbAgent_ [$mbnet mbAgent]
 68         $mbnet adjust_spec
 69 
 70         set logf [$o get_option playScript]
 71         if {"none" != $logf} {
 72                 global mb
 73                 set isRT [$config get_option rtPlay]
 74                 set player [new Tcl_Player $logf [$self set sender_] $isRT]
 75                 # wait for 1 second for everything to settle down
 76                 after 15000 $player start
 77         }
 78 
 79         $self init_local
 80 }
 81 
 82 #
 83 MBApp public destroy {} {
 84         $self instvar mbAgent_ mbui_ mgr_
 85         global mb
 86         # agent will delete the session
 87         delete $mbAgent_
 88         delete $mbui_
 89         delete $mb(gsinterp)
 90         delete $mgr_
 91 }
 92 
 93 #
 94 MBApp public exit {} {
 95         delete $self
 96         exit
 97 }
 98 
 99 #
100 MBApp instproc init_args {o} {
101         # temporary parameter for debugging
102         $o register_option -u    uid
103         $o register_option -dbg  debug
104 
105         # session address
106         $o register_option -sa   mbSessionSpec
107         $o register_option -ui   showUI
108         $o register_option -drop drop
109         $o register_option -play playScript
110         $o register_option -rt   rtPlay
111         $o register_option -rec  record
112         $o register_option -tr   trace
113         $o register_option -dp   delayParams
114         $o register_option -follow followActive
115         $o register_option -C conferenceName
116         $o register_option -K sessionKey
117 
118         $o register_boolean_option -recvonly recvOnly
119 
120         $o register_option -geometry geometry
121 
122         # MeGa resources
123         $o register_option -rport megaRecvMbPort
124         $o register_option -ofmt megaMbFormat
125         $o register_option -usemega megaMbSession
126         $o register_option -megactrl megaMbCtrl
127         $o register_option -sspec mbSessionSpec
128         $o register_option -maxsbw maxMbSessionBW
129         $o register_option -sbw mbSessionBW
130         $o register_option -sloc mbServiceLocation
131 }
132 
133 #
134 MBApp instproc ui_init_default { } {
135         # using 19 as the priority level, since it's one less than
136         # widgetDefault, which is the level used by all WidgetClass objects
137 
138         option add *Button*HighlightThickness 1 19
139         option add *Button*BorderWidth 1 19
140 
141         option add *Scrollbar*HighlightThickness 1 19
142         option add *Scrollbar*BorderWidth 1 19
143 
144         # FIXME: a hack to shrink the scrollbar size
145         set scrollbar [scrollbar .___scrollbar___]
146         set scrollbarWidth [$scrollbar cget -width]
147         set scrollbarWidth [expr {($scrollbarWidth * 2)/3}]
148         destroy $scrollbar
149         option add *Scrollbar*Width $scrollbarWidth 19
150 
151         option add *Entry*HighlightThickness 1 19
152         option add *Entry*BorderWidth 2 19
153         option add *Entry*Background White 19
154         option add *Menubutton*HighlightThickness 1 19
155         option add *Menubutton*BorderWidth 1 19
156 }
157 
158 #
159 MBApp instproc init_variables {} {
160         global mb
161 
162         $self ui_init_default
163         catch {unset mb}
164 
165         $self instvar sender_
166         if {[$self get_option record]==1} {
167                 set sender_ [new Tcl_Recorder MB_Sender]
168         } else {
169                 set sender_ [new MB_Sender]
170         }
171 
172         $self instvar mgr_
173         set mgr_ [new MB_Manager]
174         set pageMgr [new MBPageMgr $mgr_]
175         $mgr_ attach_page_manager $pageMgr
176         $mgr_ attach_sender $sender_
177 }
178 
179 #
180 MBApp instproc reset { ab } {
181         $self instvar mbAgent_ mbui_ mgr_ session_
182 
183         set nm [$mbAgent_ set network_]
184         $nm loopback 1
185 
186         # do this for the first time only
187         $self instvar have_network_
188         if {![info exists have_network_] || $have_network_ == 0} {
189                 $session_ start_timers
190                 [$self set sender_] attach $mgr_
191                 set have_network_ 1
192         }
193 
194         $mbui_ reset $session_
195 }
196 
197 #
198 # Creates a frame using the provided <i>widgetPath</i> and packs the mediaboard into it.
199 #
200 MBApp instproc init_UI { widgetPath } {
201         $self instvar mgr_ sender_
202         frame $widgetPath
203         $self set mbui_ [ new MBUI $widgetPath $mgr_ $sender_ [$self get_option showUI] "$self exit" ]
204         pack $widgetPath -expand 1 -fill both
205 }
206 
207 # use the common search_font for tcl v8 or greater
208 if { $tcl_version < 8 } {
209         MBApp instproc search_font { foundry style weight points attr} {
210                 global font tcl_version
211                 $self instvar name_
212 
213                 foreach f $font($points) {
214                 set fname -$foundry-$style-$weight-$attr-$f
215                         if [havefont $fname] {
216                                 return $fname
217                         }
218                 }
219                 puts stderr "Mb: can't find $weight $fname font (using fixed)"
220                 if ![havefont fixed] {
221                         puts stderr "Mb: can't find fixed font"
222                         exit 1
223                 }
224                 return fixed
225         }
226 }
227 
228 #
229 MBApp instproc init_fonts {o} {
230         new FontInitializer $o
231 
232         # override the default fonts
233         $o add_option smallfont [$o get_option helv10]
234         $o add_option medfont [$o get_option helv12]
235         $o add_option helpFont [$o get_option times12]
236 }
237 
238 #
239 # These can be overridden.
240 #
241 MBApp instproc init_resources {o} {
242         global env
243         $self instvar class_
244 
245         option add *Radiobutton.relief flat startupFile
246 
247         # option add Mb.geometry 700x500 startupFile
248 
249         # used by Object
250         $o add_default debug 1
251 
252         # used by MBApp
253         $o add_default playScript none
254         $o add_default rtPlay 0
255         $o add_default record 0
256         $o add_default iconPrefix MediaBoard
257         $o add_default showUI 1
258 
259         $o add_default trace none
260 
261         # default added by MBNet, used by AddressBlock
262         $o add_default defaultTTL 31
263 }
264 
265 

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