开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
stats.tcl
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：16k
源码类别：

通讯编程

开发平台：

Visual C++

stats.tcl：源码内容
  1. #
  2. # Copyright (C) 1998 by USC/ISI
  3. # All rights reserved.                                            
  4. #                                                                
  5. # Redistribution and use in source and binary forms are permitted
  6. # provided that the above copyright notice and this paragraph are
  7. # duplicated in all such forms and that any documentation, advertising
  8. # materials, and other materials related to such distribution and use
  9. # acknowledge that the software was developed by the University of
  10. # Southern California, Information Sciences Institute.  The name of the
  11. # University may not be used to endorse or promote products derived from
  12. # this software without specific prior written permission.
  13. # 
  14. # THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  15. # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  16. # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  17. # 
  18. # $Header: /cvsroot/nsnam/nam-1/tcl/stats.tcl,v 1.16 2002/05/17 20:55:37 buchheim Exp $
  20. Animator instproc tracehooktcl { e } {
  21.  
  22.     # notify observers
  23.     $self notifyObservers $e
  24. }
  26. Animator instproc update_statsview { s event } {
  28.     $self instvar colorset highest_seq timeslider maxtime colorname subView 
  29. subViewRange plotdatax plotdatay plotmark
  31.     set s_len [string length $s]
  32.     set session_id [string index $s [expr $s_len-1]]
  34.     # Only process THIS window
  35.     set sid [get_trace_item "-S" $event]
  37.     if {$sid != $session_id} {return}
  39.     # main view
  40.     set extinfo [get_trace_item "-x" $event]
  41.     set time [get_trace_item "-t" $event]
  42.     set seqno [lindex $extinfo 2]
  43.     set colorid [get_trace_item "-a" $event]
  44.     set mid [get_trace_item "-m" $event]
  46.     if { $mid == "" } {return}
  48.     set cnt 0
  49.     while {[info exists plotdatax($sid.$cnt)]} {
  50. $self plot_xy $s.main.c $time $seqno 0 $maxtime 0 $highest_seq($sid) 
  51. $colorid $plotmark($sid.$mid) 0
  52.         incr cnt
  53.     }
  55.     # subview
  56.     foreach subviews $subView(#$session_id) {
  57.    if {![winfo exists $subviews]} {continue}
  58.     
  59. set minx [lindex $subViewRange($subviews) 0]
  60. set maxx [lindex $subViewRange($subviews) 1]
  61. set miny [lindex $subViewRange($subviews) 2]
  62. set maxy [lindex $subViewRange($subviews) 3]
  63. $self plot_xy $subviews.main.c $time $seqno $minx $maxx 
  64.  $miny $maxy $colorid $plotmark($sid.$mid) 1
  66.     }
  67. }
  70. #change nam window status 
  71. Animator instproc new_waitingtext { msg } {
  72.     $self instvar windows 
  73.     $windows(title) configure -text "Please wait - $msg"
  74.     update
  75. }
  77. # restore nam window status
  78. Animator instproc restore_waitingtext {} {
  79.     $self instvar windows nam_name
  80.     $windows(title) configure -text $nam_name
  81. }
  83. Animator instproc active_sessions {} {
  84.     $self instvar analysis_ready colorset colorindex session_id colorname 
  85.     netModel analysis_flag windows nam_name tlw_ cache_ready
  86.     #processing tracefile if necessary
  87.     
  88.     if {[string compare $analysis_flag "0"] == 0} {
  89. set analysis_flag 1
  90.     }
  92.     set w $tlw_.activesessions
  94.     if {[winfo exists $w]} {
  95.      raise $w
  96.         return
  97.     } 
  98.     $windows(title) configure -text "Please wait ... "
  99.     update
  100.     # good timing
  101.     # check if analysis ready
  102.     if { $analysis_ready == 1 && $cache_ready == 0 } {
  103.         $self cache_plot
  104. set cache_ready 1
  105.     }
  106.     $windows(title) configure -text $nam_name
  108.     #processing tracefiel if necessary
  110.     toplevel $w
  112.     wm title $w "Current Active Sessions"
  114.     bind $w <Control-w> "destroy $w"
  115.     bind $w <Control-W> "destroy $w"
  116.     bind $w <Control-q> "[AnimControl instance] done"
  117.     bind $w <Control-Q> "[AnimControl instance] done"
  119.     frame $w.f 
  120.     pack $w.f -side top
  122.     label $w.f.label_left -text "LEGEND"
  123.     label $w.f.label_right -text "SESSIONS"
  125.     for {set i 0} { $i < $colorindex } { incr i} {
  126.     
  127. label $w.f.label_left$i -text "    " -bg $colorname($i);
  128. set stats_title $session_id($i)
  129. button $w.f.button$i -text $session_id($i) 
  130. -command "$self make_mainwin "$i""
  132.     }
  134.     grid config $w.f.label_left -column 0 -row 0 -sticky "n"
  135.     grid config $w.f.label_right -column 1 -row 0 -sticky "n"
  137.     for {set i 0} { $i < $colorindex } { incr i} {
  138. grid config $w.f.label_left$i -column 0 -row [expr $i+1] 
  139. -sticky "snew"
  140. grid config $w.f.button$i -column 1 -row [expr $i+1] 
  141. -sticky "snew"
  142.     }
  143. }
  145. Animator instproc auto_legend {} {
  147.     $self instvar Mcnt plotmarks colorname filter_id filtercolor_id colorindex tlw_ 
  149.     set w $tlw_.autolegend
  150.  
  151.     if {[winfo exists $w]} {
  152.      raise $w
  153.         return
  154.     }
  156.     toplevel $w
  157.     wm title $w "Current Filter Legend"
  159.     bind $w <Control-w> "destroy $w"
  160.     bind $w <Control-W> "destroy $w"
  161.     bind $w <Control-q> "[AnimControl instance] done"
  162.     bind $w <Control-Q> "[AnimControl instance] done"
  163.  
  164.     frame $w.f
  165.     pack $w.f -side top
  166.  
  167.     label $w.f.label_left -text "LEGEND"
  168.     label $w.f.label_right -text "EXPLANATION"
  169.  
  170.     for {set i 0} { $i < $Mcnt } { incr i} {
  172. #    if { $i == 2 } { 
  173. #     set i [expr $i+$colorindex-2]
  174. #        }
  176. # if { $i > 1 } {
  177. #            label $w.f.label_left$i -bitmap $plotmarks($i) -fg $colorname($i)
  178. # } else {
  179. #     label $w.f.label_left$i -bitmap $plotmarks($i) -fg $colorname(0)
  180. # }
  182. label $w.f.label_left$i -bitmap $plotmarks($i) -fg $colorname($filtercolor_id($i))
  184.         label $w.f.button$i -text $filter_id($i)
  185.  
  186.     }
  187.  
  188.     grid config $w.f.label_left -column 0 -row 0 -sticky "n"
  189.     grid config $w.f.label_right -column 1 -row 0 -sticky "n"
  190.  
  191.     for {set i 0} { $i < $Mcnt } { incr i} {
  192. #        if { $i == 2 } { 
  193. #            set i [expr $i+$colorindex-2]
  194. #        }
  196.         grid config $w.f.label_left$i -column 0 -row [expr $i+1] 
  197.                 -sticky "snew"
  198.         grid config $w.f.button$i -column 1 -row [expr $i+1] 
  199.                 -sticky "snew"
  200.     }
  202. }
  204. Animator instproc ScrolledCanvas { c width height region } {
  205.         frame $c
  206.         canvas $c.canvas -width $width -height $height 
  207.                 -scrollregion $region 
  208.                 -xscrollcommand [list $c.xscroll set] 
  209.                 -yscrollcommand [list $c.yscroll set]
  210.         scrollbar $c.xscroll -orient horizontal 
  211.                 -command [list $c.canvas xview]
  212.         scrollbar $c.yscroll -orient vertical 
  213.                 -command [list $c.canvas yview]
  214.         pack $c.xscroll -side bottom -fill x
  215.         pack $c.yscroll -side right -fill y
  216.         pack $c.canvas -side left -fill both -expand true
  217.         pack $c -side top -fill both -expand true
  218.         return $c.canvas
  219. }
  221. Animator instproc build.m0 { w } {
  222.     bind $w <Configure> "$self xtimeticks $w"
  223. }
  225. Animator instproc xtimeticks { w } {
  226.     $self instvar timeslider mintime range timeslider_width
  228.     set width [winfo width $w]
  229.     set height [winfo height $w]
  231.     $w delete ticks
  232.     
  233.     set x [expr $timeslider(swidth)/2]
  234.     set intertick [expr ($width-$timeslider(swidth))/(10 * $range)]
  235.     for {set t $mintime} {$t < ($range+$mintime)} {set t [expr $t+0.1]} {
  236.         set intx [expr int($x)]
  237.         $w addtag ticks withtag 
  238.                 [$w create line 
  239.                 $intx [expr $timeslider(height)/2 + $height*9/10] $intx [expr $timeslider(height) + $height*9/10]]
  240.         set x [expr $x+$intertick]
  241.     }
  242.     
  243.     set orx [expr $timeslider(swidth)/2]
  244.     $w addtag ticks withtag 
  245.         [$w create line $orx [expr $timeslider(height)+$height*9/10] $x [expr $timeslider(height)+$height*9/10]]
  246.     $w addtag ticks withtag 
  247.    [$w create line $orx [expr $timeslider(height)+$height*9/10] $orx 0]]
  249.     set x [expr $timeslider(swidth)/2]
  250.     set intertick [expr ($width-$timeslider(swidth))/($range)]
  251.     for {set t $mintime} {$t < ($range+$mintime)} {set t [expr $t+1]} {
  252.         set intx [expr int($x)]
  253.         $w addtag ticks withtag 
  254.                 [$w create line 
  255.                 $intx [expr $timeslider(height) + $height*9/10] $intx [expr $height*9/10]]
  256.         set x [expr $x+$intertick]
  257.     }
  258. }
  261. Animator instproc make_mainwin { sid } {
  262.     $self tkvar model_ 
  263.     $self instvar session_id
  264.     $model_($sid) startview $session_id($sid)
  265. }
  268. # namgraph
  269. # pre-process for nam analysis
  271. Animator instproc nam_analysis { tracefile } {
  272.     $self instvar analysis_OK analysis_ready trace cache_ready count
  274.     set stream [new NamStream $tracefile]
  275.     set line [$stream gets]
  276.     set time [get_trace_item "-t" $line]
  277.     set count 0
  279.     #Handle nam version, *SHOULD NOT* assume the first line is V line
  281.     # skip all beginning non "*" events
  282.     while {([$stream eof]==0)&&([string compare $time "*"]!=0)} {
  283.         set line [$stream gets]
  284.         set time [get_trace_item "-t" $line] 
  285.     }
  287.     while {([$stream eof]==0)&&([string compare $time "*"]==0) } {
  288.         set cmd [lindex $line 0]
  289.             # Skip comment lines
  290.             if [regexp {^#} $cmd] {
  291.                     continue
  292.             }
  294.         switch "$cmd" {
  295.             "V" {
  296.                  $self handle_version $line
  297.              }
  298.     "N" {
  299.  $self handle_analysis $line
  300.      }
  301.       "c" {
  302.  $self handle_colorname $line
  303.      }
  304.         }
  305.         set count [expr $count + 1]
  306.         set line [$stream gets]
  307.         set time [get_trace_item "-t" $line]
  308.     }
  309.     $stream close
  311.     if { $count==0 } {
  312.          puts "*** !!! ***"
  313.          puts "nam cannot recognize the trace file $tracefile"
  314.          puts "Please make sure that the file is not empty and it is a nam trace"
  315.          puts "***********"
  316.          exit
  317.     }
  319.     # old nam, skip it
  320.     if { $analysis_OK == 0 } { 
  321.          puts "You are using the tracefile format older than 1.0a5"
  322.  puts "which will not allow you to run namgraph"
  323.          return
  324.     }
  326.     set cache_ready 0
  327. }
  329. Animator instproc cache_plot { } {
  330.     $self instvar tracefile plotdatax plotdatay plotmark plotmarks plotcolor
  332.     if ![info exists plotmarks] {
  333.     # Initialize - loop assign ?
  334.     set plotmarks(0) mark1
  335.     set plotmarks(1) mark2
  336.     set plotmarks(2) mark3
  337.     set plotmarks(3) mark4
  338.     set plotmarks(4) mark5
  339.     set plotmarks(5) mark6
  340.     set plotmarks(6) mark7
  341.     set plotmarks(7) mark8
  342.             set plotmarks(8) mark1
  343.             set plotmarks(9) mark2
  344.             set plotmarks(10) mark3
  345.             set plotmarks(11) mark4
  346.             set plotmarks(12) mark5
  347.             set plotmarks(13) mark6
  348.             set plotmarks(14) mark7
  349.             set plotmarks(15) mark8
  351.     }
  353.     set file [new NamStream $tracefile]
  355. #    set file [open $tracefile "r"]
  356.     $self tkvar model_
  358.     while {[$file eof]==0} {
  359. set line [$file gets]
  360. set time [get_trace_item "-t" $line]
  362.         if {[string compare $time "*"]==0 } {continue}
  364. set Sid [get_trace_item "-S" $line]
  365. set mid [get_trace_item "-m" $line]
  366. set pid [get_trace_item "-p" $line]
  367. set fid [get_trace_item "-f" $line]
  368. set yvalset [get_trace_item "-y" $line]
  370. set yval [lindex $yvalset 0]
  371. set ymark [lindex $yvalset 1]
  373. if { $mid == "" } {continue}
  375. set plotmark($Sid.$mid) $plotmarks($mid)
  376. set plotcolor($Sid.$mid) $fid
  378.         #NEW MCV stuff. It will replace the above code finally
  380. if ![info exists model_($Sid)] {
  381.     #create a new namgraph model
  382.     set model_($Sid) [new NamgraphModel $Sid $self]
  383.     # Attach this model to Animator
  384.     $self addObserver $model_($Sid)
  385. }
  387. set current_model $model_($Sid)
  388. $current_model adddata $self $mid $time $yval $ymark
  390.     }
  391.     $file close
  392. }
  394. Animator instproc handle_analysis { line } {
  396.     $self instvar session_id filter_id colorname highest_seq filtercolor_id 
  397.   ymark
  399.     set index [get_trace_item "-S" $line]
  400.     set findex [get_trace_item "-F" $line]
  401.     set title [get_trace_item "-n" $line]
  402.     set hseq [get_trace_item "-h" $line]
  403.     set mindex [get_trace_item "-M" $line]
  404.     set groupm [get_trace_item "-m" $line]
  405.     set proto [get_trace_item "-p" $line]
  407.     #session info
  408.     if { $index != "" && $title != "" } {
  409.         set session_id($index) $title
  410. set proto_id($index) $proto
  411.     }
  412.     if { $index != "" && $hseq != "" } {
  413. set highest_seq($index) $hseq
  414.     }
  415.     #filter info
  416.     if { $findex != "" } {
  417.         set filter_id($mindex) $title
  418. set filtercolor_id($mindex) $findex
  419.     }
  420.     
  421. }
  423. Animator instproc handle_colorname { line } {
  424.     $self instvar colorname
  425.     set index [get_trace_item "-i" $line] 
  426.     set colorn [get_trace_item "-n" $line]
  427.     set colorname($index) $colorn
  428. }
  430. Animator instproc handle_version { line } {
  432.     $self instvar analysis_OK nam_version analysis_ready colorindex 
  433. highest_seq Mcnt
  435.     set nam_version [get_trace_item "-v" $line]
  436.     if { $nam_version >= "1.0a5" } {
  437. set analysis_OK 1
  438.     }
  439.     set analysis_ready [get_trace_item "-a" $line]
  440.     set colorindex [get_trace_item "-c" $line]
  441.     #set highest_seq [get_trace_item "-h" $line]
  442.     #set Fcnt [get_trace_item "-F" $line]
  443.     #set Fcnt [expr $Fcnt+2]
  444.     set Mcnt [get_trace_item "-M" $line]
  445. }
  447. Animator instproc viewgraph { object graphtype tracefile } {
  448.     $self instvar netView now vslider windows nam_name graphs tlw_ 
  450.     if {$object==""} {return}
  451.     set graphtrace [new Trace $tracefile $self]
  452.     set netgraph ""
  453.     switch [lindex $object 0] {
  454. l {
  455.     set netgraph [new LinkNetworkGraph]
  456.     switch $graphtype {
  457. "bw" {
  458.     $netgraph bw [lindex $object 1] [lindex $object 2]
  459. }
  460. "loss" {
  461.     $netgraph loss [lindex $object 1] [lindex $object 2]
  462. }
  463.     }
  464. }
  465. f {
  466. set netgraph [new FeatureNetworkGraph]
  467. $netgraph feature [lindex $object 1] [lindex $object 2] [lindex $object 3]
  468.         }
  469.     }
  471.     if {$netgraph==""} {
  472. return
  473.     }
  474.     set name [lindex $object 0]_[lindex $object 1]_[lindex $object 2]_$graphtype
  476.     if {[winfo exists $tlw_.graph.f$name]==1} {
  477. return
  478.     }
  480.     $windows(title) configure -text "Please wait - reading tracefile..."
  481.     update
  482.     set maxtime [$graphtrace maxtime]
  483.     set mintime [$graphtrace mintime]
  484.     $graphtrace connect $netgraph
  485.     $netgraph timerange $mintime $maxtime
  487.     #force the entire tracefile to be read
  488.     $graphtrace settime $maxtime 1
  490.     set w $tlw_.graph
  491.     if {[winfo exists $w]==0} {
  492. frame $w 
  493. pack $w -side top -fill x -expand true -after [$vslider frame]
  494.     }
  495.     lappend graphs $netgraph
  496.     frame $w.f$name -borderwidth 2 -relief groove
  497.     pack $w.f$name -side top -expand true -fill both
  498.     label $w.f$name.pr -bitmap pullright -borderwidth 1 -relief raised
  499.     bind $w.f$name.pr <Enter> 
  500.   "$self viewgraph_label "[$self viewgraph_name $object $graphtype]" 
  501.   $w.f$name $w.f$name.pr $netgraph"
  502.     pack $w.f$name.pr -side left
  503.     $netgraph view $w.f$name.view
  505.     #set the current time in the graph
  506.     $netgraph settime $now
  508.     pack $w.f$name.view -side left -expand true 
  509.     -fill both
  510.     frame $w.f$name.l2 -width [expr [$vslider swidth]/2] -height 30
  511.     pack $w.f$name.l2 -side left
  512.     $windows(title) configure -text $nam_name
  513. }
  515. Animator instproc viewgraph_label {info win where netgraph} {
  516.     $self instvar tlw_
  518.     if {[winfo exists $win.lbl]==0} {
  519. frame $win.lbl -borderwidth 2 -relief groove
  520. button $win.lbl.hide -text "Hide" -relief raised -borderwidth 1 
  521. -highlightthickness 0 
  522. -command "destroy $win;
  523. $self rm_list_entry graphs $netgraph;
  524. if {[winfo children $tlw_.graph]=={}} {destroy $tlw_.graph}"
  525. pack $win.lbl.hide -side left
  526. label $win.lbl.l -text $info -font [smallfont]
  527. pack $win.lbl.l -side left
  528.     }
  529.     catch {
  530. pack $win.lbl -side left -after $where -fill y
  531. pack forget $where
  532. bind $win.lbl <Leave> 
  533.     "pack $where -side left -before $win.lbl;pack forget $win.lbl"
  534.     }
  535. }
  537. Animator instproc rm_list_entry {var value} {
  538.     $self instvar $var
  539.     set res ""
  540.     set lst [set [set var]]
  541.     foreach el $lst {
  542. if {[string compare $el $value]!=0} {
  543.     lappend res $el
  544. }
  545.     }
  546.     set [set var] $res
  547. }
  549. Animator instproc viewgraph_name {name graphtype} {
  550.     set type [lindex $name 0]
  551.     switch $type {
  552. "l" {
  553.     switch $graphtype {
  554. "bw" {
  555.     return "Bandwidth used on link [lindex $name 1]->[lindex $name 2]"
  556. }
  557. "loss" {
  558.     return "Packets dropped on link [lindex $name 1]->[lindex $name 2]"
  559. }
  560.     }
  561. }
  562. "f" {
  563.     return "[lindex $name 2] [lindex $name 3]"
  565. }
  566.     }
  567.     return unknown
  568. }