nam.tcl

ns2.1b5版本中cbrp碼

#
# Copyright (c) 1993-1994 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the Computer Systems
#	Engineering Group at Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /usr/cvs/ns/ns-src/nam/nam.tcl,v 1.1.1.1 1998/01/13 15:06:11 root Exp $ (LBL)
#
set tk_strictMotif 0

set uscale(m) 1e-3
set uscale(u) 1e-6
set uscale(k) 1e3
set uscale(M) 1e6

proc time2real v {
	global uscale
	foreach u [array names uscale] {
		set k [string first $u $v]
		if { $k >= 0 } {
			set scale $uscale($u)
			break
		}
	}
	if { $k > 0 } {
		set v [string range $v 0 [expr $k - 1]]
		set v [expr $scale * $v]
	}
	return $v
}
#XXX
proc bw2real v {
	return [time2real $v]
}

#XXX
proc mapf s { return $s }

proc version {} { return 1.0a1 }

option add Nam.foundry adobe startupFile
set ff [option get . foundry Nam]
set helv10 [mapf "-$ff-helvetica-medium-r-normal--*-100-75-75-*-*-*-*"]
set helv10b [mapf "-$ff-helvetica-bold-r-normal--*-100-75-75-*-*-*-*"]
set helv10o [mapf "-$ff-helvetica-bold-o-normal--*-100-75-75-*-*-*-*"]
set helv12 [mapf "-$ff-helvetica-medium-r-normal--*-120-75-75-*-*-*-*"]
set helv12b [mapf "-$ff-helvetica-bold-r-normal--*-120-75-75-*-*-*-*"]
set helv14 [mapf "-$ff-helvetica-medium-r-normal--*-140-75-75-*-*-*-*"]
set helv14b [mapf "-$ff-helvetica-bold-r-normal--*-140-75-75-*-*-*-*"]
set times14 [mapf  "-$ff-times-medium-r-normal--*-140-75-75-*-*-*-*"]

option add Nam.viewBackground gray80 startupFile
option add *font $helv12b startupFile
option add *Font $helv12b startupFile

option add Nam.disablefont $helv10o startupFile
option add Nam.smallfont $helv10b startupFile
option add Nam.medfont $helv12b  startupFile
option add Nam.helpFont $times14 startupFile
option add Nam.entryFont $helv10 startupFile

option add *Radiobutton.relief flat startupFile

option add Nam.rate		2ms	startupFile
option add Nam.movie		0	startupFile
option add Nam.granularity	40	startupFile
option add Nam.pause		1	startupFile

#
# use 2 pixels of padding by default
#
option add *padX 2 startupFile
option add *padY 2 startupFile
#
# don't put tearoffs in pull-down menus
#
option add *tearOff 0 startupFile

proc smallfont { } {
	return [option get . smallfont Nam]
}
proc mediumfont { } {
	return [option get . medfont Nam]
}

proc toggle_window w {
	if ![winfo exists $w] { build$w }
	global created$w
	if ![info exists created$w] {
		set created$w 1
		wm transient $w .
		update idletasks
		set x [winfo rootx .]
		set y [winfo rooty .]
		incr y [winfo height .]
		incr y -[winfo reqheight $w]
		incr y -20
 		# adjust for virtual desktops
		incr x [winfo vrootx .]
		incr y [winfo vrooty .]
		if { $y < 0 } { set y 0 }
		if { $x < 0 } {
			set x 0
		} else {
			set right [expr [winfo screenwidth .] - \
					   [winfo reqwidth $w]]
			if { $x > $right } {
				set x $right
			}
		}
		wm geometry $w +$x+$y
		wm deiconify $w
	} elseif [winfo ismapped $w] {
		wm withdraw $w
	} else {
		wm deiconify $w
	}
}

proc backFrame { } {
	global now timeStep
	settime [expr $now - $timeStep]
}

proc nextFrame { } {
	global now timeStep
	settime [expr $now + $timeStep]
}

proc net_settime t {}

#
# Set time slider to a tick value between 0 and 100.
#
set sliderPressed 0
proc settime t {
	#XXX
	net_settime $t    

        global sliderPressed range mintime timeSlider trace now nowDisp \
		maxtime graphName
        if { $t > $maxtime } {
		stop 1
		return
	} elseif { $t < $mintime } {
	        set t $mintime
	}
	set now $t
	set nowDisp [format %.6f $now]
	if { $sliderPressed == 0 } {
	        $timeSlider set [expr int(100. * ($now - $mintime) / $range)]
	}
	set event [$trace settime $now $sliderPressed]
	if { [string length $graphName] > 0 } {
		if { [string length $event] > 0 } {
			graph_update $event
		}
	}
}

proc draw_data_pnt { tim id } {
	global prevAckId prevPktId clearDataCmd clearAckCmd lastDrawCmd \
	       graphName
	if { $prevAckId != 0 } {
		tkgraph_cmd 0 $clearAckCmd
		set prevAckId 0
	} elseif { $prevPktId != 0 } {
		tkgraph_cmd 0 $clearDataCmd
	}
	set lastDrawCmd "draw_point $graphName $tim $id"
	tkgraph_cmd 1 $lastDrawCmd
	set clearDataCmd "clear_point $graphName $tim $id"
	set prevPktId $id
}

proc draw_ack_pnt { tim id } {
	global prevAckId prevPktId delay01 graphName lastDrawCmd clearAckCmd \
	       clearDataCmd
	if { $prevAckId != 0 } {
		tkgraph_cmd 0 $clearAckCmd
	} elseif { $prevPktId != 0 } {
		tkgraph_cmd 0 $clearDataCmd
		set prevPktId 0
	}
	set prevAckId $id
	set arriv [expr $tim + $delay01]
	set lastDrawCmd "draw_point $graphName $arriv $id"
	tkgraph_cmd 1 $lastDrawCmd
	set clearAckCmd "clear_point $graphName $arriv $id"
}

proc graph_update_interval tim {
	global intervalStart intervalEnd mintime maxtime lastDrawCmd \
	       interval graphName

	# Update graph interval as needed.
	set overlap [expr 0.2 * $interval]
	if { $tim > $intervalStart && $tim < $intervalEnd } {
		return
	}
	if { $tim > $maxtime } {
		stop 1
		return
	}
	if { $tim >= [expr $intervalEnd - $overlap] } {
		set intervalStart [expr $intervalEnd - $overlap]
	} elseif { $tim < $intervalStart } {
		set intervalStart [expr $tim - 0.5 * $interval]
	}
	set intervalEnd [expr $intervalStart + $interval]
		
	# Check if going beyond max x or min x and update interval
	# accordingly.
	if { $intervalEnd > $maxtime } {
		set intervalEnd [expr $maxtime + $overlap]
		set intervalStart [expr $intervalEnd - $interval]
	} elseif { $intervalStart <= $mintime } {
		set intervalStart 0.0
		set intervalEnd [expr $intervalStart + $interval]
	}

	set cmd [format "update_graph %s %.17g %.17g" \
			 $graphName $intervalStart $intervalEnd]
	tkgraph_cmd 1 $cmd
	
	# Redraw last point drawn.
	tkgraph_cmd 1 $lastDrawCmd
}

proc graph_update events {

	set el [split $events /]
	
	foreach e $el {
		scan $e "%d %d %g %g" src dst tim id

		# Draw and/or clear any points as needed.
		if { $src == 0 } {
			# data packet leaving node 0
			draw_data_pnt $tim $id

		} elseif { $dst == 0 } {
			# Ack packet leaving node 1 (to 0).  Just need to save
			# ack id. Point for ack will be drawn later when the
			# first data packet sent as a result of this ack leaves
			# node 0.
			draw_ack_pnt $tim $id
		}
		graph_update_interval $tim
	}
}

proc slidetime { tick remote } {
	global now range mintime trace
	set now [expr ($tick * $range) / 100. + $mintime]
	settime $now
	if { $remote } {
		peer_cmd 1 "slidetime $tick 0"
	}
}

proc bumpstepper { amt remote } {
	set v [.right.rate get]
	incr v [expr - $amt]
	if { $v > 100 } {
		.right.rate set 100
	} {
		if { $v < 0 } {
			.right.rate set 0
		} {
			.right.rate set $v
		}
	}
	if { $remote } {
		peer_cmd 1 "bumpstepper $amt 0"
	}
}

proc renderFrame { } {
	global running sliderPressed granularity
	if { $running && !$sliderPressed } {
		nextFrame
		update idletasks
		after $granularity renderFrame
	}
}

proc remote_play t {
        global timeSlider
        settime $t
        play 0
}

proc play remote {
	global running now
	set running 1
	after 0 renderFrame
	if { $remote } {
		peer_cmd 1 "remote_play $now"
	}
}

proc remote_stop t {
        stop 0
        settime $t
}

proc stop remote {
	global running now
	set running 0
	if { $remote } {
		peer_cmd 1 "remote_stop $now"
	}
}

proc remote_set_time t {
        global timeSlider
        settime $t
}

proc reset { } {
	settime 0.
	peer_cmd 1 "remote_set_time 0."
}

proc rewind { } {
	global now timeStep
	set t [expr $now - $timeStep*25.0]
	settime $t
	peer_cmd 1 "remote_set_time $t"
#	settime 0.
#	peer_cmd 1 "remote_set_time 0."
}

proc fast_fwd { } {
	global now timeStep
        set t [expr $now + $timeStep*25.0]
        settime $t
	peer_cmd 1 "remote_set_time $t"
}

proc next_event { } {
	global trace running
	set t [$trace nxtevent]
	settime $t
	peer_cmd 1 "remote_set_time $t"
	if { !$running } {
		nextFrame
		peer_cmd 1 nextFrame
	}
}

proc step_format t {
	if { $t < 1e-3 } {
		return [format "%.1f" [expr $t * 1e6]]us
	} elseif { $t < 1. } {
		return [format "%.1f" [expr $t * 1e3]]ms
	}
	return [format "%.1f" $t]s
}

proc set_rate { v remote } {
	global timeStep stepDisp rateSlider currRate
	set timeStep [expr pow(10, $v / 10.)]
	set stepDisp [step_format $timeStep]
        if { [$rateSlider get] != $v } { $rateSlider set $v }
	set currRate $v
	if { $remote } {
		peer_cmd 1 "set_rate $v 0"
	}
}

# Set time to its previous value (before it was changed by
# pressing mouse button 1 on the time slider).
proc time_undo { } {
        global timeSlider prevTime now
        set currTime $now
        settime $prevTime
	peer_cmd 1 "settime $prevTime"
        set prevTime $currTime
}

# Set rate to its previous value (before it was changed by
# pressing mouse button 1 on the rate slider).
proc rate_undo { } {
        global prevRate rateSlider
        set tmpRate [$rateSlider get]
        set_rate $prevRate 1
        $rateSlider set $prevRate
        set prevRate $tmpRate
}

proc button_release_1 t {
        global timeSlider
	slidetime $t 1
        $timeSlider set $t
	global sliderPressed
	set sliderPressed 0
}

proc button_press_1 s {
	global sliderPressed prevTime
	set sliderPressed 1
        set prevTime $s
}

proc build.p0 w {
	scale $w.slider -orient horizontal -width 7p \
			-from 0 -to 100 -showvalue false -relief groove \
			-borderwidth 1

	#
	# We want slightly different semantics.  Instead of tracking
	# the time slider continuously, we just update it when the
	# button is released.
	# E.g., it takes too long to do a fast-forward each time.
	#
	global timeSlider 
	set timeSlider $w.slider
	bind $timeSlider <ButtonRelease-1> {
	        set t [%W get]
		slidetime $t 1
		global sliderPressed running
		set sliderPressed 0
		peer_cmd 1 "button_release_1 $t"