nam.tcl

ns2.1b5版本中cbrp碼

		if $running {
			renderFrame
		}
	}
	bind $timeSlider <ButtonPress-1> {
		global sliderPressed prevTime
		set sliderPressed 1
	        set prevTime $now
		peer_cmd 1 "button_press_1 $prevTime"
	}
	bind $timeSlider <B1-Motion> {
		global range mintime trace nowDisp
		set tick [%W get]
		set now [expr ($tick * $range) / 100. + $mintime]
		set nowDisp [format %%.6f $now]
	}

#	button $w.rew -bitmap rewind \
#		-command rewind -anchor center -relief ridge
#	button $w.stop -bitmap stop \
#		-command stop -anchor center -relief ridge
#	button $w.idle -bitmap play \
#			-command play -anchor center -relief ridge
#	button $w.ff -bitmap "ff" \
#			-command fast_fwd -anchor center -relief ridge

	pack $w.slider -side left -fill x -expand 1
#	pack $w.rew $w.stop $w.idle $w.ff -side left
}

proc build.p1 w {
	set f [smallfont]
	frame $w.bar -relief ridge -borderwidth 2
	label $w.bar.title -text "   LBL Network Animator v[version]" \
		-anchor w -font $f -borderwidth 1
#	label $w.bar.timer -text Time: -font $f -borderwidth 1
	label $w.bar.timerVal -textvariable nowDisp -width 10 -anchor w -font $f \
		-borderwidth 1 -relief groove -anchor e
#	label $v.step -text "  Step:" -font $f -borderwidth 1
	label $w.bar.stepVal -textvariable stepDisp -width 8 -anchor w -font $f \
		-borderwidth 1 -relief groove -anchor e

	pack $w.bar.title -side left -fill x -expand 1
	pack $w.bar.timerVal $w.bar.stepVal -side left -pady 1 \
		-ipady 1 -padx 1 -padx 1

#	button $w.help -text Help -borderwidth 2 -relief raised \
#		-font $f -command "toggle_window .help" -width 5

	checkbutton $w.bar.run -text Run -borderwidth 1 -relief raised \
		-highlightthickness 1 -font $f -variable running \
		-command renderFrame

	button $w.bar.rew -text Rew -borderwidth 1 -relief raised \
		-highlightthickness 1 -font $f -command rewind

	button $w.bar.quit -text Quit -borderwidth 1 -relief raised \
		-highlightthickness 1 -font $f -command done


	pack $w.bar.run $w.bar.rew $w.bar.quit -side left \
		-padx 1 -pady 1 -ipadx 2
#	pack $w.bar.run -side left -padx 1 -pady 1
	pack $w.bar -fill x
}

proc back_step { } {
        global running
        if $running { stop 1 }
	backFrame
	peer_cmd 1 backFrame
}

proc toggle_pause { } {
        global running
        if $running {
		stop 1
	} else {
		play 1
	}
}

proc single_step { } {
        global running
        if $running { stop 1 }
        nextFrame
	peer_cmd 1 nextFrame
}

proc dead name {
	global peers
	set i [lsearch -exact $peers $name]
	set peers [lreplace $peers $i $i]
}

proc done { } {
        peer_cmd 1 "dead \"[winfo name .]\""
#	peer_cmd 1 "destroy ."
#	tkgraph_cmd 1 "destroy ."
        destroy .
}

proc all_done { } {
	peer_cmd 1 "destroy ."
	tkgraph_cmd 1 "destroy ."
	destroy .
}

proc remote_change_rate r {
        global timeStep stepDisp
        set timeStep $r
        set stepDisp [step_format $r]
}

proc change_rate inc {
        global timeStep stepDisp
        if $inc {
	        set timeStep [expr $timeStep + $timeStep*0.05]
	} else {
	        set timeStep [expr $timeStep - $timeStep*0.05]
	}	    
        set stepDisp [step_format $timeStep]
	peer_cmd 1 "remote_change_rate $timeStep"
}

proc start_info { x y } {
	global running resume nowDisp netView
	if $running {
	        set resume 1 
        } else {
	        set resume 0
	}
	stop 1
	set text [$netView info $nowDisp]
	if { [string length $text] > 0 } {
		message $netView.msg -width 8c -text $text
		place $netView.msg -x $x -y $y
	}
}

proc end_info {} { 
        global resume netView
	catch { destroy $netView.msg }
        if $resume { play 1 }
}

proc graph_init graphInput {
	global prevAckId prevPktId interval intervalStart intervalEnd range \
	       clearDataCmd graphName delay01 graphTool
	set prevAckId 0
	set prevPktId 0
	set delay01 0
	set clearDataCmd ""
	set intervalStart 0.0
	set intervalEnd [expr $intervalStart + $interval]
	exec tkgraph $graphInput &
	after 1000
	set interps [winfo interps]
	foreach i $interps {
		if [regexp ^tkgraph* $i] {
			after 1000
			set graphTool $i
			set graphName [send $i {graph_name}]
			tkgraph_cmd 0 \
			  "update_graph $graphName $intervalStart $intervalEnd"
			break
		}
	}
}

proc tkgraph_cmd { async cmd } {
	global graphName graphTool
	if { [string length $graphName] > 0 } {
		remote_cmd $async $graphTool $cmd
	}
}
proc remote_cmd { async interp cmd } {
	if $async {
		set rcmd "send -async \"$interp\" {$cmd}"
	} else {
		set rcmd "send \"$interp\" {$cmd}"
	}
	eval $rcmd
}

#proc master_cmd { async cmd } {
#	global master
#	if { [llength $master] > 0 } {
#		remote_cmd $async $master $cmd
#	}
#}

proc peer_cmd { async cmd } {
	global peers
	foreach s $peers {
		remote_cmd $async $s $cmd
	}
}

proc peer_init name {
	peer $name 0
	peer_cmd 0 "peer \"[winfo name .]\" 1"
}

proc peer { name remote } {
	global peers
	if { $remote } {
		peer_cmd 1 "peer \"$name\" 0"
		foreach s $peers {
			remote_cmd 1 $name "peer \"$s\" 0"
		}
	}
	lappend peers $name
}

# nam_init trace-name [g=graph-input] [i=graph-interval]
# where trace-name is the nam trace input file
#       graph-input is the input tcl file to tkgraph (optional)
#       graph-interval is the graph interval to be used (optional)
#                      and is only meaningful when a graph input file
#                      is provided
proc nam_init { tracefile args } {
	. configure -background [option get . background Nam]

	global trace now mintime range maxtime timeStep prevTime prevRate \
               rateSlider netView netModel currRate graphName \
	       interval running peers peerName granularity
	set netModel [new NetworkModel]
	set trace [new NamTrace $tracefile]
	set now [$trace mintime]
	set mintime $now
        set maxtime [expr [$trace maxtime] + .05]
	set range [expr $maxtime - $mintime]
        set prevTime $mintime
	$trace connect $netModel

	frame .view
	nam_config $netModel
	$netModel layout
	$netModel view .view.net
        set netView .view.net
	set running 0

	set interval [expr $range / 7.]
	set graphName ""
	set graphInput ""
	set peerName ""
	set peers ""
	set i 0
	foreach a $args {
		set x [lindex $args [expr $i+1]]
		set aa [split $a "="]
		set pn [format "%s %s" [lindex $aa 1] $x]
		switch [lindex $aa 0] {
			g {set graphInput [lindex $aa 1]}
			i {set interval [lindex $aa 1]}
			p {
				if {[string length $x] > 0} {
					set peerName $pn
				} else {
					set peerName [lindex $aa 1]
				}
			}
		}
		incr i
	}

	if { [llength $graphInput] > 0 } {
		graph_init $graphInput
	}
	if { [llength $peerName] > 0 } {
		peer_init $peerName
	}

	scale .view.rate -orient vertical -width 7p \
			-from 1 -to -60 -showvalue false \
			-relief groove
        set rateSlider .view.rate
	set granularity [option get . granularity Nam]
	set timeStep [time2real [option get . rate Nam]]
        set currRate [expr 10*log10($timeStep)]
        set prevRate $currRate
	$rateSlider set $currRate

	pack .view.net -side left -expand 1 -fill both
	pack .view.rate -side left -fill y
	
        bind $rateSlider <ButtonRelease-1> { 
		set v [%W get]
		set_rate $v 1
	}
	bind $rateSlider <ButtonPress-1> {
		global currRate prevRate
		set prevRate $currRate
	}
	bind $rateSlider <B1-Motion> {
		global timeStep stepDisp
		set v [%W get]
		set timeStep [expr pow(10, $v / 10.)]
		set stepDisp [step_format $timeStep]
	}
	
	frame .ctrl -relief flat -borderwidth 0
	frame .ctrl.p0 -relief flat -borderwidth 0
	build.p0 .ctrl.p0
	frame .ctrl.p1 -relief flat -borderwidth 0
	build.p1 .ctrl.p1

	pack .ctrl.p0 .ctrl.p1 -side top -fill x
	pack .view -fill both -expand 1
	pack .ctrl -fill x

	wm minsize . 200 200

	settime $now
	set_rate $currRate 1
	
        bind . <q> { done }
	bind . <Q> { all_done }
	bind . <Control-c> { done }
	bind . <Control-d> { done }

	bind . <space> { toggle_pause }
	bind . <Return> { single_step }
        bind . <b> { back_step }
        bind . <B> { back_step }
	bind . <BackSpace> { back_step }
	bind . <Delete> { back_step }

	bind .view.net <ButtonPress-3> { start_info %x %y }
	bind .view.net <ButtonRelease-3> { end_info }

	bind . <0> { reset }
	bind . <c> { play 1 }
	bind . <C> { play 1 }
	bind . <f> { fast_fwd }
	bind . <F> { fast_fwd }
	bind . <n> { next_event }
	bind . <N> { next_event }
	bind . <p> { stop 1 }
	bind . <P> { stop 1 }
	bind . <r> { rewind }
	bind . <R> { rewind }
	bind . <u> { time_undo }
	bind . <U> { time_undo }
	bind . <x> { rate_undo }
	bind . <X> { rate_undo }
	bind . <period> { change_rate 1 }
	bind . <greater> { change_rate 1 }
	bind . <comma> { change_rate 0 }
	bind . <less> { change_rate 0 }
}


set helpno 0
proc helpitem { w text } {
	global helpno
	set f [option get . helpFont Nam]
	set h $w.h$helpno
	incr helpno
	frame $h
	canvas $h.bullet -width 12 -height 12 
	$h.bullet create oval 6 3 12 9 -fill black
	message $h.msg -justify left -anchor w -font $f -width 460 -text $text
	pack $h.bullet -side left -anchor ne -pady 5
	pack $h.msg -side left -expand 1 -fill x -anchor nw
	pack $h -expand 1 -fill both
}

proc build.help { } {
	set w .help
	if [winfo exists $w] { return }
	toplevel $w
	bind $w <Enter> "focus $w"
	wm withdraw $w
	wm iconname $w "nam help"
	wm title $w "nam help"

	frame $w.frame -borderwidth 2 -relief raised
	set p $w.frame
	helpitem $p "Sorry, nothing here yet."

	button $w.frame.ok -text " Dismiss " -borderwidth 2 -relief raised \
		-command "wm withdraw $w" -font [mediumfont] 
	pack $w.frame.ok -pady 6 -padx 6 -anchor e

	pack $w.frame -expand 1 -fill both
}

#
# helper functions
#
proc nam_angle { v } {
	switch $v {
		up-right -
		right-up	{ return 0.25 }
		up		{ return 0.5 }
		up-left -
		left-up		{ return 0.75 }
		left		{ return 1. }
		left-down -
		down-left	{ return 1.25 }
		down		{ return 1.5 }
		down-right -
		right-down	{ return 1.75 }
		default		{ return 0.0 }
	}
}

proc mklink { net n0 n1 bandwidth delay angle } {
	global delay01
	set th [nam_angle $angle]
	set result [$net link $n0 $n1 \
			[bw2real $bandwidth]  [time2real $delay] $th]
	$net link $n1 $n0 \
		[bw2real $bandwidth] [time2real $delay] [expr $th + 1]
	if { $n0 == 0 && $n1 == 1 } {
		set delay01 $result
	}
}

proc asym-mklink { net n0 n1 bandwidth1 delay1 bandwidth2 delay2 angle } {
	global delay01
	set th [nam_angle $angle]
	set result [$net link $n0 $n1 \
			[bw2real $bandwidth1]  [time2real $delay1] $th]
	$net link $n1 $n0 \
		[bw2real $bandwidth2] [time2real $delay2] [expr $th + 1]
	if { $n0 == 0 && $n1 == 1 } {
		set delay01 $result
	}
}

proc mklinkq { net n0 n1 bandwidth delay angle } {
	mklink $net $n0 $n1 $bandwidth $delay $angle
	$net queue $n0 $n1 0.5
	$net queue $n1 $n0 0.5
}

proc ncolor {n0 color} {
	global netModel
	$netModel ncolor $n0 $color
}

proc ecolor {n0 n1 color} {
	global netModel
	$netModel ecolor $n0 $n1 $color
	$netModel ecolor $n1 $n0 $color
}