#!/usr/local/bin/wish -f
#
#
# XNET MAIN WINDOW
#
# Richard R. Parry
# Version 1.00, Jul 10, 1995
#

# Set global variable, flags, and counters. \
	Set up main widget with buttons, initialize variables, \
	bind keyboard shortcuts

global node_hrd \
	node_lcmd \
	node_msg \
	node_heard \
	node_pcnt \
	node_fhrd \
	node_lhrd


# key locations in node array, for documentation and easy maintenance
set node_hrd    0
set node_lcmd   1
set node_msg    2
set node_heard  3
set node_pcnt   4
set node_fhrd   5
set node_lhrd   6
set node_arrend 6


set console_open 0
set nodes_open 0
set graf_open 0
set map_open 0
set graf_indx 0
set xNet_stopped 1


wm geometry . +0+0
wm title . "XNET NETWORK ANALYZER"
wm iconname . "XNET"


frame .topframe -relief raised -bd 2
frame .bframe -relief raised -bd 2
frame .botframe -relief raised -bd 2
canvas .c0 -width 300 -height 200

button .quit -text "QUIT" -command {
    destroy .
}

button .simul -text "SIMUL" -command {
    source xSimul.tcl
    xSimul
}

button .port -text "PORT" -command {
    source xPort.tcl
    xPort
}

button .prefs -text "PREFS" -command {
    source xPrefs.tcl
    xPrefs
}

button .nodes -text "NODES" -command {
    source xNodes.tcl
    xNodes
}

button .map -text "MAP" -command {
    source xMap.tcl
    xMap
}

button .con -text "TERM" -command {
    source xTerm.tcl
    xTerm
}

button .graf -text "GRAPH" -command {
    source xGraf.tcl
    xGraf
}

button .start -text "START" -command {
    if {$xNet_stopped} {
	set xNet_stopped 0

	# Open input, and clear display if open
	open_input
	if {$console_open} {term_clear}
	if {$nodes_open} {clear_buttons}
	if {$graf_open} {clear_graf_data}
	if {$map_open} {clear_map_data}
	
	# Get start "real" time
	set fid [open {|date}]
	gets $fid start_time
	close $fid
	.s_time config -text $start_time

	# Start heart beat
	tick
    }
}


button .stop -text "STOP" -command {
    if {!$xNet_stopped} {
	set xNet_stopped 1
	close_input
    }
}


#
# Make Shortcut Hot keys!!!
#
bind . <s> {.start invoke}

bind . <o> {.stop invoke}

bind . <q> {.quit invoke}

bind . <l> {
    source xSimul.tcl
    xSimul
}

bind . <p> {
    source xPort.tcl
    xPort
}

bind . <f> {
    source xPrefs.tcl
    xPrefs
}

bind . <m> {
    source xMap.tcl
    xMap
}

bind . <n> {
    source xNodes.tcl
    xNodes
}

bind . <g> {
    source xGraf.tcl
    xGraf
}

bind . <t> {
    source xTerm.tcl
    xTerm
}


#
# Pack widgets
#
pack .topframe -side top  -fill both -expand yes
pack .bframe -side top -fill both -expand yes
pack .botframe -side bottom -fill both -expand yes


pack .start .simul .port .prefs .stop -in .topframe -side left -fill x -expand yes -pady 5
pack .c0 -in .bframe -expand yes -fill both
pack .map .nodes .con .graf .quit -in .botframe -side left -fill x -expand yes -pady 5


focus default .



#
# Make center canvas and place icon on it
#

set lab_font -Adobe-helvetica-medium-r-normal--*-120*
set lab_color black
set val_color brown

label .hbeat_cnt_lab -fg $lab_color -font $lab_font \
	-text "Elapsed Time:"
label .counter -fg $val_color -font $lab_font -text 00:00:00

label .pac_ctot_lab -fg $lab_color -font $lab_font -text "Total Packets:"
label .pac_ctot -fg $val_color -font $lab_font -text 0

label .node_cnt_lab -fg $lab_color -font $lab_font -text "Active Nodes:"
label .node_cnt -fg $val_color -font $lab_font -text 0

label .s_time_lab -fg $lab_color -font $lab_font -text "Start Time:"
label .s_time -fg $val_color -font $lab_font -text "--------------"

label .node_ctot_lab -fg $lab_color -font $lab_font -text "Total Nodes:"
label .node_ctot -fg $val_color -font $lab_font -text 0

label .pac_cnt_lab -fg $lab_color -font $lab_font -text "Active Packets:"
label .pac_cnt -fg $val_color -font $lab_font -text 0

label .conn_cnt_lab -fg $lab_color -font $lab_font -text "Connect Nodes:"
label .conn_cnt -fg $val_color -font $lab_font -text 0

label .version_lab -text "VER 1.00 RRP" \
	-font -Adobe-helvetica-medium-r-normal--*-80*
label .logo_x -text "X" \
	-font -Adobe-helvetica-bold-r-normal--*-240* -fg white -bg pink
label .logo_n -text "N" \
	-font -Adobe-helvetica-bold-r-normal--*-240* -fg white -bg orange
label .logo_e -text "E" \
	-font -Adobe-helvetica-bold-r-normal--*-240* -fg white -bg brown
label .logo_t -text "T" \
	-font -Adobe-helvetica-bold-r-normal--*-240* -fg white -bg black


# Labels
.c0 create window 50 50 -window .s_time_lab -anchor nw
.c0 create window 50 70 -window .hbeat_cnt_lab -anchor nw
.c0 create window 50 90 -window .pac_ctot_lab -anchor nw
.c0 create window 50 110 -window .pac_cnt_lab -anchor nw
.c0 create window 50 150 -window .node_cnt_lab -anchor nw
.c0 create window 50 130 -window .node_ctot_lab -anchor nw
.c0 create window 50 170 -window .conn_cnt_lab -anchor nw


# Values
.c0 create window 115 50 -window .s_time -anchor nw
.c0 create window 150 70 -window .counter -anchor nw
.c0 create window 150 90 -window .pac_ctot -anchor nw
.c0 create window 150 110 -window .pac_cnt -anchor nw
.c0 create window 150 150 -window .node_cnt -anchor nw
.c0 create window 150 130 -window .node_ctot -anchor nw
.c0 create window 150 170 -window .conn_cnt -anchor nw


# Title characters
.c0 create window 225 180 -window .version_lab -anchor nw
.c0 create window 90 10  -window .logo_x -anchor n
.c0 create window 130 10  -window .logo_n -anchor n
.c0 create window 170 10  -window .logo_e -anchor n
.c0 create window 210 10  -window .logo_t -anchor n






#
# This script generates the master "heart beat" every second. \
	It will be used by procedures for update times.

proc tick {} {

    global secs mins hrs tens \
	    pac_chr_tot \
	    graf_data \
	    graf_indx \
	    graf_open \
	    xNet_stopped

    if {$xNet_stopped} {return}

    after 1000 tick
    incr secs

    incr tens
    if {$tens == 10} {
	set tens 0
	update_nodes
	update_conn
    }


    if {$secs == 60} {
	set secs 0
	incr mins

	# Save tot chrs this past minute, \
		reset circulator buffer if end of buffer
	incr graf_indx
	set graf_data($graf_indx) $pac_chr_tot
	set pac_chr_tot 0
	if {$graf_indx == 1500} {
	    set graf_indx 0
	    set graf_data($graf_indx) -99
	}

	if {$graf_open} { graf_it }
    }


    if {$mins == 60} {
	set mins 0
	incr hrs
    }
    # Update the time (every second)
    .counter config -text [format "%02d:%02d:%02d" $hrs $mins $secs]
}




#
# Open file (or serial port) to get packets, reset counters.
#
proc open_input {} {

    global pid_num \
	    inputFile \
	    input_port \
	    pac_ctot \
	    pac_cnt \
	    node_ctot \
	    pac_chr_tot \
	    graf_indx \
	    node_cnt \
	    secs mins hrs tens \
	    rbaud \
	    hrd_to \
	    uhrd_to \
	    con_to \
	    n_a \
	    dest_cnt \
	    conn_cnt



    # initialize misc. pointers, counters, etc.
    set node_cnt 0
    set graf_indx 0
    set pac_ctot 0
    set pac_cnt 0
    set conn_cnt 0
    set node_ctot 0
    set pac_chr_tot 0


    # initialize time variables
    set secs 0
    set mins 0
    set hrs 0
    set tens 0
    set n_a 0


    # initialize "connect array" variables
    set dest_cnt 0
    set conn_cnt 0


    # initialize main console statistics
    .counter config -text [format "%02d:%02d:%02d" $hrs $mins $secs]
    .pac_ctot config -text [format "%d" $pac_ctot]
    .node_cnt config -text [format "%d" $node_cnt]
    .s_time config -text "-"
    .node_ctot config -text [format "%d" $node_ctot]
    .pac_cnt config -text [format "%d" $pac_cnt]
    .conn_cnt config -text [format "%d" $conn_cnt]


    #
    # Get preferences from the preferences file
    #
    set pf [open prefs r]
    gets $pf input_port
    gets $pf serial_port
    gets $pf baud
    gets $pf stopbits
    gets $pf framesize
    gets $pf parity
    gets $pf rbaud
    gets $pf hrd_to
    gets $pf uhrd_to
    gets $pf con_to
    close $pf


    #
    # If input source is file select it, else configure serial port
    #
    if {$input_port == 0} {

	# turn off character echo, recieve only.
	exec stty -echo < $serial_port

	# specify CR and NL characters to accept
	exec stty -inlcr igncr -icrnl < $serial_port

	switch $baud {
		300 {exec stty   300 < $serial_port}
		1200 {exec stty  1200 < $serial_port}
		2400 {exec stty  2400 < $serial_port}
		9600 {exec stty  9600 < $serial_port}
		19200 {exec stty 19200 < $serial_port}
	}

	switch $stopbits {
		1 {exec stty  cstopb < $serial_port}
		2 {exec stty -cstopb < $serial_port}
	}

	switch $framesize {
		7 {exec stty  cs7 < $serial_port}
		8 {exec stty  cs8 < $serial_port}
	}

	switch $parity {
		O {exec stty  parodd parenb < $serial_port}
		E {exec stty -parodd parenb < $serial_port}
		N {exec stty -parenb < $serial_port}
	}

	# open port, initialize TNC
	set inputFile [open  $serial_port r+]
	puts $inputFile "ECHO OFF"
	puts $inputFile "HEADERL OFF"
	puts $inputFile "MP ON"
	puts $inputFile "M 6"
	puts $inputFile "MCOM ON"


     } else {

	 # open simulation file and get process ID
	 set inputFile [open "| sh $input_port"]
	 set pid_num [pid $inputFile]
     }

	addinput -read $inputFile "file_input %% %E %F"
 }






# This procedure is called each time a packet arrives, it is in \
	many ways the "heart" of the program. This procedure and \
	the procedures that it calls are responsible for parsing \
	the packet and extracting the information, and then \
	creating the main arrays from which virtually all data \
	that is displayed relies on.

proc file_input {token events fileid} {

    global secs mins hrs \
	    time_now \
	    node_hrd \
	    node_lcmd \
	    node_msg \
	    node_heard \
	    node_pcnt \
	    node_fhrd \
	    node_lhrd \
	    node_cnt \
	    node_arr \
	    node_buf \
	    console_open \
	    nodes_open \
	    map_open \
	    pac_ctot \
	    pac_cnt \
	    node_ctot \
	    pac_chr_tot \
	    n_a


    # This is where it all starts, packet arrived, get and disect!
    gets $fileid packet

    # get time now, this is time when packet arrived
    set time_now [expr 3600*$hrs + 60*$mins + $secs]
    
    # totalize packet characters for graphing
    set pac_len [string length $packet]
    set pac_chr_tot [expr $pac_chr_tot + $pac_len]
    
    # if "term" window open, display new packet
    if {$console_open} { term_insert $packet }

    # find space char which delimits header
    set space_mark [string first " " $packet]

    # find > char which delimits header
    set gt_mark [string first ">" $packet]

    # extract node list from packet
    set node_list [string range $packet 0 [expr $space_mark - 1]]

    # test for legitimate packet and extract nodes \
	    1) Space char must exist after location 6 \
	    2) A > char must be located before the space \
	    3) The > char must appear after location 1 \
	    4) There cannot be any lower case chars in node list
    if { ($space_mark > 6) && \
	    ($gt_mark < $space_mark) && \
	    ($gt_mark > 1) && \
	    (![regexp {[a-z]} $node_list])} {

	incr pac_ctot
	.pac_ctot config -text [format "%d" $pac_ctot]

	# append ">" as delimiter to ease node address search
	append node_list ">"


	# Now take the node list and extract each node name up to max
	for {set i 0} {$i <= 7} {incr i} {
	    set n_mark [string first ">" $node_list]

	    if {$n_mark >= 0} {
		
		# extract node and put in array if "good name"
		set node_name [string range $node_list 0 [expr $n_mark - 1]]

		if {($node_name == "MAIL") || \
			($node_name == "CQ") || \
			($node_name == "ID") || \
			($node_name == "QST") || \
			($node_name == "NOS") || \
			($node_name == "BEACON") || \
			($node_name == "NODES")} {
		    set node_buf($i) ""
		    break

		} else {

		    # save node name in temp array and remove from node list
		    set node_buf($i) $node_name
		    set node_list  [string range $node_list \
			    [incr n_mark] end ]
		}
	 
	    } else {

		set node_buf($i) ""
	    }
	}


	# Extract the "heard" node, it is marked with * char \
		if no * found, leave node_buf array as it.
	set i 0
	while {($node_buf($i) != "") && ($i <= 7)} {

	    # search for * char
	    set ast_mark [string first "*" $node_buf($i)]

	    # if * char found, remove * and swap location with cell 0
	    if {$ast_mark != -1} {
		set temp [string trimright $node_buf($i) *]
		set node_buf($i) $node_buf(0)
		set node_buf(0) $temp
		break
	    }
	    incr i
	}


	# Remove the node list from the rest of the packet, \
		begin analysis char after 1st space is delimeter \
		for frame ID, extract ID based on this, ID is always \
		framed with [<()>]
	set pac_seg [string range $packet [expr $space_mark + 1] end]
	set fram_beg 0
	set fram_end 0
	set delim_chr [string index $pac_seg $fram_beg]
	switch $delim_chr {
	    "\[" {set fram_end [string first "\]" $pac_seg]}
	    "<"  {set fram_end [string first ">"  $pac_seg]}
	    "("  {set fram_end [string first ")"  $pac_seg]}
	}

	# extract "information" field from packet for display
	if {$fram_beg != $fram_end} {
	    set node_buf(8) \
		    [string range $pac_seg $fram_beg $fram_end]
	    set node_buf(9) [string range $pac_seg \
		    [incr fram_end] end]

	} else {

	    set node_buf(8) ""
	    set node_buf(9) ""
	}


	# store required info in node array for NODES window
	node_array

	# store required info in connection array for MAP window
	connect_array
	
	# update console node count (active and total counts)
	.node_cnt config -text [format "%d" $node_cnt]
	.node_ctot config -text [format "%d" $node_ctot]


	# update "active packet" counter, some packets may have \
		been removed due to the aging process.
	set pac_cnt 0
	for {set j 0} {$j < $node_cnt} {incr j} {
	    incr pac_cnt $node_arr("$n_a,$j,$node_pcnt") 
	}
	.pac_cnt config -text [format "%d" $pac_cnt]


	# update nodes window if open
	if {$nodes_open} {nodes_insert}

	# update map window if open
	if {$map_open} {map_insert}
    }
}







# NODE ARRAY
# Node list & other info in temporary "node buffer", \
	now store it. If node exists, update statistics \
	The array which is about to be created/updated \
	contains most of the information which is displayed \
	in the NODES window. This is a major array. It has a \
	companion array which is flip flopped with for \
	the aging process. See "tick" procedure.

proc node_array {} {

    global time_now \
	    node_lcmd \
	    node_msg \
	    node_heard \
	    node_pcnt \
	    node_fhrd \
	    node_lhrd \
	    node_cnt \
	    node_arr \
	    node_buf \
	    node_ctot \
	    n_a

	set i 0
	while {($node_buf($i) != "") && ($i <= 7)} {
	    set node_exists 0
	    set j 0
	    
	    while {$j < $node_cnt} {
		if {$node_arr("$n_a,$j,0") == $node_buf($i)} {

		    # existing node, xfer last heard to first heard time
		    set node_arr("$n_a,$j,$node_fhrd") \
			    $node_arr("$n_a,$j,$node_lhrd")

		    # timestamp "now"
		    set node_arr("$n_a,$j,$node_lhrd") $time_now

		    # increment packet counter for heard node only
		    if {$i == 0} {
			incr node_arr("$n_a,$j,$node_pcnt")

			set node_arr("$n_a,$j,$node_lcmd") $node_buf(8)

			set node_arr("$n_a,$j,$node_msg") $node_buf(9)

			set node_arr("$n_a,$j,$node_heard") "H"
		    }
		    set node_exists 1
		    break
		} 
		incr j
	    }


	    # New node, store it with initial statistics
	    if { !$node_exists } {
		set node_arr("$n_a,$node_cnt,0") $node_buf($i)

		# initialize packet count originating node to 1 else 0
		if {$i == 0} {
		    set node_arr("$n_a,$node_cnt,$node_pcnt") 1

		    set node_arr("$n_a,$node_cnt,$node_lcmd") $node_buf(8)

		    set node_arr("$n_a,$node_cnt,$node_msg") $node_buf(9)

		    set node_arr("$n_a,$j,$node_heard") "H"

		} else {

		    set node_arr("$n_a,$node_cnt,$node_pcnt") 0
		    set node_arr("$n_a,$node_cnt,$node_msg") ""
		    set node_arr("$n_a,$node_cnt,$node_lcmd") ""
		    set node_arr("$n_a,$j,$node_heard") "U"
		}

		set node_arr("$n_a,$node_cnt,$node_fhrd") $time_now

		set node_arr("$n_a,$node_cnt,$node_lhrd") $time_now

		incr node_cnt

		incr node_ctot
	    }
	    incr i
	}
    # end node array procedure
}






# This procedure updates the age of all packets in the "node_arr" \
	then copies all unexpired ( < time out period) to new array \
	expired nodes are dropped (i.e, > time out)
proc update_nodes {} {

    global secs mins hrs tens \
	    nodes_open \
	    node_cnt \
	    node_ctot \
	    node_arr \
	    node_lhrd \
	    node_hrd \
	    node_heard \
	    node_pcnt \
	    node_fhrd \
	    node_lhrd \
	    node_arrend \
	    hrd_to \
	    uhrd_to \
	    n_a

    # Update the last age of the packet, which is stored in \
	    global node array.
    set age_now [expr 3600*$hrs + 60*$mins + $secs]
    for {set j 0} {$j < $node_cnt} {incr j} {
	set node_arr("$n_a,$j,$node_lhrd") $age_now
    }

    # "k" is pointer to store node if not timed out, \
	    similar but not identical to "j"
    set k 0

    # Now with updated age, find and delete nodes that have \
	    expired their "heard time out" and "unheard time out"
    for {set j 0} {$j < $node_cnt} {incr j} {

	set age [expr $node_arr("$n_a,$j,$node_lhrd") \
		-  $node_arr("$n_a,$j,$node_fhrd")]

	# set flag for this node to "no save" (i.e., assume time out)
	set node_save 0

	# Check time out of "heard" station
	if {($node_arr("$n_a,$j,$node_heard") == "H") && \
		($age < $hrd_to)} {
	    set node_save 1
	}

	# Check time out of "unheard" station
	if {($node_arr("$n_a,$j,$node_heard") == "U") && \
		($age < $uhrd_to)} {
	    set node_save 1
	}


	# This is a little tricky, here we move between "2" arrays \
		if array "1" has current node list, then move nodes \
		to array "0" but do not move the "timed out" nodes" \
		do similar if array "0" is in use
	if {$node_save} {
	    for {set i 0} {$i <= $node_arrend} {incr i} {
		if {$n_a} {
		    set node_arr("0,$k,$i") $node_arr("1,$j,$i")
		} else {
		    set node_arr("1,$k,$i") $node_arr("0,$j,$i")
		}
	    }
	    # increment storing pointer
	    incr k
	}
    }

    # done move array to array, update # of nodes
    set node_cnt $k

    # flip flop between "two" arrays (i.e., n_a = 0 and n_a = 1)
    if {$n_a} {
	set n_a 0
    } else {
	set n_a 1
    }

    # update nodes windows (if open)
    if {$nodes_open} {
	clear_buttons
	nodes_insert
    }


    # update node counter, some nodes may have been removed due to time out
    .node_cnt config -text [format "%d" $node_cnt]


    # update "active packet" counter, some packets may have been removed
    set pac_cnt 0
    for {set j 0} {$j < $node_cnt} {incr j} {
	incr pac_cnt $node_arr("$n_a,$j,$node_pcnt") 
    }
    .pac_cnt config -text [format "%d" $pac_cnt]

    # end update nodes procedure
}







# CONN ARRAY
# Node list & other info in temporary "node buffer", \
	now store it. If node exists, update statistics \
	The array which is about to be created/updated \
	contains most of the information which is displayed \
	in the CONN window. This is a major array. It has a \
	companion array which is flip flopped with for \
	the aging process. See "tick" procedure.

proc connect_array {} {

    global time_now \
	    dest_cnt \
	    conn_cnt \
	    conn_arr \
	    node_buf


    # from the "node_buf", find destination node by definition, \
	    destination node is last node in node_buf array
    for {set i 0} {$i <=7} {incr i} {
	if {$node_buf($i) == ""} {
	    break
	}
    }
    set dest_node [expr $i  -1]

    # RETURN from this procedure is there is not a source and \
	    a destination node which is requirement for a connection
    if {$dest_node == 0} {return}


    # this is a legitimate connection, \
	    there is a source and destination node, now find them in \
	    the array, and if they do not exist add them

    # search array for "source node"
    set src_exists 0
    for {set j 0} {$j < $conn_cnt} {incr j} {
	if {$conn_arr("0,$j,0") == $node_buf(0)} {

	    # set flag, location & get out, we found source node
	    set src_exists 1
	    set src_ptr $j
	    break
	}
    }


    # search array for "destination node"
    set dest_exists 0
    for {set j 0} {$j < $conn_cnt} {incr j} {
	if {$conn_arr("0,$j,0") == $node_buf($dest_node)} {

	    # set flag, location & get out, we found dest. node in array
	    set dest_exists 1
	    set dest_ptr $j
	    break
	}
    }



    # if destination node is not in array, add it
    if {!$dest_exists} {
	# new "source" node, store it with initial values

	# add "source node" name to array
	set conn_arr("0,$conn_cnt,0") $node_buf($dest_node)

	# add "source count" to array
	set conn_arr("0,$conn_cnt,1") 0

	# add "destination count" to array
	set conn_arr("0,$conn_cnt,2") 1

	# remember where node exists
	set dest_ptr $conn_cnt

	# increment connection counter
	incr conn_cnt
    }


    # if source node is not in array, add it
    if {!$src_exists} {
	# new "source" node, store it with initial values

	# add "source node" name to array
	set conn_arr("0,$conn_cnt,0") $node_buf(0)

	# add "source count" to array
	set conn_arr("0,$conn_cnt,1") 1

	# add "destination count" to array
	set conn_arr("0,$conn_cnt,2") 0

	# add "destination name" to array
	set conn_arr("0,$conn_cnt,3") $dest_ptr

	# add "packet count" to array
	set conn_arr("0,$conn_cnt,4") 1

	# add "first heard" time to array
	set conn_arr("0,$conn_cnt,5") $time_now

	# add "last heard" time to array
	set conn_arr("0,$conn_cnt,6") $time_now

	# remember where node exists
	set src_ptr $conn_cnt

	# increment connection counter
	incr conn_cnt

	# increment # of sources for this destination \
		however only if the node exists.
	if {$dest_exists} {
	    incr conn_arr("0,$dest_ptr,2")
	}
    }




    # existing "source" node, is this destination new? \
	    if existing destination update packet count
    if {$src_exists} {

	set dconn_exists 0
	set dconn_ptr 3

	for {set i 0} {$i < $conn_arr("0,$src_ptr,1")} {incr i} {

	    if {$conn_arr("0,$src_ptr,$dconn_ptr") == $dest_ptr} {
		# set flag and get out, destination node exists in array
		set dconn_exists 1
		break

	    } else {

		# skip to next group (4 elements)
		incr dconn_ptr 4
	    }
	}


	if {$dconn_exists} {

	    # both source and destination node exist update values

	    # increment # of packets to this destination
	    incr conn_arr("0,$src_ptr,[expr $dconn_ptr+1]")

	    #update time for this existing dconnination node
	    set conn_arr("0,$src_ptr,[expr $dconn_ptr+2]") \
		    $conn_arr("0,$src_ptr,[expr $dconn_ptr+3]")

	    set conn_arr("0,$src_ptr,[expr $dconn_ptr+3]") $time_now

	} else {

	    # destination doesn't exist, it is new, add to list

	    # add "destination name" to array
	    set conn_arr("0,$src_ptr,$dconn_ptr") $dest_ptr

	    # add "packet count" to array
	    set conn_arr("0,$src_ptr,[expr $dconn_ptr+1]") 1

	    # add "first heard" time to array
	    set conn_arr("0,$src_ptr,[expr $dconn_ptr+2]") $time_now

	    # add "last heard" time to array
	    set conn_arr("0,$src_ptr,[expr $dconn_ptr+3]") $time_now

	    # increment # of sources for this destination
	    incr conn_arr("0,$src_ptr,1")

	    # increment # of sources for this destination \
		    however only if the node exists.
	    if {$dest_exists} {
		incr conn_arr("0,$dest_ptr,2")
	    }
	}
    }


    # update "active packet" counter, some packets may have been removed
    .conn_cnt config -text [format "%d" $conn_cnt]

    # End connect array procedure
}








# This procedure updates the age of all packets in the "conn_arr" \
	then copies all unexpired ( < time out period) to new array \
	expired nodes are dropped (i.e., > con_to
proc update_conn {} {

    global secs mins hrs tens \
	    conn_arr \
	    conn_cnt \
	    map_open \
	    node_cnt \
	    node_ctot \
	    node_lhrd \
	    node_hrd \
	    node_heard \
	    node_pcnt \
	    node_fhrd \
	    node_lhrd \
	    node_arrend \
	    con_to


    # Update the last age of the packet, which is stored in \
	    global conn array. Knowledge of array is crucial

    set time_now [expr 3600*$hrs + 60*$mins + $secs]

    for {set i 0} {$i < $conn_cnt} {incr i} {

	# update time of destination nodes this source is connected to
	set dest_lhrd 6
	for {set j 0} {$j < $conn_arr("0,$i,1")} {incr j} {

	    set conn_arr("0,$i,$dest_lhrd") $time_now

	    # point to next destination last heard time array element
	    incr dest_lhrd 4
	}
    }




    # Knowledge of array imperative! Move source name from array 0 \
	    to array one with non-timed out destination nodes
    for {set i 0} {$i < $conn_cnt} {incr i} {

	# move source name, zero destinations, move num. of src nodes
	set conn_arr("1,$i,0") $conn_arr("0,$i,0")
	set conn_arr("1,$i,1") 0
	set conn_arr("1,$i,2") $conn_arr("0,$i,2")

	# initialize array swapping pointers to first destination node
	set dest_name0 3
	set dest_pacs0 4
	set dest_fhrd0 5
	set dest_lhrd0 6

	set dest_name1 3
	set dest_pacs1 4
	set dest_fhrd1 5
	set dest_lhrd1 6

	# move destination to new array only if not time out
	for {set j 0} {$j < $conn_arr("0,$i,1")} {incr j} {

	    set age [expr $conn_arr("0,$i,$dest_lhrd0") - \
		    $conn_arr("0,$i,$dest_fhrd0")]

	    # if not timed out, save 4 elements of destination
	    if {$age < $con_to} {
		set conn_arr("1,$i,$dest_name1") \
			$conn_arr("0,$i,$dest_name0")

		set conn_arr("1,$i,$dest_pacs1") \
			$conn_arr("0,$i,$dest_pacs0")

		set conn_arr("1,$i,$dest_fhrd1") \
			$conn_arr("0,$i,$dest_fhrd0")

		set conn_arr("1,$i,$dest_lhrd1") \
			$conn_arr("0,$i,$dest_lhrd0")

		# incr source's destination counter in the new array
		incr conn_arr("1,$i,1")

		incr dest_name0 4
		incr dest_pacs0 4
		incr dest_fhrd0 4
		incr dest_lhrd0 4

		incr dest_name1 4
		incr dest_pacs1 4
		incr dest_fhrd1 4
		incr dest_lhrd1 4

	    } else {

		# this node is being dropped from the list, the count must \
			be decremented in its source location. Careful \
			attention must be given to which array, \
			since the node may already be in new array
		set ptr $conn_arr("0,$i,$dest_name0")
		
		if {$ptr > $i} {
		    # update in old array
		    incr conn_arr("0,$ptr,2") -1
		} else {
		    # update in new array
		    incr conn_arr("1,$ptr,2") -1
		}
		incr dest_name0 4
		incr dest_pacs0 4
		incr dest_fhrd0 4
		incr dest_lhrd0 4
	    }
	}
    }



    # Before moving and removing nodes with no src. or dest. \
	    all destination index must be updated.

    for {set i 0} {$i < $conn_cnt} {incr i} {
	set dest_name 3

	for {set j 0} {$j < $conn_arr("1,$i,1")} {incr j} {
	    set del_cnt 0
	    set name_now $conn_arr("1,$i,$dest_name")

	    for {set m 0} {$m < $name_now} {incr m} {
		if {($conn_arr("1,$m,1") == 0) && \
			($conn_arr("1,$m,2") == 0)} {
		    incr del_cnt
		}
	    }

	    # subtract no. of nodes to be deleted
	    incr conn_arr("1,$i,$dest_name") -$del_cnt
	    incr dest_name 4
	}
    }



    # We have removed ALL expired destinations nodes, \
	    if source has zero destinations AND zero connections \
	    remove entire node from list
    set k 0
    for {set i 0} {$i < $conn_cnt} {incr i} {

	if {($conn_arr("1,$i,1") != 0) || ($conn_arr("1,$i,2") != 0)} {
	    # move source name, zero destinations, move num. of src nodes
	    set conn_arr("0,$k,0") $conn_arr("1,$i,0")
	    set conn_arr("0,$k,1") $conn_arr("1,$i,1")
	    set conn_arr("0,$k,2") $conn_arr("1,$i,2")
	    set dest_name 3
	    set dest_pacs 4
	    set dest_fhrd 5
	    set dest_lhrd 6

	    # move destinations to new array
	    for {set j 0} {$j < $conn_arr("1,$i,1")} {incr j} {

		set conn_arr("0,$k,$dest_name") $conn_arr("1,$i,$dest_name")
		set conn_arr("0,$k,$dest_pacs") $conn_arr("1,$i,$dest_pacs")
		set conn_arr("0,$k,$dest_fhrd") $conn_arr("1,$i,$dest_fhrd")
		set conn_arr("0,$k,$dest_lhrd") $conn_arr("1,$i,$dest_lhrd")

		# skip to next destination group
		incr dest_name 4
		incr dest_pacs 4
		incr dest_fhrd 4
		incr dest_lhrd 4
	    }
	    # incrment connection node counter
	    incr k
	}
    }


    # done moving array to array, update # of connections, some nodes\
	    may have expired and therefore not in new array
    set conn_cnt $k

    # update main console
    .conn_cnt config -text [format "%d" $conn_cnt]

    # update map windows (if open)
    if {$map_open} {
	map_insert
    }

    # end update connection array procedure
}






#
# Stop, close open file
#
proc close_input {} {

    global pid_num inputFile input_port
    global xNet_stopped
    
    # stop only if already started \
	    & kill process only if in simulation mode
    if {$input_port != 0} {
	exec kill $pid_num
    }

    removeinput $inputFile
    catch {close $inputFile}
}
