ns-namsupp.tcl

对ns2软件进行UMTS扩展

	}
}

# a link doesn't have its own trace file, write it to global trace file
Link instproc change-color { color } {
	puts "Warning: Link::change-color is obsolete. Please use Link::color."
	$self color $color
}

Link instproc get-color {} {
	puts "Warning: Node::get-color is obsolete. Please use Node::get-attribute"
	return [$self get-attribute "COLOR"]
}

Link instproc label { label } {
        $self instvar attr_ fromNode_ toNode_ trace_
        set ns [Simulator instance]
        if [info exists attr_(DLABEL)] {
            $ns puts-nam-config \
            "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DLABEL -l \"$label\" -L $attr_(DLABEL)"
        } else {
            $ns puts-nam-config \
            "l -t [$ns now] -s [$fromNode_ id] -d [$toNode_ id] -S DLABEL -l \"$label\" -L \"\""
        }
        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-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_
	# P.M. & P.B. modifications
	$self instvar addressType_

	if ![$self is-started] {
		return
	}
	foreach nn [array names Node_] {
		if ![$Node_($nn) is-lan?] {
			# P.M. & P.B. modifications, make distinction between hierarchical
			# and flat addressing like in ns-lib.tcl, proc initial_node_pos
			set prov [$Node_($nn) nodetype]
			if {!$prov} {
				$Node_($nn) dump-namconfig
			}
#			if { [info exists addressType_] && $addressType_ == "hierarchical" } {
#				# Hierarchical addressing
#				$Node_($nn) dump-namconfig
#			} else {
#				# Flat addressing
#				$Node_($nn) dump-namconfig-flat
#			}
		}
	}
}

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

	# 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"
}