1 # ui-stats.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1993-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/common/ui-stats.tcl,v 1.28 2002/02/03 04:25:43 lim Exp $
32
33
34 #FIXME this module needs a lot more work.
35
36 import TopLevelWindow Timer Observer Configuration
37
38 #
39 # This abstract base class implements some common features of TopLevelWindows
40 # that can be easily quit.
41 #
42 Class QuitWindow -superclass TopLevelWindow
43
44 #
45 # A toplevel window for displaying information about a source, along with providing access
46 # to more detailed information, such as network statistics.
47 #
48 Class InfoWindow -superclass {QuitWindow Timer} -configuration {
49 infoHighlightColor LightYellow2
50 # list of sdes items to display in info window
51 sdesList "cname tool email note"
52 }
53
54 #
55 # A toplevel window for displaying the SCUBA votes for a source.
56 #
57 Class ScubaInfoWindow -superclass {QuitWindow Timer Observer}
58
59 #
60 # An abstract base class for creating a toplevel window for displaying
61 # continuously updated statistics on a source. The three columns of the
62 # table are "EWA", "Delta", and "Total", while the rows and data-values
63 # are user-defined.
64 # <p>
65 # Derived subclasses must implement the following methods: <br>
66 # <dd> <i>create-plot-window name</i>
67 # <dd> <i>delete-plot-window w</i>
68 #
69 Class StatWindow -superclass {QuitWindow Timer} -configuration {
70 statsFilter 0.0625
71 }
72
73 #
74 # A toplevel window for displaying a table of continuously updated RTP
75 # statistics for a given source. The three columns of the table are
76 # "EWA", "Delta", and "Total", while the rows and data-values are
77 # user-defined.
78 #
79 Class RtpStatWindow -superclass StatWindow
80
81 #
82 # Not yet implemented.
83 #
84 Class GlobalStatWindow -superclass StatWindow
85
86 #
87 # A toplevel window for displaying the output of mtrace to/from a source.
88 #
89 Class MtraceWindow -superclass TopLevelWindow
90
91 #
92 # Add the <i>path</i> and <i>quitMethod</i> of this toplevel window to the data structure.
93 #
94 QuitWindow public init { path quitMethod } {
95 $self next $path
96 $self instvar quitMethod_
97 set quitMethod_ $quitMethod
98 }
99
100 #
101 # Evaluates the quitMethod of this toplevel window.
102 #
103 QuitWindow instproc quit {} {
104 $self instvar quitMethod_
105 eval $quitMethod_
106 }
107
108 #
109 proc get-playout src {
110 set d [$src handler]
111 if { "$d" != "" } {
112 #FIXME assume 8Khz */
113 return [expr [$d playout] >> 3]
114 }
115 return 0
116 }
117
118 #
119 # Creates a row within widget, <i>r</i>. On the left side of the row,
120 # place a button named <i>name</i>, of the supplied <i>width</i>, that
121 # executes <i>cmd</i> when selected. To the right of the button,
122 # include three labels using the supplied <i>relief</i>.
123 #
124 StatWindow instproc create-row { r name width cmd relief } {
125 set f [$self get_option smallfont]
126 button $r.name -text $name -font $f -anchor w -width $width \
127 -command $cmd -pady 2 -padx 2 -borderwidth 2 \
128 -highlightthickness 0 -relief raised
129 label $r.smooth -font $f -anchor e -width 8 \
130 -relief $relief -borderwidth 1 -pady 1
131 label $r.diff -font $f -anchor e -width 8 \
132 -relief $relief -borderwidth 1 -pady 1
133 label $r.total -font $f -anchor e -width 8 \
134 -relief ridge -borderwidth 1 -pady 1
135
136 pack $r.name -anchor w -fill x -side left -pady 1 -padx 4
137 pack $r.smooth $r.diff $r.total \
138 -expand 1 -fill both -anchor e -side left
139 }
140
141 #
142 # Inside a frame within widget, <i>w</i>, create three columns: "EWA",
143 # "Delta", and "Total", and a row for every type of stat in the
144 # <i>stats</i> list.
145 #
146 StatWindow instproc create-panel { w stats } {
147 set f [$self get_option smallfont]
148 set p $w.f
149 frame $p
150 set top [winfo toplevel $w]
151 set gain [$self get_option statsFilter]
152
153 set r $p.legend
154 frame $r
155 label $r.smooth -font $f -anchor c -width 8 -text EWA \
156 -relief ridge -borderwidth 1
157 label $r.diff -font $f -anchor c -width 8 -text Delta \
158 -relief ridge -borderwidth 1
159 label $r.total -font $f -anchor c -width 8 -text Total \
160 -relief ridge -borderwidth 1
161 pack $r.total $r.diff $r.smooth -side right
162 pack $r -anchor e
163
164 #
165 # save list of stats because they might change and we want to
166 # remember the rate variables that we have created
167 #
168 $self instvar statCache_
169 set statCache_ $stats
170
171 set n [llength $stats]
172
173 $self instvar width_
174 set width_ 10
175 set i 0
176 while { $i < $n } {
177 set v [string len [lindex $stats $i]]
178 if { $v > $width_ } {
179 set width_ $v
180 }
181 incr i 2
182 }
183
184 $self instvar rv_diff_ rv_smooth_
185 set i 0
186 while { $i < $n } {
187 set name [lindex $stats $i]
188 incr i
189 set value [lindex $stats $i]
190 incr i
191 set id [string tolower $name]
192 set r $p.$id
193 frame $r
194
195 set cmd "$self create-plot-window $name"
196 $self create-row $r $name $width_ $cmd ridge
197 pack $r -pady 0
198
199 set rv_diff_($id) $value
200 set rv_smooth_($id) $value
201
202 rate_variable rv_diff_($id) 1.0 "%.1f"
203 rate_variable rv_smooth_($id) $gain "%.1f"
204 }
205 $self instvar statWindow_
206 set statWindow_ $p
207
208 pack $w.f -anchor c
209 }
210
211 #
212 # Returns true if the key-value statList, <i>s1</i>, has changed with
213 # respect to statList, <i>s2</i>.
214 #
215 StatWindow instproc stats-changed { s1 s2 } {
216 set n [llength $s1]
217 if { $n != [llength $s2] } {
218 return 1
219 }
220 set i 0
221 while { $i < $n } {
222 if { [lindex $s1 $i] != [lindex $s2 $i] } {
223 return 1
224 }
225 incr i 2
226 }
227 return 0
228 }
229
230 #
231 # Re-evaluate the statList using the <i>method</i> supplied to the
232 # StatWindow's init method, and update the data displayed in the
233 # StatWindow if necessary.
234 #
235 StatWindow instproc stat-update {} {
236 $self instvar rv_diff_ rv_smooth_ statCache_
237
238 $self instvar method_ statWindow_
239 set stats [eval $method_]
240 if [$self stats-changed $stats $statCache_] {
241 $self unset_rvs
242 pack forget $w.frame
243 destroy $w.frame
244 frame $w.frame -borderwidth 2 -relief groove
245 $self create-panel $w.frame $stats
246 pack $w.frame -after $w.title -expand 1 -fill x -anchor center
247 }
248
249 set p $statWindow_
250 set i 0
251 set n [llength $stats]
252 while { $i < $n } {
253 set id [string tolower [lindex $stats $i]]
254 incr i
255 set cntr [lindex $stats $i]
256 incr i
257 set rv_diff_($id) $cntr
258 set rv_smooth_($id) $cntr
259 $p.$id.total configure -text $cntr
260 $p.$id.diff configure -text $rv_diff_($id)
261 $p.$id.smooth configure -text $rv_smooth_($id)
262 }
263 $self instvar src_
264 if [winfo exists $p.playout.total] {
265 $p.playout.total configure -text [get-playout $src_]ms
266 }
267 }
268
269 #
270 # Unset all the rate variables associated with a window,
271 # so that the C storage is freed up
272 #
273 StatWindow instproc unset_rvs {} {
274 $self instvar statCache_ rv_diff_ rv_smooth_
275 if [info exists statCache_] {
276 set n [llength $statCache_]
277 for { set i 0 } { $i < $n } { incr i 2 } {
278 set id [string tolower [lindex $statCache_ $i]]
279 unset rv_diff_($id) rv_smooth_($id)
280 }
281 unset statCache_
282 }
283 }
284
285 #
286 proc stat_destroy src {
287 destroy $src
288 global stat_method win_src
289 if [info exists stat_method($src)] {
290 unset stat_method($src)
291 }
292 if [info exists win_src($src)] {
293 unset win_src($src)
294 }
295 }
296
297 #
298 # Not used... <br>
299 # Destroy widget at path <i>w</i>.
300 #
301 InfoWindow instproc info_destroy { w src } {
302 #FIXME
303 global info_x info_y
304 set info_x($src) [winfo rootx $w]
305 set info_y($src) [winfo rooty $w]
306 destroy $w
307 }
308
309 #
310 # Not used... <br>
311 # Destroy widget at path <i>w</i>.
312 #
313 ScubaInfoWindow instproc info_destroy { w src } {
314 global info_x info_y
315 set info_x($src) [winfo rootx $w]
316 set info_y($src) [winfo rooty $w]
317 destroy $w
318 }
319
320 #
321 # Keep restarting a timer that causes a stat_update on expiration.
322 #
323 StatWindow private timeout {} {
324 $self stat-update
325 $self sched 1000
326 }
327
328 #
329 # Create a window with widgetpath, <i>w</i>, titled <i>windowName</i>.
330 # The <i>titleText</i> will be displayed as a label across the top of
331 # the window. The supplied <i>method</i> should return a list of stats,
332 # which will serve as rows for a three-column ("EWA", "Delta", and
333 # "Total") table. The command used to quit the window should be
334 # supplied as <i>quitCmd</i>.
335 #
336 StatWindow public init { w windowName titleText method quitCmd } {
337 $self next $w $quitCmd
338 $self create-window $w $windowName
339
340 set f [$self get_option smallfont]
341 frame $w.title -borderwidth 2 -relief groove
342 label $w.title.main -borderwidth 0 -anchor w -text $titleText
343 label $w.title.name -borderwidth 0 -anchor w
344 frame $w.frame -borderwidth 2 -relief groove
345
346 $self instvar method_
347 set method_ $method
348 $self create-panel $w.frame [eval $method]
349
350 pack $w.title.name -anchor w
351 pack $w.title.main -anchor w
352 pack $w.title -fill x
353 pack $w.frame -expand 1 -fill x -anchor center
354
355 wm geometry $w +[winfo pointerx .]+[winfo pointery .]
356 wm deiconify $w
357 # start up the timer
358 $self sched 1000
359
360 button $w.dismiss -relief raised -font $f \
361 -command "$self quit" -text Dismiss
362 pack $w.dismiss -anchor c -pady 4
363
364 wm protocol $w WM_DELETE_WINDOW "$self quit"
365 }
366
367 #
368 # Delete all the plot windows.
369 #
370 StatWindow instproc destroy {} {
371 #
372 #FIXME should change this so plot windows can remain
373 # mapped even if we destroy stat windows.
374 # this would require bookeeping the plot-windows in
375 # the active source so we could delete them when
376 # the source is deleted.
377 #
378 $self instvar plot_win_
379 foreach w [array names plot_win_] {
380 $self delete-plot-window $w
381 }
382 $self next
383 }
384
385 #
386 # Create a StatWindow with widgetpath, <i>w</i>, titled using some
387 # representation of <i>src</i>. The <i>titleText</i> will be displayed
388 # as a label across the top of the window. The supplied <i>method</i>
389 # should return a list of stats, which will serve as rows for a
390 # three-column ("EWA", "Delta", and "Total") table. A final row along
391 # the bottom will represent "Playout". The command used to quit the
392 # window should be supplied as <i>quitCmd</i>.
393 #
394 RtpStatWindow public init { w src titleText method quitCmd } {
395 $self next $w [$src getid] $titleText $method $quitCmd
396 $w.title.name configure -textvariable src_nickname($src)
397 $self instvar src_
398 set src_ $src
399
400 #
401 # Special-case playout estimator since it's not a counter
402 #
403 $self instvar statWindow_ width_
404 set r $statWindow_.playout
405 frame $r
406 # FIXME don't create-plot-window unless you add Playout value to statList.
407 # currently "stat-get Playout" returns -1
408 # set cmd "$self create-plot-window Playout"
409 set cmd ""
410 $self create-row $r Playout $width_ $cmd flat
411 pack $r -pady 0
412 }
413
414 #
415 # Return the value of the stat in the statList that corresponds to the key <i>id</i>.
416 # Return -1 if not found.
417 #
418 RtpStatWindow instproc stat-get id {
419 $self instvar method_
420 set stats [eval $method_]
421 set k [lsearch -exact $stats $id]
422 return [lindex $stats [expr $k + 1]]
423 }
424
425 #
426 # Displays another toplevel window for the src being represented in this
427 # RtpStatWindow, plotting the data in the statList with the key
428 # <i>name</i>.
429 #
430 RtpStatWindow instproc create-plot-window name {
431 $self instvar plot_win_ src_
432 set id [string tolower $name]
433 set w .plot$src_$id
434 if [info exists plot_win_($w)] {
435 $self delete-plot-window $w
436 } else {
437 set plot_win_($w) [new PlotWindow $w $src_ $name \
438 "$self stat-get $name" \
439 "$self delete-plot-window $w"]
440 }
441 }
442
443 #
444 # Delete the PlotWindow for the src being represented in this
445 # RtpStatWindow.
446 #
447 RtpStatWindow instproc delete-plot-window w {
448 $self instvar plot_win_
449 delete $plot_win_($w)
450 unset plot_win_($w)
451 }
452
453 #
454 # Not yet implemented.
455 #
456 Class GlobalWindow -superclass StatWindow
457
458 #
459 GlobalWindow public init { w titleText method quitCmd } {
460 $self next $w "RTP Stats" $titleText $method $quitCmd
461 }
462
463 #
464 proc has_src w {
465 global win_src
466 if [string compare $win_src($w) GLOBAL] {
467 return 1
468 } else {
469 return 0
470 }
471 }
472
473 #
474 # A toplevel window that plots data along a timescale as it is generated.
475 #
476 Class PlotWindow -superclass {QuitWindow Timer}
477
478 #
479 # Keep restarting a timer that causes the <i>generator</i> to re-evaluate the data plotted in this window.
480 #
481 PlotWindow private timeout {} {
482 $self instvar rv_plot_ generator_ path_
483 set rv_plot_ [eval $generator_]
484 $path_.frame.sc set $rv_plot_
485 $self sched 1000
486 }
487
488 #
489 proc relabel_stripchart {w min max perDiv} {
490 $w configure -text " range $min to $max, $perDiv/div"
491 }
492
493 #
494 # Creates a toplevel window at widgetpath <i>w</i> for plotting the data
495 # called <i>name</i> for the source, <i>src</i>, generated by the
496 # <i>generator</i> command. The command used to quit the window should
497 # be supplied as <i>quitCmd</i>.
498 #
499 PlotWindow public init { w src name generator quitCmd } {
500 $self next $w $quitCmd
501 $self create-window $w "plot window"
502 catch "wm resizable $w true false"
503 $self instvar generator_
504 set generator_ $generator
505
506 set f [$self get_option smallfont]
507 frame $w.title -borderwidth 2 -relief groove
508 label $w.title.main -borderwidth 0 -anchor w -text $name
509 frame $w.frame -borderwidth 2 -relief groove
510
511 stripchart $w.frame.sc -max 200 -min 1 -stripwidth 1 -width 1 \
512 -autoscale 2 -rescale_command "relabel_stripchart $w.bf.lab" \
513 -relief groove -striprelief flat -tickcolor gray95 -hticks 30
514 pack $w.frame.sc -expand 1 -fill both
515
516 # force more reasonable initial size
517 frame $w.brace -width 250
518 pack $w.brace
519
520 if [string match Source/* [$src info class]] {
521 label $w.title.name -borderwidth 0 -anchor w \
522 -textvariable src_nickname($src)
523 pack $w.title.name -anchor w
524 }
525 pack $w.title.main -anchor w
526 pack $w.title -fill x
527 pack $w.frame -expand 1 -fill both -anchor center
528
529 #
530 # create a new rate-variable. would be nice to just use
531 # rv_diff but the stat window that this plot comes from can
532 # be deleted while leaving this one in place.
533 # FIXME hack: don't use a rate-variable for the playout estimator
534 # since we want actual value not differences
535 $self instvar rv_plot_
536 if { "$name" != "Playout" } {
537 rate_variable rv_plot_ 1.0 "%.1f"
538 }
539
540 wm geometry $w +[winfo pointerx .]+[winfo pointery .]
541 wm deiconify $w
542 # start up the timer
543 $self sched 1000
544
545 frame $w.bf
546 label $w.bf.lab -borderwidth 0 -font $f -anchor w -text "No data"
547 pack $w.bf.lab -side left -expand 1 -fill x
548 button $w.bf.dismiss -relief raised -font $f -anchor e \
549 -command "$self quit" -text Dismiss
550 pack $w.bf.dismiss -side right -pady 4 -padx 4
551 pack $w.bf -expand 1 -fill x
552
553 wm protocol $w WM_DELETE_WINDOW "$self quit"
554 }
555
556 #
557 # what we want printed in the info window for our format etc.
558 # (i.e., info window code is app independent but this info isn't,
559 # so we have this hackish callback)
560 #
561 proc info_text src {
562 set d [$src handler]
563 set fmt [$src format_name]
564
565 if {[[$src set sm_] info class] == "VideoAgent"} {
566 if { "$d" != "" } {
567 set fmt "$fmt [$d cmd info] ([$d width]x[$d height])"
568 }
569 } elseif {[[$src set sm_] info class] == "AudioAgent"} {
570 if { "$d" != "" } {
571 set n [expr [$d block-size] / 160]
572 if { $n > 1 } {
573 set fmt $fmt/$n
574 }
575 }
576 if { $fmt == "" } {
577 set fmt none
578 }
579 }
580
581 return "format: $fmt"
582 }
583
584 #
585 # Create a top-level window using widgetpath, <i>w</i>, to display summary statistics
586 # of source, <i>src</i>. The <i>parent</i> must implement the methods: <br>
587 # <dd> delete-info-window
588 # <dd> create-rtp-window
589 # <dd> create-decoder-window
590 # <br>
591 # Info displayed includes: <br>
592 # <dd> <i>src</i> nickname
593 # <dd> <i>src</i> address
594 # <dd> items in <i>sdesList</i> (a resource defined in the options database)
595 # <dd> buttons for retrieving "Stats...": "RTP" & "Decoder"
596 # <br>
597 # "smallfont" must be in options database before invoking this method.
598 #
599 InfoWindow public init { w src parent } {
600 $self instvar src_
601 set src_ $src
602
603 $self next $w "$parent delete-info-window"
604 $self create-window $w [$src getid]
605 set f [$self get_option smallfont]
606 frame $w.title -borderwidth 2 -relief groove
607 label $w.title.name -borderwidth 0 -font $f -anchor w \
608 -textvariable src_nickname($src)
609 label $w.title.info -borderwidth 0 -font $f -anchor w \
610 -text [$src addr]
611 label $w.title.timeData -borderwidth 0 -font $f -anchor w
612 label $w.title.timeCtrl -borderwidth 0 -font $f -anchor w
613
614 frame $w.frame -borderwidth 2 -relief groove
615
616 pack $w.title.name $w.title.info -fill x
617
618 foreach sdes [$self get_option sdesList] {
619 label $w.title.$sdes -borderwidth 0 -font $f -anchor w
620 pack $w.title.$sdes -fill x
621 }
622 label $w.title.srcid -borderwidth 0 -font $f -anchor w
623 pack $w.title.srcid -fill x
624
625 pack $w.title.timeData $w.title.timeCtrl -fill x
626
627 pack $w.title -fill x
628
629 set p $w.bot
630 frame $p
631
632 set m $p.mb.menu
633 menubutton $p.mb -text Stats... -menu $m -relief raised -width 8 \
634 -font $f
635 menu $m
636 $m add command -label RTP -command "$parent create-rtp-window" -font $f
637 $m add command -label Decoder \
638 -command "$parent create-decoder-window" -font $f
639
640 button $p.dismiss -relief raised -font $f \
641 -command "$self quit" -text Dismiss
642
643 pack $p.mb -side left -padx 8
644 pack $p.dismiss -side right -padx 8
645 pack $p -anchor c -pady 4 -fill x
646
647 wm protocol $w WM_DELETE_WINDOW "$self quit"
648
649 $self info_update
650
651 global info_x info_y
652 if [info exists info_x($src) ] {
653 set x $info_x($src)
654 set y $info_y($src)
655 } else {
656 set x [winfo pointerx .]
657 set y [winfo pointery .]
658 }
659
660 #
661 # Need to do an update so that $w gets laid out allowing us to
662 # look up its size. This is tricky because of a possible race:
663 # if the user releases the mouse, summary_window might get
664 # destroyed during the update idletasks. So we check
665 # that the window still exists before proceeeding.
666 #
667 update idletasks
668 if ![winfo exists $w] { return }
669
670 #
671 # Check if window goes off the bottom or right. Don't need
672 # to check top or left since upper-left corner is at mouse.
673 #
674 set right [expr [winfo screenwidth .] - [winfo reqwidth $w] - 5]
675 if { $x > $right } {
676 set x $right
677 }
678 set bot [expr [winfo screenheight .] - [winfo reqheight $w] - 5]
679 if { $y > $bot } {
680 set y $bot
681 }
682 wm geometry $w +$x+$y
683 wm deiconify $w
684
685 # start a timer that will invoke $self::timeout on expiration
686 $self sched 3000
687 }
688
689 #
690 # Updates information regarding the <i>src</i> represented by this window including: <br>
691 # <dd> the last data
692 # <dd> the last control
693 # <dd> items in <i>sdesList</i> (a resource defined in the options database)
694 # <dd> the id/address
695 # <dd> the sdes note
696 #
697 InfoWindow instproc info_update {} {
698 $self instvar path_ src_
699 set w $path_
700 set src $src_
701 set decoder [$src handler]
702 set fmt [$src format_name]
703 if { $fmt == "" } { set fmt "?" }
704 $w.title.info configure -text [info_text $src]
705 set t [$src lastdata]
706 if { $t == "" } { set t "never" }
707 $w.title.timeData configure -text "last data $t"
708 set t [$src lastctrl]
709 if { $t == "" } { set t "never" }
710 $w.title.timeCtrl configure -text "last control $t"
711
712 foreach sdes [$self get_option sdesList] {
713 $w.title.$sdes configure -text "$sdes: [$src sdes $sdes]"
714 }
715 $w.title.srcid configure -text "srcid: [$src srcid]/[$src addr]"
716 if { [$src srcid] != [$src ssrc] } {
717 if ![winfo exists $w.title.mixer] {
718 label $w.title.mixer -borderwidth 0 \
719 -font [$self get_option smallfont] -anchor w
720 pack $w.title.mixer -after $w.title.srcid -fill x
721 }
722 $w.title.mixer configure -text "mixer: [$src ssrc]/[$src addr]"
723 } elseif [winfo exists $w.title.mixer] {
724 pack forget $w.title.mixer
725 destroy $w.title.mixer
726 }
727 set note [$src sdes note]
728 if { $note != "" } {
729 set bg [$self get_option infoHighlightColor]
730 } else {
731 set bg [$self get_option background]
732 }
733 $w.title.note configure -background $bg
734 }
735
736 #
737 # Keep restarting a timer that causes an info_update on expiration.
738 #
739 InfoWindow private timeout {} {
740 $self info_update
741 $self sched 3000
742 }
743
744 #
745 # Keep restarting a timer that causes an info_update on expiration.
746 #
747 ScubaInfoWindow private timeout {} {
748 $self info_update
749 $self sched 1000
750 }
751
752 #
753 # Create a top-level window using widgetpath, <i>w</i>, to display summary statistics
754 # of source, <i>src</i>. The <i>parent</i> must implement the method: <br>
755 # <dd> delete-scuba-window
756 # <br>
757 # Info displayed includes: <br>
758 # <dd> <i>src</i> nickname
759 # <dd> individual SCUBA Votes
760 # <dd> Aggregate SCUBA Vote
761 # <br>
762 # "smallfont" must be in options database before invoking this method.
763 #
764 ScubaInfoWindow public init { w src parent scuba_sess } {
765 $self instvar src_ parent_ scuba_sess_
766 set src_ $src
767 set scuba_sess_ $scuba_sess
768
769 $self next $w "$parent delete-scuba-window"
770 $self create-window $w [$src getid]
771 set f [$self get_option smallfont]
772 frame $w.title -borderwidth 2 -relief groove
773 label $w.title.name -borderwidth 0 -anchor w \
774 -textvariable src_nickname($src)
775 label $w.title.info -borderwidth 0 -anchor w -text "SCUBA Votes"
776
777 frame $w.frame -borderwidth 2 -relief groove
778
779 pack $w.title.name $w.title.info -fill x
780
781 pack $w.title -fill x
782
783 frame $w.frame.total -relief ridge -borderwidth 1
784 label $w.frame.total.t -text "Aggregate Vote:" -font $f
785 label $w.frame.total.val -text 0 -font $f
786 pack $w.frame.total.t $w.frame.total.val -side left -anchor w
787 pack $w.frame.total -fill x -expand 1 -side bottom
788 pack $w.frame -fill both -expand 1 -side top
789
790 set p $w.bot
791 frame $p
792 button $p.dismiss -relief raised -font $f \
793 -command "$self quit" -text Dismiss
794
795 pack $p.dismiss
796 pack $p -anchor c -pady 4 -fill x
797
798 wm protocol $w WM_DELETE_WINDOW "$self quit"
799
800 global scubainfo_x scubainfo_y
801 if [info exists scubainfo_x($src) ] {
802 set x $scubainfo_x($src)
803 set y $scubainfo_y($src)
804 } else {
805 set x [winfo pointerx .]
806 set y [winfo pointery .]
807 }
808
809 #
810 # Need to do an update so that $w gets laid out allowing us to
811 # look up its size. This is tricky because of a possible race:
812 # if the user releases the mouse, summary_window might get
813 # destroyed during the update idletasks. So we check
814 # that the window still exists before proceeeding.
815 #
816 update idletasks
817 if ![winfo exists $w] { return }
818
819 #
820 # Check if window goes off the bottom or right. Don't need
821 # to check top or left since upper-left corner is at mouse.
822 #
823 set right [expr [winfo screenwidth .] - [winfo reqwidth $w] - 5]
824 if { $x > $right } {
825 set x $right
826 }
827 set bot [expr [winfo screenheight .] - [winfo reqheight $w] - 5]
828 if { $y > $bot } {
829 set y $bot
830 }
831 wm geometry $w +$x+$y
832 wm deiconify $w
833 }
834
835 #
836 # Updates information regarding the <i>src</i> represented by this window including: <br>
837 # <dd> individual SCUBA Votes
838 # <dd> Aggregate SCUBA Vote
839 #
840 ScubaInfoWindow instproc info_update {} {
841 $self instvar path_ src_ scuba_sess_
842 set w $path_.frame
843
844 set sm [$scuba_sess_ source-manager]
845 if { [$sm info vars local_] == "" } {
846 return
847 }
848 set localsrc [$sm set local_]
849
850 set total 0
851 set al [$sm active_list]
852 foreach src $al {
853 set srcid [$src srcid]
854 set voters [$scuba_sess_ array names scoretab_ *:$srcid]
855 set subtotal 0
856 foreach v $voters {
857 set subtotal \
858 [expr $subtotal+[$scuba_sess_ set scoretab_($v)]]
859 }
860 set tot($src) $subtotal
861 set total [expr $total+$subtotal]
862 }
863 if { $total > 0 } {
864 set avg [expr $tot($src_)/$total]
865 } else {
866 set avg 0
867 }
868 set srcid [$src_ srcid]
869 set voters [$scuba_sess_ array names scoretab_ *:$srcid]
870 set sm [$scuba_sess_ source-manager]
871 foreach s [$sm set sources_] {
872 if { $s == $src_ } {
873 continue
874 }
875 $w.s$s.v configure -text "= 0.0"
876 }
877 foreach v $voters {
878 set sender [lindex [split $v :] 0]
879 $w.s$sender.v configure \
880 -text "= [$scuba_sess_ set scoretab_($v)]"
881 }
882 $w.total.val configure -text $avg
883 }
884
885 #
886 # Add the vote from the new <i>src</i> to the ScubaInfoWindow.
887 #
888 ScubaInfoWindow instproc register { src } {
889 $self instvar path_ scuba_sess_ src_
890 if { $src == $src_ } {
891 return
892 }
893 set f [$self get_option smallfont]
894 set w $path_.frame
895 global src_nickname
896 frame $w.s$src
897
898 set sm [$scuba_sess_ source-manager]
899 if { [$sm set local_] == $src } {
900 label $w.s$src.t -text "Local Receiver" -font $f
901 } else {
902 label $w.s$src.t -textvariable src_nickname($src) -font $f
903 }
904 label $w.s$src.v -text "= 0.0" -font $f
905 pack $w.s$src.t -side left -anchor w
906 pack $w.s$src.v -side right -anchor e
907 pack $w.s$src -fill both -expand 1
908 }
909
910 #
911 # Remove the vote of the unregistered <i>src</i> from the ScubaInfoWindow.
912 #
913 ScubaInfoWindow instproc unregister { src } {
914 $self instvar path_ src_
915 if { $src == $src_ } {
916 return
917 }
918 set w $path_.frame
919 destroy $w.s$src
920 }
921
922 #
923 # If the <i>src</i> being deactivated is the subject of this ScubaInfoWindow, delete the window.
924 #
925 ScubaInfoWindow instproc deactivate { src } {
926 $self instvar src_ path_
927 if { $src == $src_ } {
928 destroy $path_
929 }
930 }
931
932 #
933 # Instantiate, but do not yet display or iconify, a dismissable, x/y
934 # scrollable toplevel using the provided widgetpath, <i>w</i>. Also
935 # label this window and its icon to identify the source, <i>src</i>. Use
936 # the <i>dir</i> parameter to specify the direction of the trace
937 # (e.g. "to" or "from".)<br> The options database must define smallfont
938 # before this method is invoked.
939 #
940 MtraceWindow public init {w src dir} {
941 $self instvar w_ src_ dir_
942 set w_ $w
943 set src_ $src
944 set dir_ $dir
945 if ![winfo exists $w] {
946 # $self next $w "$parent delete-info-window"
947 $self create-window $w [$src getid]
948 set f [$self get_option smallfont]
949 frame $w.t
950 scrollbar $w.t.yscroll -command "$w.t.text yview" -relief sunken
951 scrollbar $w.t.xscroll -command "$w.t.text xview" -relief sunken \
952 -orient horiz
953 text $w.t.text -height 24 -width 80 -setgrid true -wrap none \
954 -font fixed -relief sunken -borderwidth 2 \
955 -xscrollcommand "$w.t.xscroll set" \
956 -yscrollcommand "$w.t.yscroll set"
957 pack $w.t.yscroll -side right -fill y
958 pack $w.t.xscroll -side bottom -fill x
959 pack $w.t.text -side left -padx 0 -pady 0 -fill both -expand yes
960 set p $w.b
961 frame $p
962 button $p.dismiss -relief raised -font $f \
963 -command "destroy $w" -text Dismiss
964 pack $p.dismiss -side right -padx 8
965 pack $w.t -side top -fill both -expand yes
966 pack $p -side bottom -pady 2 -fill x
967 wm geometry $w +[winfo pointerx .]+[winfo pointery .]
968 wm deiconify $w
969 wm protocol $w WM_DELETE_WINDOW "destroy $w"
970 update idletasks
971 if ![winfo exists $w] { return }
972 }
973 }
974
975 #
976 # Execute the mtrace and output the results within this window.
977 #
978 MtraceWindow instproc do_mtrace {} {
979 $self instvar w_ src_ dir_
980 global V
981 set rtpagent $V(sm)
982 set net [$rtpagent network]
983 if {$dir_=="to"} {
984 set cmd "|mtrace [$net interface] [$net addr] [$src_ addr]"
985 } else {
986 set cmd "|mtrace [$src_ addr] [$net addr]"
987 }
988 if [catch "open {$cmd} r" fd] {
989 $w_.t.text insert end "mtrace error: $fd"
990 return
991 }
992 fconfigure $fd -blocking 0
993 fileevent $fd readable "$self read_mtrace $fd"
994 }
995
996 #
997 # Read the output of the mtrace from a file into this window.
998 #
999 MtraceWindow instproc read_mtrace {fd} {
1000 $self instvar w_
1001 if [winfo exists $w_] {
1002 $w_.t.text insert end [read $fd 1]
1003 $w_.t.text yview end
1004 if [eof $fd] {
1005 fileevent $fd readable {}
1006 catch "close $fd"
1007 }
1008 } else {
1009 fileevent $fd readable {}
1010 catch "close $fd"
1011 }
1012 }
1013
1014
1015
1016 #FIXME
1017 proc destroy_rtp_stats src {