#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# Get the fifo through the debian /etc/diald/diald.options
# Modified from the original for Debian by Philippe Troin <phil@fifi.org>,
# with additonal modifications by Jeff Licquia <licquia@debian.org>
set debian_diald_conf "/etc/diald/diald.defaults"
if [file exists "/etc/diald/diald.options"] {
    if [file exists "/etc/diald/diald.provider"] {
	if [catch { exec grep old-config /etc/diald/diald.provider | wc -l }] {
	    set debian_diald_conf "/etc/diald/diald.options"
	}
    }
}
if [catch { exec egrep {^[^\#]*fifo} $debian_diald_conf | sed -e {s/^ *fifo *//} } grep_results] {
    set diald_FIFO ""
} else {
    set diald_FIFO $grep_results
}

set user_config_file "$env(HOME)/.dctrl"

if [ file isfile $user_config_file ] {
    source $user_config_file
}

# User tunable parameters
set imagepath "/usr/share/diald"
set diald_TITLE ""
set diald_HOST ""
set diald_PORT 0

# Default globals
set monfifo ""
set monfd ""
set fifofd ""
set fifo_counter 0

# Initial values
set monloglevel 6
set monlevel 0x0000017f
set monstate 0.0
set queue_list [list]
set max_info_lines 500
set out_usage bps
set in_usage bps
set out_bandwidth [expr 33600 / 8]
set in_bandwidth [expr 33600 / 8]

# These should be proc static but Tcl has no such concept.
set txtotal 0
set status(rx_total) 0.0
set status(tx_total) 0.0
set status(rx_load) 0.0
set status(tx_load) 0.0
set status(rx_load5) 0.0
set status(tx_load5) 0.0
set status(rx_load150) 0.0
set status(tx_load150) 0.0


# Tool tip handling
proc toolTipSet {w txt} {
	global toolTip
	set toolTip($w) $txt
	bind $w <Enter> "_toolTipStart $w"
	bind $w <Leave> "_toolTipStop $w"
}

proc _toolTipStart {w} {
	global _toolTipTimer
	destroy .toolTipWin
	set _toolTipTimer [after 750 "_toolTipShow $w"]
}

proc _toolTipStop {w} {
	global _toolTipTimer
	after cancel $_toolTipTimer
	destroy .toolTipWin
}

proc _toolTipShow {w} {
	global toolTip
	toplevel .toolTipWin -cursor {top_left_arrow}
	wm withdraw .toolTipWin
	wm overrideredirect .toolTipWin 1
	label .toolTipWin.l -text $toolTip($w) \
		-bg lemonchiffon -fg black -bd 1 -relief solid \
		-justify {left} -padx 4 -wraplength 2i
	pack .toolTipWin.l
	set x [expr "[winfo rootx $w] + [winfo width $w] / 2"]
	set y [expr "[winfo rooty $w] + [winfo height $w] + 5"]
	wm geometry .toolTipWin +$x+$y
	wm deiconify .toolTipWin
}


# strip chart code
proc stripchart {win x y label} {
    upvar #0 var$win type
    set type(scale) 1
    set type(entry) 1
    set type(height) $y
    set type(label) $label

    frame $win -bor 0
    canvas $win.canv -width $x -height $y -bor 0 -highlightthickness 0
    pack $win.canv -expand 1 -fill both -pady 0
}

# add a new line to the strip chart, moving it left if needed
proc addtick {w val} {
    set win $w.canv
    upvar #0 var$w type
    set e $type(entry)
    set s $type(scale)
    set o $type(height)
    set h [winfo height $win]
    set w [expr "[winfo width $win]"]

    $win delete ticks

    if {$val > $s} {
    	# adjust the window for a larger value than currently displayed.
	# get the new scale
	set ns [expr "int($val)"]
	if {$val > $ns} { incr ns }
	if { $ns > 0 } {
	    set r [expr "($s+0.0)/$ns"]
	    $win scale all 0 $o 1 $r
	    set s $ns
	}
    } else {
    	# Also trim the window down for a smaller value if needed.
	# figure out how many ticks are currently spanned by the image
	set t [expr "$h-([lindex [$win bbox all] 1]+1)"]
	set fs [expr "($t*$s*1.0)/$h"]
	set ns [expr "int($fs)"]
	if {$fs > $ns} {incr ns}
	if {$ns > 0 && $ns != $s} {
		set r [expr "($s+0.0)/$ns"]
		$win scale all 0 $o 1 $r
		set s $ns
	}
    }

    set v [expr "($val*$h)/$s"]

    # rescale vertically if needed
    if {$o > 0 && "$o"!="$h"} {
	set sc [expr "($h+0.0)/$o"]
	$win scale all 0 0 1 $sc
	set type(height) $h
    }

    # Create a new line
    $win create line $e $h $e [expr "$h-$v+1"]

    # Check if we can shrink or expand the tick count

    # scroll left if needed
    if {"$e">="$w"} {
	set diff [expr "$w-($e+1)"]
    	$win move all $diff 0
	set e $w
    } else {
	incr e
    }

    # kill window elements outside of the visible window and draw tick marks
    $win addtag extra all
    $win addtag ok enclosed 0 0 [expr "$w+1"] [expr "$h+1"]
    $win dtag ok extra
    $win delete extra
    $win dtag all ok
    set x 1
    while {$x < $s} {
	set th [expr "($x*$h)/$s"]
	$win create line 1 $th $w $th -tag ticks -fill red
	incr x
    }
    $win create text 2 2 -anchor nw -fill blue -tags ticks -text $type(label)

    $win addtag deltag closest 0 [winfo height $win]
    set type(scale) $s
    set type(entry) $e
}

# If this is 1 the icon will be an active window.
# If this is 2 then there will be a seperate top level window,
#	named dctrlIcon that can be swallowed by FVWM Goodstuff,
#	or the Bowman/Afterstep Wharf.
# If this is 0 then there will be neither.

set fancy_icon 0

set trans(DOWN) Down
set trans(CONNECT) Connect
set trans(CLOSE) Close
set trans(START_LINK) Start
set trans(UP) Up
set trans(HALF_DEAD) HalfDead
set trans(STOP_LINK) StopLink
set trans(KILL_LINK) KillLink
set trans(STOP_DIAL) StopDial
set trans(KILL_DIAL) KillDial
set trans(DISCONNECT) Disconnect
set trans(RETRY) Retry
set trans(ERROR) Error
set trans(ZOMBIE) Zombie

set colors(DOWN)	{{} {} red}
set colors(CONNECT)	{{} yellow red}
set colors(START_LINK)	{{} yellow {}}
set colors(STOP_DIAL)	{{} red red}
set colors(KILL_DIAL)	{{} black red}
set colors(UP) 		{green {} {}}
set colors(HALF_DEAD) 	{yellow {} {}}
set colors(DISCONNECT)	{green yellow {}}
set colors(STOP_LINK)	{green red {}}
set colors(KILL_LINK)	{green black {}}
set colors(CLOSE)	{{} yellow yellow}
set colors(RETRY)	{yellow yellow yellow}
set colors(ERROR)	{red red red}
set colors(ZOMBIE)	{black black black}

# Set up the basic data for the app

wm title . "Diald: No link"
wm iconname . "Diald"
wm minsize . 1 1
wm protocol . WM_DELETE_WINDOW dctrlQuit

proc print_usage {} {
	puts {Usage dctrl [-title <title>] [-fifo <name>] [-host <host> -port <port>] [-i|-animated-icon] [-cw|-control-window] [-iconic] [-toolbar] [-dstatus] [-tload] [-gload] [-pqueue] [-dlog]}
	exit
}

# Deal with command line options
set previous ""
foreach i $argv {
	if {"$previous"=="-title"} {
		set diald_TITLE $i
		wm title . $i
    		wm iconname . $i
		set previous ""
	} elseif {"$previous"=="-fifo"} {
		set diald_FIFO $i
		set previous ""
	} elseif {"$previous"=="-host"} {
		set diald_HOST $i
		set previous ""
	} elseif {"$previous"=="-port"} {
		set diald_PORT $i
		set previous ""
	} elseif {"$i"=="-i"} { set fancy_icon 1 } \
	elseif {"$i"=="-title"} { set previous $i } \
	elseif {"$i"=="-animated-icon"} { set fancy_icon 1 } \
	elseif {"$i"=="-cw"} { set fancy_icon 2 } \
	elseif {"$i"=="-control-window"} { set fancy_icon 2 } \
	elseif {"$i"=="-fifo"} { set previous $i } \
	elseif {"$i"=="-host"} { set previous $i } \
	elseif {"$i"=="-port"} { set previous $i } \
	elseif {"$i"=="-iconic"} {wm iconify .} \
        elseif {"$i"=="-toolbar"} { set toolbar 1 } \
        elseif {"$i"=="-dstatus"} { set dstatus 1 } \
	elseif {"$i"=="-tload"} { set tload 1 } \
	elseif {"$i"=="-gload"} { set gload 1 } \
	elseif {"$i"=="-pqueue"} { set pqueue 1 } \
	elseif {"$i"=="-dlog"} { set dlog 1 } \
	else { print_usage }
}
if {"$previous"!=""} { print_usage }

proc make_icon {} {
	toplevel .dctrlIcon -class DctrlIcon -width 50 -height 50
	canvas .dctrlIcon.canv -width 50 -height 32
	.dctrlIcon.canv create text 2 2 \
		-font -adobe-times-medium-r-*-*-12-*-*-*-*-*-*-* \
        	-text "Diald" -anchor nw
	.dctrlIcon.canv create text 2 15 \
		-font -adobe-times-medium-r-*-*-12-*-*-*-*-*-*-* \
        	-text "Status" -anchor nw
	.dctrlIcon.canv create rectangle 35 2 45 32 -fill grey75
	.dctrlIcon.canv create oval 37 4 43 10 -tag top
	.dctrlIcon.canv create oval 37 14 43 20 -tag mid
	.dctrlIcon.canv create oval 37 24 43 30 -tag bot
	label .dctrlIcon.message -textvar status(fsm_trans) -border 0 -width 50 \
		-font -adobe-times-bold-r-*-*-12-*-*-*-*-*-*-*
	pack propagate .dctrlIcon 0
	pack .dctrlIcon.canv -padx 0 -pady 0 -fill x -expand 1
	pack .dctrlIcon.message -padx 0 -pady 0 -fill x -expand 1
	bind .dctrlIcon <Destroy> {
		if {$fancy_icon=="1"} {
			if {"%W"==".dctrlIcon"} {after idle make_icon}
		} else {
			dctrlQuit
		}
	}

	bind .dctrlIcon <Button-1> {wm deiconify .}
}

if {"$fancy_icon" != 0} { make_icon }
if {"$fancy_icon"==1} { wm iconwindow . .dctrlIcon }

#
# MONITOR_STATE           0x0001
# MONITOR_INTERFACE       0x0002
# MONITOR_STATUS          0x0004
# MONITOR_LOAD            0x0008
# MONITOR_MESSAGE         0x0010
# MONITOR_QUEUE           0x0020
#

proc closeMonitor {} {
    global fifofd monfifo monfd diald_HOST diald_TITLE
    if { $monfd != "" } {
	catch { close $monfd }
	set monfd ""
    }
    if { $diald_HOST == "" } {
        if { $monfifo != "" } {
	    catch { exec rm -f $monfifo }
	}
	set monfifo ""
    }
    if { $fifofd != "" } {
	catch { close $fifofd }
	set fifofd ""
    }

    .toolbar.up configure -state disabled
    .toolbar.down configure -state disabled

    if { $diald_TITLE == "" } {
	wm title . "Diald: No link"
	wm iconname . "Diald"
    }
}

proc setMonitor {} {
    global monloglevel monlevel monfifo
    fifoCmd [format "monitor 0x%x $monfifo" \
	[expr $monlevel + ($monloglevel << 24)]]
}

proc openMonitor {} {
    global monstate monlevel
    global fifofd monfifo monfd fifo_counter
    global diald_FIFO diald_HOST diald_PORT diald_TITLE

    # Turn off any previous monitoring
    closeMonitor

    # get new monitoring fifo
    set monstate 0.0
    if { $diald_HOST != "" } {
	# FIXME: should do a catch here?
	set title "$diald_HOST:$diald_PORT"
        set fifofd [socket $diald_HOST $diald_PORT]
        set monfd $fifofd
        set monfifo "TCP [fconfigure $fifofd -sockname]"
    } elseif { $diald_FIFO != "" } {
	set title "$diald_FIFO"
#        set fifofd [open $diald_FIFO w]
        if [catch "open $diald_FIFO w" rval] {
        tk_dialog .errormsg "Error while opening FIFO" \
            "While opening FIFO \"$diald_FIFO\", the following \
error occurred:\n\n  \"$rval\"\n\nIf it's a permission problem, you \
can get access to the FIFO\nby adding yourself to the dialout group.\n" \
            error \
            0 \
            "Ok"
        exit 1
        }
        set fifofd $rval

        #
        set fifo_counter [expr "$fifo_counter+1"]
        set monfifo /tmp/dctrl.[pid]-$fifo_counter
        # If an event comes along that causes a signal, then
        # it is possible the exec above gets exited BEFORE
        # it finishes waiting. Nasty stuff.
        # so, we do a little loop until we can confirm the fifo exists
        # before we ask diald to deal with it.
        catch {exec mkfifo -m 0600 $monfifo}
        set monfd [open $monfifo r+]

	# Apparently some systems need this to avoid a hang???
	after 500
    }

    setMonitor

    if { $diald_TITLE == "" } {
	wm title . "Diald: $title"
	wm iconname . "$title"
    }
    fconfigure $monfd -blocking 0
    fileevent $monfd readable {readMonitor}
    .toolbar.up configure -state active
    .toolbar.down configure -state active
}

proc openLocal {} {
    set my_path ""
    catch { destroy .openConn }
    toplevel .openConn
    wm group .openConn .
    wm transient .openConn .
    wm geometry .openConn \
	+[expr [winfo pointerx .]-100]+[expr [winfo pointery .]-50]
    wm resizable .openConn 0 0
    wm title .openConn "Open Connection"

    frame .openConn.input
    pack .openConn.input -side top -fill x -pady 2m
    label .openConn.input.l -text "FIFO name:"
    entry .openConn.input.e -width 40 -relief sunken -bd 2 -textvariable my_path
    bind .openConn.input.e <Return> {
	set diald_HOST ""
	set diald_FIFO $my_path
	destroy .openConn
	openMonitor
    }
    bind .openConn.input.e <Escape> \
	"destroy .openConn"
    focus .openConn.input.e
    pack .openConn.input.l .openConn.input.e -side left -padx 1m -pady 2m

    frame .openConn.buttons
    pack .openConn.buttons -side bottom -fill x -pady 2m
    button .openConn.buttons.ok \
	-default active \
	-text "  Ok  " \
	-command {
	    set diald_HOST ""
	    set diald_FIFO $my_path
	    destroy .openConn
	    openMonitor
	}
    button .openConn.buttons.dismiss \
	-text "Cancel" \
	-command {
	    destroy .openConn
	}
    pack .openConn.buttons.ok .openConn.buttons.dismiss -side left -expand 1
}

proc openRemote {} {
    set my_host ""
    set my_port ""
    catch { destroy .openConn }
    toplevel .openConn
    wm group .openConn .
    wm transient .openConn .
    wm geometry .openConn \
	+[expr [winfo pointerx .]-100]+[expr [winfo pointery .]-50]
    wm resizable .openConn 0 0
    wm title .openConn "Open Connection"

    frame .openConn.input
    pack .openConn.input -side top -fill x -pady 2m
    label .openConn.input.l1 -text "Host:"
    entry .openConn.input.e1 -width 30 -relief sunken -bd 2 -textvariable my_host
    label .openConn.input.l2 -text "Port:"
    entry .openConn.input.e2 -width 10 -relief sunken -bd 2 -textvariable my_port
    bind .openConn.input.e1 <Return> {
	if { $my_port == "" } {
	    focus .openConn.input.e2
	} else {
	    set diald_FIFO ""
	    set diald_HOST $my_host
	    set diald_PORT $my_port
	    destroy .openConn
	    openMonitor
	}
    }
    bind .openConn.input.e1 <Escape> {
	destroy .openConn
    }
    bind .openConn.input.e2 <Return> {
	if { $my_host == "" } {
	    focus .openConn.input.e1
	} else {
	    set diald_FIFO ""
	    set diald_HOST $my_host
	    set diald_PORT $my_port
	    destroy .openConn
	    openMonitor
	}
    }
    bind .openConn.input.e2 <Escape> {
	destroy .openConn
    }
    focus .openConn.input.e1
    pack .openConn.input.l1 .openConn.input.e1 \
	.openConn.input.l2 .openConn.input.e2 \
	-side left -padx 1m -pady 2m

    frame .openConn.buttons
    pack .openConn.buttons -side bottom -fill x -pady 2m
    button .openConn.buttons.ok \
	-default active \
	-text "  Ok  " \
	-command {
	    set diald_FIFO ""
	    set diald_HOST $my_host
	    set diald_PORT $my_port
	    destroy .openConn
	    openMonitor
	}
    button .openConn.buttons.dismiss \
	-text "Cancel" \
	-command {
	    destroy .openConn
	}
    pack .openConn.buttons.ok .openConn.buttons.dismiss -side left -expand 1
}

proc fifoCmd {cmd} {
    global fifofd
    if {$fifofd!=""} {
	puts $fifofd $cmd
	catch {flush $fifofd}
    }
    # FIXME: if we are not connected we should say so
}

proc cmp {a b} {
    if {[lindex $a 3]<[lindex $b 3]} {
	return 1;
    }
    if {[lindex $a 3]>[lindex $b 3]} {
	return -1;
    }
    return 0;
}

proc updateIcon {} {
    global colors status trans fancy_icon

    set status(fsm_trans) [set trans($status(fsm))]
    set clist [set colors($status(fsm))]
    set tcol [lindex $clist 0]
    set mcol [lindex $clist 1]
    set bcol [lindex $clist 2]
    if {"$fancy_icon" != 0} {
	.dctrlIcon.canv itemconfig top -fill $tcol
	.dctrlIcon.canv itemconfig mid -fill $mcol
	.dctrlIcon.canv itemconfig bot -fill $bcol
    }
}



proc user_number { n } {
    if { $n > 1073741824 } {
	format " %4.0fG" [expr $n/1073741824]
    } elseif { $n > 1048576 } {
	format " %4.0fM" [expr $n/1048576]
    } elseif { $n > 1024 } {
	format " %4.0fk" [expr $n/1024]
    } else {
	format " %4.0f " $n
    }
}

proc readMonitor {} {
    global monstate monfd status
    global queue_list status trans colors gload tload
    global in_usage out_usage in_bandwidth out_bandwidth
    global demand blocked forced max_info_lines
    global diald_TITLE

    while {[gets $monfd foo] != -1} {

    switch " $foo" {
	{ STATE}	{ set monstate 1.0; continue }
	{ STATUS}	{ set monstate 2.0; continue }
	{ QUEUE}	{ set monstate 4.0
			set queue_list [list]
			continue
			}
	{ MESSAGE}	{ set monstate 5.0; continue }
	{ INTERFACE}	{ set monstate 6.0; continue }
	{ LOAD}		{ set monstate 7.0; continue }
	{ END QUEUE}	{ set monstate 0.0
#			We insert then delete to avoid the creeping
#			scrollbar problem but then, to avoid lines
#			dropping off the end, we have to pad with
#			and extra line before inserting.
			set i 1
			foreach foo $queue_list {
			    .queue.vis.text insert end "\n"
			    .queue.vis.text insert $i.0 $foo
			    incr i
			    .queue.vis.text delete $i.0 $i.0+1l
			}
			.queue.vis.text delete $i.0 end
			set queue_list [list]
			continue
			}
	{ TITLE}	{ set monstate 8.0; continue; }
    }

    if {$monstate < 1.0} {
#	Monitor idle
    } elseif {$monstate < 2.0} {
	set status(fsm) $foo
        if {$foo == "UP"} { load_init }
	updateIcon
	set monstate 0.0
    } elseif {$monstate < 3.0} {
	scan $foo "%d %d %d %d %d %d %s %s %s %d %d %d" \
	    status(up) status(force) status(impmode) \
	    status(imp_itime) status(imp_time) status(imp_fuzz) \
	    status(imp_timeout) status(force_timeout) \
	    status(timeout) demand blocked forced
	set monstate 0.0
    } elseif {$monstate < 4.0} {
# This was STATUS2 but it is no longer used.
#	switch $monstate {
#	    3.0	{ set demand $foo; set monstate 3.1 }
#	    3.1	{ set blocked $foo; set monstate 3.2 }
#	    3.2	{ set forced $foo; set monstate 0.0 }
#	}
    } elseif {$monstate < 5.0} {
	set outp 0
	set outb 0
	set outtot 0
	set inp 0
	set inb 0
	set intot 0
	set desc [string range $foo 0 59]
	scan [string range $foo 61 end] \
	    "%f %f %f %f %f %f" \
	    outp outb outtot inp inb intot
	set foo ""
	lappend queue_list [append foo $desc \
	    [switch $in_usage {
		pps { user_number $inp }
		bps { user_number $inb }
		lbp { format " %4.0f%%" [expr $inb*100/$in_bandwidth] }
		tot { user_number $intot }
	    }] \
	    [switch $out_usage {
		pps { user_number $outp }
		bps { user_number $outb }
		lbp { format " %4.0f%%" [expr $outb*100/$out_bandwidth] }
		tot { user_number $outtot }
	    }] \
	"\n" ]
    } elseif {$monstate < 6.0} {
	set monstate 0.0
	if {[.message.vis.text index end] >= $max_info_lines} {
	    .message.vis.text delete 1.0 2.0
	}
	set do_tail 0
	if {[.message.vis.text index "end-1c"] > 1.0} {
	    if {[lindex [.message.vis.yscroll get] 1] == 1} {
		set do_tail 1
	    }
	    .message.vis.text insert end "\n"
	}
	.message.vis.text insert end $foo
	if {$do_tail == 1} {
	    .message.vis.text see end
	}
    } elseif {$monstate < 7.0} {
	switch $monstate {
	    6.0	{ set status(iface) $foo; set monstate 6.1 }
	    6.1	{ set status(lip) $foo; set monstate 6.2 }
	    6.2	{ set status(rip) $foo; set monstate 0.0 }
	}
    } elseif {$monstate < 8.0} {
	if {$status(fsm)=="UP"} {
	    global txtotal
	    switch $monstate {
		7.0	{ set txtotal $foo; set monstate 7.1 }
		7.1	{
			set rxtotal $foo
			set monstate 0.0
			set e5 ".81873075307798185867"
			set e150 ".99335550625503441537"
			set fp "1"
			set status(rx_load5) \
			    [expr {$status(rx_load5)*$e5+$rxtotal*($fp-$e5)}]
			set status(tx_load5) \
			    [expr {$status(tx_load5)*$e5+$txtotal*($fp-$e5)}]
			set status(rx_load150) \
			    [expr {$status(rx_load150)*$e150+$rxtotal*($fp-$e150)}]
			set status(tx_load150) \
			    [expr {$status(tx_load150)*$e150+$txtotal*($fp-$e150)}]
			set status(rx_load) \
			    [format "%.3f %.3f" \
				[expr {$status(rx_load5)/1000}] \
				[expr {$status(rx_load150)/1000}]]
			set status(tx_load) \
			    [format "%.3f %.3f" \
				[expr {$status(tx_load5)/1000}] \
				[expr {$status(tx_load150)/1000}]]
#			update
			addtick .lm.tx [expr {$status(tx_load5)/1000}]
			addtick .lm.rx [expr {$status(rx_load5)/1000}]
			set status(tx_total) [expr {$status(tx_total)+$txtotal}]
			set status(rx_total) [expr {$status(rx_total)+$rxtotal}]
		}
	    }
	}
    } elseif {$monstate < 9.0} {
	set monstate 0.0
	if { $diald_TITLE == "" } {
	    wm title . "Diald: $foo"
	    wm iconname . "$foo"
	}
    }
    }
    if {[eof $monfd]} { closeMonitor; return 0 }
}

proc dctrlQuit {} {
    global fancy_icon

    closeMonitor

    if {"$fancy_icon" != 0} {
        bind .dctrlIcon <Destroy> {}
    }
    exit
#    destroy .
}

proc ctrlAccess {} {
    global my_name

    set my_name ""
    catch { destroy .ctrlAccess }
    toplevel .ctrlAccess
    wm group .ctrlAccess .
    wm transient .ctrlAccess .
    wm geometry .ctrlAccess \
	+[expr [winfo pointerx .]-100]+[expr [winfo pointery .]-50]
    wm resizable .ctrlAccess 0 0
    wm title .ctrlAccess "Access Name"

    frame .ctrlAccess.input
    pack .ctrlAccess.input -side top -fill x -pady 2m
    label .ctrlAccess.input.l -text "Name:"
    entry .ctrlAccess.input.e -show '*' -width 40 \
	-relief sunken -bd 2 -textvariable my_name
    bind .ctrlAccess.input.e <Return> {
	fifoCmd "auth simple $my_name"
	set my_name ""
	destroy .ctrlAccess
    }
    bind .ctrlAccess.input.e <Escape> \
	"destroy .ctrlAccess"
    focus .ctrlAccess.input.e
    pack .ctrlAccess.input.l .ctrlAccess.input.e -side left -padx 1m -pady 2m

    frame .ctrlAccess.buttons
    pack .ctrlAccess.buttons -side bottom -fill x -pady 2m
    button .ctrlAccess.buttons.ok \
	-default active \
	-text "  Ok  " \
	-command {
	    fifoCmd "auth simple $my_name"
	    set my_name ""
	    destroy .ctrlAccess
	}
    button .ctrlAccess.buttons.dismiss \
	-text "Cancel" \
	-command {
	    set my_name ""
	    destroy .ctrlAccess
	}
    pack .ctrlAccess.buttons.ok .ctrlAccess.buttons.dismiss -side left -expand 1
}

# Create menu bar.


frame .menu -relief raised -bd 2
pack .menu -side top -fill x -expand 0

frame .spacer -width 560 -height 0
pack .spacer -side top

menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
menu .menu.file.m
.menu.file.m add command -label "Reconnect" \
	-command openMonitor -underline 0
.menu.file.m add cascade -label "Connect" \
	-menu .menu.file.m.open
.menu.file.m add command -label "Disconnect" \
	-command closeMonitor -underline 0
.menu.file.m add command -label "Quit" -command dctrlQuit -underline 0
pack .menu.file -side left

menu .menu.file.m.open
.menu.file.m.open add command -label "Local  (FIFO)" \
	-command openLocal -underline 0
.menu.file.m.open add command -label "Remote (TCP)" \
	-command openRemote -underline 0

menubutton .menu.control -text "Control" -menu .menu.control.m -underline 0
menu .menu.control.m
.menu.control.m add command -label "Access Name" \
    -command ctrlAccess -underline 0
.menu.control.m add sep
.menu.control.m add check -label "Demand Dialling" -underline 0 \
    -variable demand -command {
   	 if {$demand} {fifoCmd "demand"} {fifoCmd "nodemand"}
    }
.menu.control.m add check -label "Block connection" -underline 0 \
    -variable blocked -command {
   	 if {$blocked} {fifoCmd "block"} {fifoCmd "unblock"}
    }
.menu.control.m add check -label "Forced up" -underline 0 \
    -variable forced -command {
   	 if {$forced} {fifoCmd "force"} {fifoCmd "unforce"}
    }
.menu.control.m add sep
.menu.control.m add command -label "Up request" -underline 0 \
	-command "fifoCmd up"
.menu.control.m add command -label "Down request" -underline 0 \
	-command "fifoCmd down"
.menu.control.m add command -label "Terminate on idle" -underline 0 \
	-command "fifoCmd delayed-quit"
.menu.control.m add command -label "Quit diald" -underline 0 \
	-command "fifoCmd quit"
pack .menu.control -side left

menubutton .menu.options -text "Options" -menu .menu.options.m -underline 0
menu .menu.options.m
.menu.options.m add check -label "Tool Bar" -underline 0 \
	-variable toolbar -command { repack }
.menu.options.m add check -label "Detailed Status" -underline 0 \
	-variable dstatus -command { repack }
.menu.options.m add check -label "Numeric Load Monitor" -underline 0 \
	-variable tload -command { repack }
.menu.options.m add check -label "Graphical Load Monitor" -underline 0 \
	-variable gload -command { repack}
.menu.options.m add check -label "Packet Queue" -underline 0 \
	-variable pqueue -command { repack }
.menu.options.m add check -label "Information" -underline 8 \
	-variable dlog -command { repack }
pack .menu.options -side left

# Toolbar
frame .toolbar -relief raised -bd 2
button .toolbar.up -command { fifoCmd up } \
	-state disabled \
	-image [image create photo -file "$imagepath/up.gif" ]
toolTipSet .toolbar.up {Link up}
button .toolbar.down -command { fifoCmd down } \
	-state disabled \
	-image [image create photo -file "$imagepath/down.gif" ]
toolTipSet .toolbar.down {Link down}
checkbutton .toolbar.dstatus -variable dstatus -command { repack } \
	-indicatoron 0 \
	-image [image create photo -file "$imagepath/dstatus.gif" ]
toolTipSet .toolbar.dstatus {Detailed status}
checkbutton .toolbar.tload -variable tload -command { repack } \
	-indicatoron 0 \
	-image [image create photo -file "$imagepath/tload.gif" ]
toolTipSet .toolbar.tload {Numeric load}
checkbutton .toolbar.gload -variable gload -command { repack } \
	-indicatoron 0 \
	-image [image create photo -file "$imagepath/gload.gif" ]
toolTipSet .toolbar.gload {Graphical load}
checkbutton .toolbar.pqueue -variable pqueue -command { repack } \
	-indicatoron 0 \
	-image [image create photo -file "$imagepath/pqueue.gif" ]
toolTipSet .toolbar.pqueue {Packet queue}
checkbutton .toolbar.dlog -variable dlog -command { repack } \
	-indicatoron 0 \
	-image [image create photo -file "$imagepath/dlog.gif" ]
toolTipSet .toolbar.dlog {Information}
pack .toolbar.up .toolbar.down \
	.toolbar.dstatus .toolbar.tload .toolbar.gload \
	.toolbar.pqueue .toolbar.dlog \
	-side left

# Basic status display
frame .basic -relief groove -bd 2
label .basic.p1 -text "Interface "
label .basic.p2 -textvar status(iface)
label .basic.p3 -text " from "
label .basic.p4 -textvar status(lip)
label .basic.p5 -text " to "
label .basic.p6 -textvar status(rip)
label .basic.p7 -text " in state "
label .basic.p8 -textvar status(fsm)
pack .basic.p1 -side left
pack .basic.p2 -side left
pack .basic.p3 -side left
pack .basic.p4 -side left
pack .basic.p5 -side left
pack .basic.p6 -side left
pack .basic.p7 -side left
pack .basic.p8 -side left


# Link status display
frame .status -relief groove -bd 2

set col1 {"Link Status" "Next Alarm" "Forcing Rule"}
set col2 {status(up) status(timeout) status(force)}
set col3 {"Forcing Timeout" "Impulse State" "Initial Impulse"}
set col4 {status(force_timeout) status(impmode) status(imp_itime)}
set col5 {"Impulse Length" "Impulse Fuzz" "Impulse Timeout"}
set col6 {status(imp_time) status(imp_fuzz) status(imp_timeout)}

frame .status.col1
frame .status.col2
frame .status.col3
frame .status.col4
frame .status.col5
frame .status.col6
pack .status.col1 -side left -anchor nw
pack .status.col2 -side left -expand 0 -fill x -anchor nw
pack .status.col3 -side left -anchor nw
pack .status.col4 -side left -expand 0 -fill x -anchor nw
pack .status.col5 -side left -anchor nw
pack .status.col6 -side left -expand 0 -fill x -anchor nw

set i0 0
foreach i $col1 {
    label .status.col1.$i0 -text $i
    pack .status.col1.$i0 -side top -anchor nw
    incr i0
}

set i0 0
foreach i $col2 {
    message .status.col2.$i0 -textvar $i -rel sunken -bor 1 -width 100 -anchor nw
    pack .status.col2.$i0 -side top -fill x -expand 1 -anchor nw
    incr i0
}

set i0 0
foreach i $col3 {
    label .status.col3.$i0 -text $i
    pack .status.col3.$i0 -side top -anchor nw
    incr i0
}

set i0 0
foreach i $col4 {
    message .status.col4.$i0 -textvar $i -rel sunken -bor 1 -width 100 -anchor nw
    pack .status.col4.$i0 -side top -fill x -expand 1 -anchor nw
    incr i0
}

set i0 0
foreach i $col5 {
    label .status.col5.$i0 -text $i
    pack .status.col5.$i0 -side top -anchor nw
    incr i0
}

set i0 0
foreach i $col6 {
    message .status.col6.$i0 -textvar $i -rel sunken -bor 1 -width 100 -anchor nw
    pack .status.col6.$i0 -side top -fill x -expand 1 -anchor nw
    incr i0
}


# Textual load monitor...

frame .tlm -relief groove -bd 2
label .tlm.l1 -text "RX Load/Total"
message .tlm.l2l -textvar status(rx_load) -width 100 -bor 1 -rel sunken
message .tlm.l2t -textvar status(rx_total) -width 100 -bor 1 -rel sunken
label .tlm.l3 -text "TX Load/Total"
message .tlm.l4l -textvar status(tx_load) -width 100 -bor 1 -rel sunken
message .tlm.l4t -textvar status(tx_total) -width 100 -bor 1 -rel sunken
pack .tlm.l1 -side left -expand 0 -fill x
pack .tlm.l2l -side left -expand 1 -fill x
pack .tlm.l2t -side left -expand 1 -fill x
pack .tlm.l3 -side left -expand 0 -fill x
pack .tlm.l4l -side left -expand 1 -fill x
pack .tlm.l4t -side left -expand 1 -fill x


# Graphical load monitor...
frame .lm -relief groove -bd 2
# 60 is a good height. Divisible by 1 through 6 evenly, but high enough to see.
stripchart .lm.tx 100 60 "TX"
frame .lm.sep -width 2 -bor 2 -rel sunken
stripchart .lm.rx 100 60 "RX"
pack .lm.rx -side left -expand 1 -fill both -pady 0
pack .lm.sep -side left -fill y -pady 0
pack .lm.tx -side left -expand 1 -fill both -pady 0


# Connection queue
frame .queue -relief groove -bd 2
frame .queue.menu -relief raised -bd 2
pack .queue.menu -side top -anchor nw -fill x -expand 0
  label .queue.menu.label -text "Connection Queue"
  menubutton .queue.menu.in_traffic -text "Traffic In" -menu .queue.menu.in_traffic.m -underline 0
  menu .queue.menu.in_traffic.m
  .queue.menu.in_traffic.m add radiobutton -label {Packets per second} \
	-variable in_usage -value pps
  .queue.menu.in_traffic.m add radiobutton -label {Bytes per second} \
	-variable in_usage -value bps
  .queue.menu.in_traffic.m add radiobutton -label {Link Bandwidth %} \
	-variable in_usage -value lbp
  .queue.menu.in_traffic.m add radiobutton -label {Bytes Total} \
	-variable in_usage -value tot

  menubutton .queue.menu.out_traffic -text "Traffic Out" -menu .queue.menu.out_traffic.m -underline 0
  menu .queue.menu.out_traffic.m
  .queue.menu.out_traffic.m add radiobutton -label {Packets per second} \
	-variable out_usage -value pps
  .queue.menu.out_traffic.m add radiobutton -label {Bytes per second} \
	-variable out_usage -value bps
  .queue.menu.out_traffic.m add radiobutton -label {Link Bandwidth %} \
	-variable out_usage -value lbp
  .queue.menu.out_traffic.m add radiobutton -label {Bytes total} \
	-variable out_usage -value tot
  pack .queue.menu.label -side left
  pack .queue.menu.out_traffic .queue.menu.in_traffic -side right
frame .queue.vis -bor 0
text .queue.vis.text -bor 0 -yscrollcommand ".queue.vis.yscroll set" -height 6 -width 72 -highlightthickness 0 -wrap none -insertontime 0
scrollbar .queue.vis.yscroll -relief sunken -command ".queue.vis.text yview" -highlightthickness 0
pack .queue.vis.text -side left -fill both -expand 1 -pady 0
pack .queue.vis.yscroll -side right -fill y -pady 0
pack .queue.vis -side top -fill both -expand 1 -pady 0


# Information
frame .message -relief groove -bd 2
frame .message.menu -relief raised -bd 2
pack .message.menu -side top -anchor nw -fill x -expand 0
  label .message.menu.label -text "Information"
  menubutton .message.menu.loglevel -text "Log Level" -menu .message.menu.loglevel.m -underline 0
  menu .message.menu.loglevel.m
  .message.menu.loglevel.m add radiobutton -label {Emergency} \
	-variable monloglevel -value 0 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Alert} \
	-variable monloglevel -value 1 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Critical} \
	-variable monloglevel -value 2 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Error} \
	-variable monloglevel -value 3 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Warning} \
	-variable monloglevel -value 4 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Notice} \
	-variable monloglevel -value 5 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Info} \
	-variable monloglevel -value 6 -command { setMonitor }
  .message.menu.loglevel.m add radiobutton -label {Debug} \
	-variable monloglevel -value 7 -command { setMonitor }
  pack .message.menu.label -side left
  pack .message.menu.loglevel -side right
frame .message.vis
text .message.vis.text -bor 0 \
	-height 8 -width 60 -highlightthickness 0 -insertontime 0 \
	-yscrollcommand ".message.vis.yscroll set" \
	-wrap none -xscrollcommand ".message.vis.xscroll set"
scrollbar .message.vis.yscroll -relief sunken -highlightthickness 0 \
	-command ".message.vis.text yview"
scrollbar .message.vis.xscroll -relief sunken -highlightthickness 0 \
	-orient horizontal \
	-command ".message.vis.text xview"
pack .message.vis.yscroll -side right -fill y
pack .message.vis.xscroll -side bottom -anchor s -fill x
pack .message.vis.text -side left -fill both -padx 2 -pady 2 -expand 1
pack .message.vis -side top -fill both -expand 1 -pady 0

proc repack {} {
    global toolbar dstatus tload gload pqueue dlog

    pack forget .toolbar
    pack forget .basic
    pack forget .status
    pack forget .tlm
    pack forget .lm
    pack forget .queue
    pack forget .message

    if {$toolbar} {
    	pack .toolbar -side top -fill both -expand 0 -pady 0
    }
    pack .basic -anchor nw -expand 0 -fill x -side top
    if {$dstatus} {
    	pack .status -side top -fill both -expand 0 -pady 0
    }
    if {$tload} {
        pack .tlm -side top -fill both -expand 0 -pady 0
    }
    if {$gload} {
    	pack .lm -side top -fill both -expand 0 -pady 0
    }
    if {$pqueue} {
    	pack .queue -side top -fill both -expand 1 -pady 0
    }
    if {$dlog} {
        pack .message -side top -fill both -expand 1 -pady 0
    }

    wm geometry .

    write_config_file
}

proc write_config_file {} {
    global user_config_file
    global toolbar dstatus tload gload pqueue dlog
    
    set config_file [ open $user_config_file "w" ]

    if {[ info exists toolbar ]} {
        puts $config_file "set toolbar $toolbar"
    }
    
    if {[ info exists dstatus ]} {
        puts $config_file "set dstatus $dstatus"
    }
    
    if {[ info exists tload ]} {
        puts $config_file "set tload $tload"
    }
    
    if {[ info exists gload ]} {
        puts $config_file "set gload $gload"
    }
    
    if {[ info exists pqueue ]} {
        puts $config_file "set pqueue $pqueue"
    }
    
    if {[ info exists dlog ]} {
        puts $config_file "set dlog $dlog"
    }

    flush $config_file
    close $config_file
}

repack

proc load_init {} {
    global status

    set status(rx_load5) "0.0"
    set status(tx_load5) "0.0"
    set status(rx_load30) "0.0"
    set status(tx_load30) "0.0"
    set status(rx_load150) "0.0"
    set status(tx_load150) "0.0"
    set status(tx_total) 0
    set status(rx_total) 0
}

load_init

update
if { $diald_FIFO != "" || $diald_HOST != "" } {
    openMonitor
}