1 # session-scubavic.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/vic/session-scubavic.tcl,v 1.16 2002/02/03 04:39:54 lim Exp $
32
33 import Session/Scuba Observer NetworkManager/Scuba
34
35 #
36 Class Session/Scuba/Vic -superclass { Session/Scuba Observer }
37
38 #
39 Session/Scuba/Vic instproc init { rtpsess sm ab vpipe } {
40 $self next
41 $self set rtpsess_ $rtpsess
42 $self source-manager $sm
43 $self set vpipe_ $vpipe
44
45 if { $ab != "" && [$ab nchan] > 0 } {
46 $self reset $ab
47 }
48 }
49
50 #
51 Session/Scuba/Vic instproc reset ab {
52 $self instvar nm_ rtpsess_
53
54 if [info exists nm_] {
55 delete $nm_
56 }
57 set nm_ [new NetworkManager/Scuba $ab $rtpsess_ $self]
58 $self scuba-net [$nm_ set scubaNet_]
59 $self start-control
60 }
61
62 #
63 Session/Scuba/Vic instproc set_allocation {} {
64 $self instvar scoretab_ share_ rtpsess_ sessionbw_
65
66 set sm [$self source-manager]
67 if { [$sm info vars local_] == "" } {
68 return
69 }
70 set localsrc [$sm set local_]
71
72 #
73 # Tabulate scores
74 #
75 # For now, just find ourselves in the score table and allocate
76 # our bandwith proportionally. If our bandwidth is 0, we get a
77 # proportional fraction of 5% of the bandwidth which is set aside for
78 # this purpose.
79
80 set total 0
81 set tot($localsrc) 0
82 set al [$sm active_list]
83 set zerosrcs 0
84 foreach src $al {
85 set srcid [$src srcid]
86 set voters [array names scoretab_ *:$srcid]
87 set subtotal 0
88 foreach v $voters {
89 set subtotal [expr $subtotal+$scoretab_($v)]
90 }
91 set tot($src) $subtotal
92 if { $subtotal == 0 } {
93 incr zerosrcs
94 }
95 set total [expr $total+$subtotal]
96 }
97 #puts "total=$total localtot=$tot($localsrc)"
98 if { $total > 0 } {
99 set avg [expr $tot($localsrc)/$total]
100 } else {
101 set avg 0
102 }
103 if { $avg > 0 } {
104 set share_ [expr 0.95*$avg]
105 } else {
106 if { $zerosrcs == 0 } {
107 set zerosrcs 1
108 }
109 set share_ [expr 0.05/$zerosrcs]
110 }
111 #puts "$self: $localsrc set_bps $share_ of $sessionbw_=[expr $share_*$sessionbw_]"
112 $self set_bps [expr $share_*$sessionbw_]
113 }
114
115 #
116 Session/Scuba/Vic instproc set_bps { bps } {
117 set videoagent [$self source-manager]
118 set b [expr int($bps)]
119 $self instvar vpipe_
120 $vpipe_ set_bps $b
121 $videoagent local_bandwidth $b
122 global bps_slider
123 if [info exists bps_slider] {
124 $bps_slider set $b
125 }
126 }
127
128 #
129 Session/Scuba/Vic instproc build_report {} {
130 #puts "build_report"
131 $self instvar focus_set_
132 if ![info exists focus_set_] {
133 return 0
134 }
135 set sm [$self source-manager]
136 if { [$sm info vars local_] == "" } {
137 return 0
138 }
139 set localsrc [$sm set local_]
140
141 # Divvy up score equally among all in focus set
142 set t 0
143 set srcs [array names focus_set_]
144 foreach s $srcs {
145 # Ignore our own focus
146 if { $s != $localsrc && $focus_set_($s) > 0 } {
147 incr t
148 }
149 }
150
151 $self clean_scoretab $localsrc
152
153 if { $t != 0 } {
154 set score [expr int(1e6/$t)]
155 foreach s $srcs {
156 if { $focus_set_($s) > 0 && $s != $localsrc } {
157 set srcid [$s srcid]
158 $self add-scuba-entry $srcid $score
159 # Loopback our votes, but ignore our own.
160 $self recv_scuba_entry $localsrc \
161 $srcid $score
162 }
163 }
164 }
165
166 $self set_allocation
167
168 return $t
169 }
170
171 #
172 Session/Scuba/Vic instproc activate { src } {
173 $self set focus_set_($src) 0
174
175 $self next $src
176 }
177
178 #
179 Session/Scuba/Vic instproc deactivate { src } {
180 $self unset focus_set_($src)
181
182 $self next $src
183 }
184
185 #
186 Session/Scuba/Vic instproc scuba_focus { src } {
187 $self instvar focus_set_
188 incr focus_set_($src)
189 }
190
191 #
192 Session/Scuba/Vic instproc scuba_unfocus { src } {
193 $self instvar focus_set_
194 if {[array names focus_set_ $src] == $src} {
195 incr focus_set_($src) -1
196 }
197 }
198
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.