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

Open Mash Cross Reference
mash/tcl/applications/player/app-player.tcl

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

  1 # app-player.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/applications/player/app-player.tcl,v 1.10 2002/02/03 04:22:14 lim Exp $
 32 
 33 
 34 import Application FileDialog/Archive PlayerUI/EditStream PlayerUI/Main ArchiveSession/Play/RTP ArchiveSession/Play/SRM
 35 
 36 #  This class implements policy for the player application
 37 #  <p> Status: Beta
 38 
 39 
 40 Class Application/Player -superclass Application
 41 
 42 
 43 Application/Player instproc init { } {
 44         $self next player
 45         #$self instvar options_
 46         set options_ [$self options]
 47         $self init_resources $options_
 48         $class set instance_ $self
 49 
 50     # Hide the root window offscreen so it's not visible.  We can't just
 51     # withdraw or iconify it because, on Windows, that will also
 52     # withdraw/iconify all the transient windows used as dialogs.
 53     # Unfortunately, we have to force a window update and then reposition it
 54     # offscreen because some Unix window managers adjust the positions of
 55     # windows when they first appear.
 56     #
 57     label .label -text {Starting up...}
 58     pack .label -fill both -expand true
 59     set x [expr int([winfo screenwidth .] / 2)]
 60     set y [expr int([winfo screenheight .] / 2)]
 61     wm geometry . +$x+$y
 62     update idletasks
 63     .label configure -text {Running...}
 64     set x [expr [winfo screenwidth .] + 32]
 65     set y [expr [winfo screenheight .] + 32]
 66     wm geometry . +$x+$y
 67 
 68         $self set file_dialog_ [FileDialog/Archive .file_dialog \
 69                         -transient . ]
 70         $self set edit_stream_dialog_ [PlayerUI/EditStream .edit_stream_dialog\
 71                         -transient . ]
 72         $self set main_ui_ [PlayerUI/Main .player_ui \
 73                         -closecmd "delete $self; exit"]
 74 }
 75 
 76 
 77 Application/Player instproc init_resources o {
 78         $o add_default drop 0
 79         $o add_default debug 0
 80         $o add_default rtPlay 0
 81         $o add_default record 0
 82         $o add_default uid none
 83         $o add_default trace none
 84         $o add_default delayParams default
 85 
 86         $o add_default defaultTTL 31
 87 }
 88 
 89 
 90 Application/Player instproc destroy { } {
 91         $self instvar file_dialog_ main_ui_
 92         if [info exists file_dialog_] { destroy $file_dialog_ }
 93         if [info exists main_ui_] { destroy $main_ui_ }
 94 }
 95 
 96 
 97 Application/Player proc instance { } {
 98         return [$self set instance_]
 99 }
100 
101 
102 Application/Player instproc file_dialog { } {
103         return [$self set file_dialog_]
104 }
105 
106 
107 Application/Player instproc edit_stream_dialog { } {
108         return [$self set edit_stream_dialog_]
109 }
110 
111 
112 Application/Player instproc lts { } {
113         return [$self set lts_]
114 }
115 
116 
117 Application/Player instproc main_ui { } {
118         return [$self set main_ui_]
119 }
120 
121 
122 Application/Player instproc parse_args { argv } {
123         $self instvar no_input_ main_ui_
124         set no_input_ 0
125 
126         set len [llength $argv]
127         set idx 0
128         while { $idx < $len } {
129                 set option [lindex $argv $idx]
130                 incr idx
131                 switch -exact -- $option {
132                         -catalog {
133                                 if { $idx >= $len } {
134                                         error "missing argument for\
135                                                         -catalog"
136                                 }
137                                 $main_ui_ read_catalog \
138                                                 [lindex $argv $idx]
139                                 incr idx
140                         }
141 
142                         -addsession {
143                                 if { $idx >= $len } {
144                                         error "missing argument for\
145                                                         -addsession"
146                                 }
147                                 set arg [lindex $argv $idx]
148                                 if { [llength $arg] != 3 } {
149                                         error "invalid argument to\
150                                                         -addsession: $arg.\
151                                                         must be \"<protocol>\
152                                                         <media> <addr>\""
153                                 }
154                                 $main_ui_ add_session [lindex $arg 0] \
155                                                 [lindex $arg 1] [lindex $arg 2]
156                                 incr idx
157                         }
158 
159                         -addstream {
160                                 if { $idx >= $len } {
161                                         error "missing argument for\
162                                                         -addstream"
163                                 }
164                                 set arg [lindex $argv $idx]
165                                 if { [llength $arg] != 2 } {
166                                         error "invalid argument to\
167                                                         -addstream: $arg.\
168                                                         must be \"<datafile>\
169                                                         <indexfile>\""
170                                 }
171 
172                                 eval [list $self] add_stream $arg
173                                 incr idx
174                         }
175 
176                         -noinput {
177                                 set no_input_ 1
178                         }
179 
180                         default {
181                                 $self usage
182                         }
183                 }
184         }
185 }
186 
187 
188 Application/Player instproc add_stream { datafile indexfile } {
189         set file [new ArchiveFile]
190 
191         if [catch {$file open $datafile} error] {
192                 error "Error opening data file:\n$error"
193         }
194 
195         if [catch {$file header data_hdr} error] {
196                 error "Error reading data header:\n$error"
197         }
198 
199         $file close
200 
201 
202         if [catch {$file open $indexfile} error] {
203                 error "Error opening index file:\n$error"
204         }
205 
206         if [catch {$file header index_hdr} error] {
207                 error "Error reading data header:\n$error"
208         }
209 
210         $file close
211 
212 
213         if { $data_hdr(protocol)!=$index_hdr(protocol) } {
214                 error "Protocol fields do not match in data and index files"
215         }
216 
217         if { $data_hdr(media)!=$index_hdr(media) } {
218                 error "Media fields do not match in data and index files"
219         }
220 
221         if { $data_hdr(cname)!=$index_hdr(cname) } {
222                 error "cname fields do not match in data and index files"
223         }
224 
225         if { $data_hdr(name)!=$index_hdr(name) } {
226                 error "Name fields do not match in data and index files"
227         }
228 
229         delete $file
230         $self instvar main_ui_
231         $main_ui_ add_stream $data_hdr(name) $datafile $indexfile \
232                         $data_hdr(protocol) $data_hdr(media)
233 }
234 
235 
236 
237 Application/Player instproc usage { } {
238         puts "Usage: player \[options\]"
239         puts "\t-catalog <file>: read session information from session catalog"
240         puts "\t                    (this flag erases any previous sessions"
241         puts "\t                    added using -addsession/-addstream)"
242         puts "\t-addsession \"<protocol> <media> <address>\": add this session"
243         puts "\t                                       to the play list"
244         puts "\t\t\t<protocol>: SRM or RTP"
245         puts "\t\t\t<media>:    mediaboard, video, audio, etc."
246         puts "\t\t\t<address>:  <multicast group>/<port number>"
247         puts "\t-addstream \"<datafile> <indexfile>\": add this stream to the"
248         puts "\t                                       play list"
249         puts "\t-noinput: do not pop up the initial input dialog\n"
250 
251         exit
252 }
253 
254 
255 Application/Player instproc run { } {
256         $self instvar main_ui_ no_input_
257         $main_ui_ center
258         if { ! $no_input_ } {
259                 tkwait variable [$main_ui_ tkvarname input_done_]
260         }
261         $self start_play
262         return 1
263 }
264 
265 
266 Application/Player instproc start_play { } {
267         $self instvar main_ui_ start_ end_ lts_
268         set start_ 0
269         set end_ 0
270         $main_ui_ playback_ui
271 
272         set list [$main_ui_ subwidget session_list]
273         set lts_ [new LTS]
274         set ttl  [$main_ui_ set ttl_]
275         foreach session_widget [$list info all] {
276                 set item_widget [$list info widget -id $session_widget]
277                 set value [$item_widget cget -value]
278                 set protocol [string trim [lindex $value 0]]
279                 set media    [string trim [lindex $value 1]]
280                 set address  "[string trim [lindex $value 2]]/none/$ttl"
281 
282                 set session [new ArchiveSession/Play/$protocol $media \
283                                 $address]
284                 $session attach_observer $session_widget
285                 $session_widget attach_session $session
286         }
287 
288         $main_ui_ config_scale $start_ $end_
289         $lts_ now_logical $start_
290         $lts_ speed 1.0
291 }
292 
293 
294 Application/Player instproc clip_time { start end } {
295         $self instvar start_ end_
296         if { $start_==0 || $start < $start_ } {
297                 set start_ $start
298         }
299         if { $end_==0 || $end > $end_ } {
300                 set end_ $end
301         }
302 }
303 
304 

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