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

Open Mash Cross Reference
mash/tcl/tgw/tgw-ui.tcl

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

  1 # tgw-ui.tcl --
  2 #
  3 #       This file has the main ui component of the tgw application. Also, it
  4 #       contains many of the slightly modified superclasses to make things
  5 #       work... This is the main file with all the code in it.
  6 #
  7 # Copyright (c) 2000-2002 The Regents of the University of California.
  8 # All rights reserved.
  9 #
 10 # Redistribution and use in source and binary forms, with or without
 11 # modification, are permitted provided that the following conditions are met:
 12 #
 13 # A. Redistributions of source code must retain the above copyright notice,
 14 #    this list of conditions and the following disclaimer.
 15 # B. Redistributions in binary form must reproduce the above copyright notice,
 16 #    this list of conditions and the following disclaimer in the documentation
 17 #    and/or other materials provided with the distribution.
 18 # C. Neither the names of the copyright holders nor the names of its
 19 #    contributors may be used to endorse or promote products derived from this
 20 #    software without specific prior written permission.
 21 #
 22 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 23 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 24 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 25 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 26 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 27 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 28 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 29 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 30 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 31 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 32 
 33 
 34 import Switcher \
 35         ActiveSourceManager \
 36         CuesReceiver VisualFrame ActiveSource AudioAgent RealServerUI H261TranscoderAddrInput RedirUI RealConfigUI OutgoingReal OutgoingCombiner VideoAgent OutgoingH261 AddressBlock/Simple Network OutgoingRedir Observer
 37 
 38 # this is the file that defines the UI and the member objects for TGW. Actually, everything is implemented in here.
 39 
 40 
 41 # This is a subclass of ActiveSourceManager that basically just changes the UI that it uses to display the streams so that we can manipulate it to add new options.
 42 
 43 Class ActiveSourceManagerTGW -superclass ActiveSourceManager
 44 
 45 ActiveSourceManagerTGW public really_activate src {
 46         $self instvar grid_ curcol_ currow_ ui_ list_direction_ localChannel_
 47 
 48         set as [new ActiveSource $self $ui_ $grid_.$src $src $localChannel_]
 49 
 50         grid $grid_.$src -row $currow_ -column $curcol_ -sticky we
 51 
 52     #inserted by Tim to attach the stream and also make the GUI
 53         $ui_ attach_stream $src $self $grid_ $currow_
 54     #end of insertion
 55 
 56         if { $list_direction_ == "vertical" } {
 57                 grid columnconfigure $grid_ $curcol_ -weight 1
 58         } else {
 59                 grid rowconfigure $grid_ $currow_ -weight 1
 60         }
 61 
 62         $ui_ update_decoder $src
 63 
 64         $self bump
 65 
 66         #
 67         # Someone became activated, so we have to change
 68         # the switchable menu to include this participant
 69         #
 70         Switcher rebuild_switch_list_menu
 71 
 72         # XXX this is a temporary hack while cindy works on the VideoBox class...
 73         if {[$ui_ info class] == "MuiUI"} {
 74                 $ui_ maybe_switch_in $src
 75         }
 76 }
 77 
 78 # Adds the "source" title at the top of the sources column
 79 ActiveSourceManagerTGW public add_active { as src } {
 80         $self instvar active_ grid_ currow_ curcol_ tgwTitleCol_
 81         if { [array size active_] == 0 } {
 82             $self next $as $src
 83             frame $grid_.title(0) -relief sunken -borderwidth 1
 84             label $grid_.title(0).label -text Sources -font [$self get_option smallfont] -relief flat
 85             pack $grid_.title(0).label
 86             grid $grid_.title(0) -row 0 -column 0 -sticky we
 87             grid columnconfigure $grid_ 0 -weight 1
 88             $self bump
 89         } else {
 90             $self next $as $src
 91         }
 92 }
 93 
 94 # this is a subclass of AudioAgent that we need to create so that the app doesn't use the soundcard that is actually on the machine, but instead it uses the virtual soundcard that will give the sample to the RealAudio encoder.
 95 
 96 Class AudioAgentTGW -superclass AudioAgent
 97 
 98 AudioAgentTGW public init { app spec RealEnc {callback {}} } {
 99     $self instvar deviceName audioDevice_
100     set deviceName "Audio/RealAudioVirtualDevice"
101     $self next $app $spec $callback
102     #link the output of the virtual device to go to the RealEncoder
103     set temp [$audioDevice_ set audio_]
104     $temp linkEncoder $RealEnc
105 }
106 
107 # This is the main UI for TGW
108 
109 Class TGWUI -superclass Observer -configuration {
110         minwidth 200
111         minheight 100
112         filterGain 0.25
113         geometry {}
114         vain false
115 }
116 
117 TGWUI instproc window-title { prefix name } {
118         $self instvar name_ prefix_
119         set name_ $name
120         set prefix_ $prefix
121 
122         wm iconname . "$prefix_ $name_"
123         wm title . "$prefix_ $name_"
124 
125 }
126 
127 
128 # Build the user-interface.
129 TGWUI instproc init { w localChannel globalChannel videoAgent vpipe exitCmd useUI rServer rStream } {
130         $self next 
131         $self instvar localChannel_ globalChannel_ videoAgent_ vpipe_ exitCmd_ 
132         set localChannel_ $localChannel
133         set globalChannel_ $globalChannel
134         set videoAgent_ $videoAgent
135         set vpipe_ $vpipe
136         set exitCmd_ "$exitCmd"
137 
138         # let this ui be an observer of the VideoAgent so it can catch "trigger_sdes"
139         $videoAgent attach $self
140 
141         $self build_gui $w
142 
143         $self set-geometry
144 
145 }
146 
147 TGWUI instproc reset {} {
148         $self new_hostspec
149 }
150 
151 TGWUI instproc build_gui { w } {
152         $self instvar videoAgent_ userwindows_ path_ vpipe_ asm_ localChannel_ globalChannel_
153 
154         $self set_rate_vars [$videoAgent_ set session_]
155 
156         $self instvar id_
157         set id_ [after 1000 "$self periodic_update"]
158 
159         #
160         # Configure the Switcher class to ignore attempts to switch
161         # to the local source, since this is not interesting (unless
162         # we set the "vain" configuration option to true).
163         #
164         if { ![$self yesno vain] && [$videoAgent_ have_network] } {
165                 Switcher set ignore_([$videoAgent_ local]) 1
166         }
167 
168         $self layout_gui $w
169 
170         #
171         # Local coordination bus events
172         # - receive a focus speaker message from vat running on the
173         #   same machine as this vic
174         #
175         set cb $localChannel_
176         if { $cb != "" } {
177                 $cb register FOCUS_SPEAKER "$asm_ focus_speaker"
178         }
179 
180         #
181         # Global coordination bus events
182         # - receive a aware {ear,hand,yes,no} message from vat
183         #   running on others machine
184         # - receive an unaware of the same types
185         #
186         # CuesReceiver handle these events, this is created only
187         # when the user specified to do so on the command line
188         #
189         set cb $globalChannel_
190         if { [$self yesno useCues] && $cb!="" }  {
191                 CuesReceiver set_cb $cb
192         }
193 }
194 
195 # Given widget <i>w</i>, create frame $w.top, initializing its visual and colormap.
196 # Within this frame, a frame ($w.top.f) is created for holding either a label (instvar label_)
197 # or another frame (instvar grid_).
198 # A few keybinbdings are assigned.
199 #
200 
201 TGWUI public layout_gui {w} {
202         $self instvar asm_ controlMenu_ videoAgent_ vpipe_ vframe_ exitCmd_ localChannel_
203 
204         set vframe_ [new VisualFrame $w.top]
205 
206         set asm_ [new ActiveSourceManagerTGW $self $w.top $videoAgent_ vertical $localChannel_]
207         $vframe_ attach_observer $asm_
208         foreach i { 1 2 3 4 } {
209                 bind . <Key-$i> "$asm_ redecorate $i"
210         }
211 
212         pack $w.top -expand 1 -fill both
213 
214         $self build_menubar $w.top.bar
215         pack $w.top.bar -fill x -side bottom
216 
217         $asm_ init_grid $w.top.f
218         pack $w.top.f -expand 1 -fill both -side top
219 }
220 
221 # Size the "." window using values from the resource database:
222 # <i>minwidth</i>, <i>minheight</i>, and <i>geometry</i> (all in
223 # pixels).  Specify <i>geometry</i> in the form wXh or set it to empty
224 # string, {}, to cancel the existing user-specified geometry and revert
225 # to the size requested internally by its widgets.
226 #
227 TGWUI instproc set-geometry {} {
228         #
229         # Withdraw window so that user-placement is deferred
230         # until after initial geometry is computed
231         #
232         global mash
233         if { ![info exists mash(environ)] || $mash(environ)!="mplug" } {
234             wm withdraw .
235         }
236         wm geometry . [$self get_option geometry]
237         update idletasks
238         set minwidth [winfo reqwidth .]
239         set minheight [winfo reqheight .]
240         #XXX
241         if { $minwidth < [$self get_option minwidth] } {
242                 set minwidth [$self get_option minwidth]
243         }
244         if { $minheight < [$self get_option minheight] } {
245                 set minheight [$self get_option minheight]
246         }
247         wm minsize . $minwidth $minheight
248         if { ![info exists mash(environ)] || $mash(environ)!="mplug" } {
249                 wm deiconify .
250         }
251 }
252 
253 #
254 # Every second, update rate variables.
255 #
256 TGWUI instproc periodic_update { } {
257         $self instvar videoAgent_ vpipe_ id_
258         if [$vpipe_ running] {
259                 update_rate [$videoAgent_ set session_]
260         }
261         update idletasks
262         set id_ [after 1000 "$self periodic_update"]
263 }
264 
265 #
266 TGWUI instproc clean_timers { } {
267         $self cancel_periodic_update
268 }
269 
270 #
271 # Cancels the periodic_update.
272 #
273 TGWUI instproc cancel_periodic_update { } {
274         $self instvar id_
275         if [info exists id_] {
276                 after cancel $id_
277                 unset id_
278         }
279 }
280 
281 # Update the source description by updating the element of the global
282 # arrays src_info(), src_nickname(), and src_name() indexed by the
283 # specified <i>src</i>.  If the src_name() is changed, then this is
284 # reflected in the UserWindows in which this src appears.
285 #
286 TGWUI instproc trigger_sdes src {
287         $self instvar asm_
288 
289         global src_info src_nickname src_name
290         #
291         # Figure out best presentation from available information.
292         #
293         set name [$src sdes name]
294         set cname [$src sdes cname]
295         set addr [$src addr]
296         if { $name == "" } {
297                 if { $cname == "" } {
298                         set src_nickname($src) $addr
299                         set info $addr/[$src format_name]
300 
301                 } else {
302                         set src_nickname($src) $cname
303                         set info "$addr/[$src format_name]"
304                 }
305         } elseif [cname_redundant $name $cname] {
306                 set src_nickname($src) $name
307                 set info $addr/[$src format_name]
308         } else {
309                 set src_nickname($src) $name
310                 set info $cname/[$src format_name]
311         }
312         set msg [$src sdes note]
313         if { $msg != "" } {
314                 set info $msg
315         }
316         set src_info($src) $info
317 
318         # only call change_name when name really changes
319         if { ![info exists src_name($src)] || "$src_name($src)" != "$name" } {
320                 set src_name($src) $name
321                 $asm_ change_name $src
322         }
323 }
324 
325 #
326 TGWUI instproc trigger_media src {}
327 
328 #
329 # For the source specified by <i>src</i>, update its rate variables and its source description.
330 #
331 TGWUI instproc update_decoder src {
332         $self set_rate_vars $src
333         $self trigger_sdes $src
334 }
335 
336 TGWUI instproc set_rate_vars {src} {
337         global fpshat bpshat lhat shat
338         if [info exists fpshat($src)] {
339                 unset fpshat($src)
340                 unset bpshat($src)
341                 unset lhat($src)
342                 unset shat($src)
343         }
344         set gain [$self get_option filterGain]
345         set fpshat($src) 0
346         rate_variable fpshat($src) $gain
347         set bpshat($src) 0
348         rate_variable bpshat($src) $gain
349         set lhat($src) 0
350         rate_variable lhat($src) $gain
351         set shat($src) 0
352         rate_variable shat($src) $gain
353 }
354 
355 # An accessor function for a ControlMenu tkvar value.
356 #
357 TGWUI public use_hw_decode {} {
358         $self instvar controlMenu_
359         #return [$controlMenu_ use-hw]
360     return 0
361 }
362 
363 #
364 # An accessor function for a ControlMenu tkvar value.
365 #
366 TGWUI public mute_new_sources {} {
367         $self instvar controlMenu_
368         #return [$controlMenu_ mute-new-sources]
369     return 0
370 }
371 
372 TGWUI instproc build_menubar { w } {
373     $self instvar newRealScreen_ newH261Screen_ newRedirScreen_ configReal_
374     set newRealScreen_ [new RealServerUI $self]
375     set newH261Screen_ [new H261TranscoderAddrInput $self]
376     set newRedirScreen_ [new RedirUI $self]
377     set configReal_ [new RealConfigUI $self]
378 
379     frame $w -relief ridge -borderwidth 2
380     label $w.title -text "[$self get_option appname] v[version]" -font [$self get_option smallfont] \
381             -relief flat -justify left
382     button $w.quit -text Quit -relief raised \
383             -font [$self get_option smallfont] -command "$self shutdown" \
384             -highlightthickness 1
385     menubutton $w.new -text " New Transmission " -relief raised \
386             -font [$self get_option smallfont] -highlightthickness 1 \
387             -menu $w.new.menu
388 
389     set tempmenu [menu $w.new.menu -tearoff 0]
390     $tempmenu add command -label "New Bandwidth Limiter" -command "$self showNewH261screen"
391     $tempmenu add command -label "New Redirector" -command "$self showNewRedirector"
392 
393     set classList [Class info instances]
394     if { [lsearch -exact $classList "RealWindow"] == -1 } {
395         $tempmenu add command -label "New Real Transcoded Broadcast" -command "$self showNewRealScreen" -state disabled
396         $tempmenu add command -label "New Real Transcoded File" -command "$self newRealSession \"\" \"\" \"\" \"\"" -state disabled
397         $tempmenu add command -label "New Stream Combiner" -command "$self showNewRealScreen combine" -state disabled
398     } else {
399         $tempmenu add command -label "New Real Transcoded Broadcast" -command "$self showNewRealScreen"
400         $tempmenu add command -label "New Real Transcoded File" -command "$self newRealSession \"\" \"\" \"\" \"\""
401         $tempmenu add command -label "New Stream Combiner" -command "$self showNewRealScreen combine"
402     }
403     pack $w.title -side left -fill both -expand 1
404     pack $w.new $w.quit -side left -padx 1 -pady 1
405     pack $w.new -fill y -expand 1
406 }
407 
408 TGWUI instproc shutdown { } {
409     $self instvar exitCmd_
410 # make sure all transcoding is stopped so files can be saved and post-processed
411     eval $exitCmd_
412 }
413 
414 #
415 # This is the function that gets called every time a new source appears (as input)
416 #
417 
418 TGWUI instproc attach_stream { src sourceManager grid rownum } {
419     $self instvar managers_ sources_ windows_ source_count_ grid_
420 
421     if ![info exists source_count_] {
422         set source_count_ 0
423     }
424 #add it to the arrays
425     set sources_($source_count_) $src
426     set managers_($src) $sourceManager
427     set windows_($source_count_) $rownum
428     set grid_ $grid
429     incr source_count_
430 
431     $self updateUI
432 }
433 
434 #
435 # This is the beginning of the code needed to transcode to Real.
436 # showNewRealScreen toggles the UI that asks for the server name, username, etc...
437 # newRealSession will just add a new column on the matrix.
438 #
439 
440 TGWUI instproc showNewRealScreen { {combine {}} } {
441     $self instvar realSessions_ newRealScreen_
442     $newRealScreen_ toggle $combine
443 }
444 
445 TGWUI instproc newRealSession { serverName serverPort userName password } {
446     $self instvar outgoingSessions_
447 
448     if ![info exists outgoingSessions_] {
449         set outgoingSessions_(0) [new OutgoingReal $serverName $serverPort $userName $password]
450     } else {
451         set nextCount [array size outgoingSessions_]
452         set outgoingSessions_($nextCount) [new OutgoingReal $serverName $serverPort $userName $password]
453     }
454     $self addTitle "RN Transcode: $serverName"
455     $self updateUI
456 }
457 
458 # this is the class that makes a combiner stream
459 TGWUI instproc newCombiner { serverName serverPort userName password } {
460     $self instvar outgoingSessions_
461 
462     set rend [new Combiner]
463 
464     if ![info exists outgoingSessions_] {
465         set outgoingSessions_(0) [new OutgoingCombiner $rend $serverName $serverPort $userName $password]
466     } else {
467         set nextCount [array size outgoingSessions_]
468         set outgoingSessions_($nextCount) [new OutgoingCombiner $rend $serverName $serverPort $userName $password]
469     }
470     $self addTitle "RN Combiner: $serverName"
471     $self updateUI
472 }
473 
474 
475 # puts the title on top of the new column... used by all transcoders
476 TGWUI instproc addTitle { name } {
477     $self instvar grid_ tgwTitleCol_
478     if ![info exists tgwTitleCol_] {
479         set tgwTitleCol_ 1
480     }
481     frame $grid_.title($tgwTitleCol_) -relief sunken -borderwidth 2
482     label $grid_.title($tgwTitleCol_).label -text $name -font [$self get_option smallfont] -relief flat
483     pack $grid_.title($tgwTitleCol_).label 
484     grid $grid_.title($tgwTitleCol_) -row 0 -column $tgwTitleCol_ -sticky we
485     incr tgwTitleCol_
486 }
487 
488 # updateUI refreshes the matrix to make sure that there
489 # is a widget everywhere there should be. All transcoders use this.
490 
491 TGWUI instproc updateUI { } {
492     $self instvar windows_ sources_ outgoingSessions_ grid_
493 
494     if ![info exists outgoingSessions_] {
495         return
496     }
497 
498     foreach src [array names windows_] {
499         for { set sessionNum 0 } { $sessionNum < [array size outgoingSessions_] } { incr sessionNum } {
500             if {[llength [info commands $grid_.$windows_($src)_outgoing($sessionNum)]] == 0} {
501                 frame $grid_.$windows_($src)_outgoing($sessionNum) -relief sunken -borderwidth 2
502                 $outgoingSessions_($sessionNum) makeUI $grid_.$windows_($src)_outgoing($sessionNum) $self $sources_($src) $windows_($src)
503                 grid $grid_.$windows_($src)_outgoing($sessionNum) -row $windows_($src) -column [expr $sessionNum + 1] -sticky nsew
504             }
505         }
506     }
507 }
508 
509 #
510 # This will set up a new session on which we transcode to H261
511 #
512 
513 TGWUI instproc showNewH261screen { } {
514     $self instvar newH261Screen_
515     $newH261Screen_ toggle
516 }
517 
518 TGWUI instproc newH261Session { addr maxBW } {
519     $self instvar outgoingSessions_ auction_houses_ out_vidAgents_
520 
521     if [info exists auction_houses_($addr)] {
522         puts "we already transcode to that address"
523     } else {
524         set out_vidAgents_($addr) [new VideoAgent $self $addr]
525         set osess [$out_vidAgents_($addr) get_transmitter]
526         $osess loopback-layer -1
527 #               $osess set rate_control_ 1
528 #               $osess set txonly_ 1
529 #               $osess data-bandwidth 128000
530         set auction_houses_($addr) [new BidderHouse $maxBW]
531         $auction_houses_($addr) hold_bid
532         $auction_houses_($addr) update_bw
533 
534         if ![info exists outgoingSessions_] {
535             set outgoingSessions_(0) [new OutgoingH261 $osess $maxBW $auction_houses_($addr) $addr]
536         } else {
537             set nextCount [array size outgoingSessions_]
538             set outgoingSessions_($nextCount) [new OutgoingH261 $osess $maxBW $auction_houses_($addr) $addr]
539         }
540     } 
541     $self addTitle "B/W limiter: $addr"
542     $self updateUI    
543 }
544 
545 
546 # for redirection, or tunnels
547 
548 TGWUI instproc showNewRedirector { } {
549     $self instvar newRedirScreen_
550     $newRedirScreen_ toggle
551 }
552 
553 TGWUI instproc newRedirSession { fwVid fwAud vidDest audSrc audDest } {
554     $self instvar outgoingSessions_ videoAgent_
555 
556     if { $fwVid == 1 } {
557         set vidRedir [new Redirector 1024]
558         set ab [new AddressBlock/Simple $vidDest]
559         set addr [$ab addr 0]
560         set sport [$ab sport 0]
561         set rport [$ab rport 0]
562         set ttl [$ab ttl 0]
563         set n [new Network]
564         $n open $addr $sport $rport $ttl
565         $n loopback 1
566         $vidRedir add-sink $n
567         delete $ab
568 
569         set n [new Network]
570         set src_net [$videoAgent_ network]
571         $n open [$src_net addr] [$src_net sport] [$src_net rport] [$src_net ttl]
572         $n loopback 1    
573         $vidRedir add-source-net $n
574     } else {
575         set vidRedir ""
576     }
577 
578     if { $fwAud == 1 } {
579         # currently audio forwarding is not supported... couldn't get it to work.
580         set audRedir [new Redirector 1024]
581         set ab [new AddressBlock/Simple $audDest]
582         set addr [$ab addr 0]
583         set sport [$ab sport 0]
584         set rport [$ab rport 0]
585         set ttl [$ab ttl 0]
586         set n [new Network]
587         $n open $addr $sport $rport $ttl
588         $n loopback 1
589         set temp [$n addr]
590         $audRedir add-sink $n
591         delete $ab
592 
593         set ab [new AddressBlock/Simple $audSrc]
594         set addr [$ab addr 0]
595         set sport [$ab sport 0]
596         set rport [$ab rport 0]
597         set ttl [$ab ttl 0]
598         set n [new Network]
599         $n open $addr $sport $rport $ttl
600         $n loopback 1    
601         set temp [$n addr]
602         $audRedir add-source-net $n
603         delete $ab
604     } else {
605         set audRedir ""
606     }
607 
608     if ![info exists outgoingSessions_] {
609         set outgoingSessions_(0) [new OutgoingRedir $fwVid $fwAud $vidRedir $vidDest $audRedir $audDest]
610     } else {
611         set nextCount [array size outgoingSessions_]
612         set outgoingSessions_($nextCount) [new OutgoingRedir $fwVid $fwAud $vidRedir $vidDest $audRedir $audDest]
613     }
614     $self addTitle "Redirect: $vidDest"
615     $self updateUI    
616 }
617 
618     
619 

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