ns-namsupp.tcl

来自「一款用来进行网络模拟的软件」· TCL 代码 · 共 591 行 · 第 1/2 页

        set attr_(DLABEL) \"$label\"
    }

Link instproc label-color { str } {
        $self instvar attr_ fromNode_ toNode_ trace_
        set ns [Simulator instance]
        if [info exists attr_(DCOLOR)] {
            $ns puts-nam-config \
            "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DCOLOR -e \"$str\" -E $attr_(DCOLOR)"
        } else {
            $ns puts-nam-config \
            "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DCOLOR -e \"$str\" -E \"\""
        }
        set attr_(DCOLOR) \"$str\"
    }

Link instproc label-at { str } {
        $self instvar attr_ fromNode_ toNode_ trace_
        set ns [Simulator instance]
        if [info exists attr_(DIRECTION)] {
            $ns puts-nam-config \
            "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DIRECTION -p \"$str\" -P $attr_(DIRECTION)"
        } else {
            $ns puts-nam-config \
            "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DIRECTION -p \"$str\" -P \"\""
        }
        set attr_(DIRECTION) \"$str\"
    }

#
# Support for nam snapshot
#

Simulator instproc snapshot { } {
    set ns [Simulator instance]
    $ns puts-nam-config \
            "v -t [$self now] take_snapshot"
}

Simulator instproc rewind-nam { } {
	set ns [Simulator instance]
	$ns puts-nam-config \
			"v  -t [$self now] playing_backward"
}

Simulator instproc re-rewind-nam { } {
	set ns [Simulator instance]
	$ns puts-nam-config \
				"v  -t [$self now] playing_forward"
}

Simulator instproc terminate-nam { } {
	set ns [Simulator instance]
	$ns puts-nam-config \
				"v  -t [$self now] terminating_nam"
}

#
# Support for agent tracing
#

# This function records agents being traced, so they will be written into nam
# trace when the simulator starts
Simulator instproc add-agent-trace { agent name {f ""} } {
	$self instvar tracedAgents_
	set tracedAgents_($name) $agent

	set trace [$self get-nam-traceall]
	if {$f != ""} {
		$agent attach-trace $f
	} elseif {$trace != ""} {
		$agent attach-trace $trace
	}
}

Simulator instproc delete-agent-trace { agent } {
	$agent delete-agent-trace
}

Simulator instproc monitor-agent-trace { agent } {
	$self instvar monitoredAgents_
	lappend monitoredAgents_ $agent
}

#
# Agent trace is added when attaching to a traced node
# we need to keep a file handle in tcl so that var tracing can also be 
# done in tcl by manual inserting update-var-trace{}
#
Agent instproc attach-trace { file } {
	$self instvar namTrace_
	set namTrace_ $file 
	# add all traced var messages
	$self attach $file 
}

#
# nam initialization
#
Simulator instproc dump-namagents {} {
	$self instvar tracedAgents_ monitoredAgents_
	
	if {![$self is-started]} {
		return
	}
	if [info exists tracedAgents_] {
		foreach id [array names tracedAgents_] {
			$tracedAgents_($id) add-agent-trace $id
			$tracedAgents_($id) cmd dump-namtracedvars
		}
		unset tracedAgents_
	}
	if [info exists monitoredAgents_] {
		foreach a $monitoredAgents_ {
			$a show-monitor
		}
		unset monitoredAgents_
	}
}

Simulator instproc dump-namversion { v } {
	$self puts-nam-config "V -t * -v $v -a 0"
}

Simulator instproc dump-namwireless {} {
	$self instvar namNeedsW_ namWx_ namWy_

	# see if we need to write a W event
	if ![info exists namNeedsW_] { set namNeedsW_ 0 }
	if {[info exists namWx_] && [info exists namWy_]}  {
		set maxX $namWx_
		set maxY $namWy_
	} else {
		set maxX 10
		set maxY 10

		# get max X and Y coords of nodes
		# if any nodes have coordinates set, then flag the need for
		# a W event and adjust maxX/maxY as needed
		foreach node [Node info instances] {
			if {[lsearch -exact [$node info vars] X_] != -1} {
				set namNeedsW_ 1
				set curX [$node set X_]
				if {$curX > $maxX} {set maxX $curX}
			}
			if {[lsearch -exact [$node info vars] Y_] != -1} {
				set namNeedsW_ 1
				set curY [$node set Y_]
				if {$curY > $maxY} {set maxY $curY}
			}
		}
	}

	if $namNeedsW_ {
		$self puts-nam-config "W -t * -x $maxX -y $maxY"
	}
}

Simulator instproc dump-namcolors {} {
	$self instvar color_
	if ![$self is-started] {
		return 
	}
	foreach id [array names color_] {
		$self puts-nam-config "c -t * -i $id -n $color_($id)"
	}
}

Simulator instproc dump-namlans {} {
	if ![$self is-started] {
		return
	}
	$self instvar Node_
	foreach nn [array names Node_] {
		if [$Node_($nn) is-lan?] {
			$Node_($nn) dump-namconfig
		}
	}
}

Simulator instproc dump-namlinks {} {
	$self instvar linkConfigList_
	if ![$self is-started] {
		return
	}
	if [info exists linkConfigList_] {
		foreach lnk $linkConfigList_ {
			$lnk dump-namconfig
		}
		unset linkConfigList_
	}
}

Simulator instproc dump-namnodes {} {
	$self instvar Node_
	if ![$self is-started] {
		return
	}
	foreach nn [array names Node_] {
		if ![$Node_($nn) is-lan?] {
			$Node_($nn) dump-namconfig
		}
	}
}

Simulator instproc dump-namqueues {} {
	$self instvar link_
	if ![$self is-started] {
		return
	}
	foreach qn [array names link_] {
		$link_($qn) dump-nam-queueconfig
	}
}

# Write hierarchical masks/shifts into trace file
Simulator instproc dump-namaddress {} {
	# First write number of hierarchies
	$self puts-nam-config \
	    "A -t * -n [AddrParams hlevel] -p 0 -o [AddrParams set \
ALL_BITS_SET] -c [AddrParams McastShift] -a [AddrParams McastMask]"
	
	for {set i 1} {$i <= [AddrParams hlevel]} {incr i} {
		$self puts-nam-config "A -t * -h $i -m [AddrParams \
NodeMask $i] -s [AddrParams NodeShift $i]"
	}
}

Simulator instproc init-nam {} {
	$self instvar annotationSeq_ 

	set annotationSeq_ 0

	# Setting nam trace file version first
	$self dump-namversion 1.0a5
	
	# write W event if needed
	$self dump-namwireless

	# Addressing scheme
	$self dump-namaddress
	
	# Color configuration for nam
	$self dump-namcolors
	
	# Node configuration for nam
	$self dump-namnodes
	
	# Lan and Link configurations for nam
	$self dump-namlinks 
	$self dump-namlans
	
	# nam queue configurations
	$self dump-namqueues
	
	# Traced agents for nam
	$self dump-namagents

}

#
# Other animation control support
# 
Simulator instproc trace-annotate { str } {
	$self instvar annotationSeq_
	$self puts-ns-traceall [format \
		"v %s %s {set sim_annotation {%s}}" [$self now] eval $str]
	incr annotationSeq_
	$self puts-nam-config [format \
		"v -t %.15g -e sim_annotation %.15g $annotationSeq_ $str" \
		[$self now] [$self now] ]
}

proc trace_annotate { str } {
	set ns [Simulator instance]

	$ns trace-annotate $str
}

proc flash_annotate { start duration msg } {
	set ns [Simulator instance]
	$ns at $start "trace_annotate {$msg}"
	$ns at [expr $start+$duration] "trace_annotate periodic_message"
}

# rate's unit is second
Simulator instproc set-animation-rate { rate } {
	# time_parse defined in tcl/rtp/session-rtp.tcl
	set r [time_parse $rate]
	# This old nam api (set_rate) works but is quite obscure,
	# the new api (set_rate_ext) is simpler.
	# $self puts-nam-config "v -t [$self now] set_rate [expr 10*log10($r)] 1"
	$self puts-nam-config "v -t [$self now] set_rate_ext $r 1"
}