#!/bin/sh
#\
exec /usr/bin/wish "$0" ${1+"$@"}
# Opps still here ? Well start the interactive command line interface 
# to be implemented at a later date ...

###############################################################################
# TkMasqdialer                                                                #
# Copyright (C) 1998 BJ Goodwin                                               #
# Copyright (C) 1998 Michael H. Voase                                         #
#                                                                             #
# This program is free software; you can redistribute it and/or               #
# modify it under the terms of the GNU General Public License                 #
# as published by the Free Software Foundation; either version 2              #
# of the License, or (at your option) any later version.                      #
#                                                                             #
# This program is distributed in the hope that it will be useful,             #
# but WITHOUT ANY WARRANTY; without even the implied warranty of              #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
# GNU General Public License for more details.                                #
#                                                                             #
###############################################################################
#                                                                             #
# Let me know if you have any suggestions, comments, or questions. My         #
# thanks to Jeff Meininger for the Masqdialerd, very nice, handy, and         #
# portable.                                                                   #
#                                                                             #
# BJ Goodwin                                                                  #
# latency@cutlet.ddns.org                                                     #
# http://www.cutlet.ddns.org                                                  #
#                                                                             #
# Michael H. Voase                                                            #
# mvoase@midcoast.com.au                                                      #
# http://www.midcoast.com.au/~mvoase                                          #
#                                                                             #
###############################################################################
#
# Change these to suit your own system

# Note Version 2 Masqdialer places a lot more demands
# on the config file like adding new buttons and actions
# to the default tkmasqdial window . However the old config should
# also be readable without change ;-) 

set User_Config "$env(HOME)/.tkmasqdialer"
set Code_Config "$env(HOME)/.tkmasqcode"
set Install_Dir "/usr/local/bin"

# Some more global values for all procs .

set Sock_id "NULL"
array set timer { id "NULL" interval 1000 curr 0 istimer 0}
set connsound none
set dconnsound none
set username none
set password none
set mute on
set servername "NULL"
set serverport "NULL"
set ProgramName "TkMasqdialer"
set Version "2.00a"
set OS_name $tcl_platform(os)
set OS_version $tcl_platform(osVersion)
set CPU_type $tcl_platform(machine)
set FullPath $env(PATH)
set Have_Config 0
# Tweak this if you have a slow network connection ( in milli seconds )
set READ_DELAY1 100
# Tweak this for the second half of the non- blocking read ( milli seconds )
set READ_DELAY2 200

# Apperntly this gets done once and once only ...
wm withdraw .


proc tkmasqdial { } {
    global Have_Config User_Config timer Sock_id

# Source user defined variables 
# The machine wide config is optional ...

    create_default_config
    
    set res [ load_config  "/etc/tkmasqdial.conf" ] 
    set res [ load_config  $User_Config  ]	
    create_main_win    
    
    if { ! $Have_Config } {
	after 1 spawn_config_module
    } else {	
    after 300 open_server_conn
    }
}

#############################################################################
#
# First the low levelstuff . I want this handy to iron the wrinkles 
# out . Most of the graphic and config stuff you will find at the end
# Note : refer to the server section for proc's that update the display

proc spawn_config_module { } {
# We have to determine if we can find the config module .
# If so , then source it . After sourcing the module we can
# call the functions in it . however once sourced , its text 
# pages remain in memory until the user restarts tkmasqdialer .
# Dats Ok by me cause it allows a spawned process ( using after ;-)
# to continue to run simultaneously with tkmasqdialer . Note a lockout
# variable is used to check for the precense of the config module so that
# two simultaneous modules cannot be launched .

# Second not - the follwing code is not what config will be but is
# used for debugging purposes until I have written up the real config module
    global Serv_addr username password dconnsound connsound mute 
    global Install_Dir server_name_ent

    puts "Current Config -"
    puts " Server Address - $Serv_addr(addr)"
    puts " Server Port    - $Serv_addr(port)"
    puts " Username       - $username"
    puts " Password       - $password"
    puts " Deconnect Sound- $dconnsound"
    puts " Connect Sound  - $connsound"
    puts " Mute           - $mute"
    puts " Serv ent textvar - $server_name_ent(textvariable)"
    set config_filename "$Install_Dir/tkmasqconf"
    set res [ source $config_filename ]
    if { $res == "" } {
	puts "error sourcing configure"
	}
}

proc load_config { config_file } {
    global Have_Config Serv_addr servername serverport
    global connsound dconnsound username password mute
    
    if { $config_file=="" } {
	return "no filename"
	}
    set res "error"
    if {[ file exists $config_file ]} {
	set res [ source $config_file ] 
	if { $res == "" } {
	    puts "Call_config : Error sourcing machine config" 
    	    } else { 
		set Have_Config 1 
		if { $servername != "NULL" } { 
		    set Serv_addr(addr) $servername 
		    puts "Soucring old servername $servername"
		    }
		if { $serverport != "NULL" } {
		    set Serv_addr(port) $serverport
		    puts "Sourcing old serverport $serverport"
		    }
		}
    }
    return $res
}

proc rem_control_proc { } {
#rem this is for later ...

}
proc recreate_window { } {
# Note this function is specific for tkmasqdialer . Subsequent functions
# in seperate modules must provide their own recreate functions ( if needed )
# This functions purpose is to allow a user to view the changes to the 
# tkmasqdialer main window after configuration...
 
    destroy .f
    create_main_win
    return
}
proc open_sock { serv_args  } { 
    upvar $serv_args addr_arr 

    puts "Open sock : args $addr_arr(addr) $addr_arr(port) "
    set timeout 2
    if {[ info exists $addr_arr(addr) ]} {
	return "NULL"
	}  
    if { $addr_arr(addr) == "NULL" || $addr_arr(addr) == "" } {
	return "NULL"
	}
    if {[ info exists $addr_arr(port) ] || $addr_arr(port) == "" } {
	set port 222
	} else { set port $addr_arr(port) }
    puts " Open sock : Opening socket " 
    set errinf [ catch { 
	set dingus [ socket -async $addr_arr(addr) $port ]
	} ]
    if { $errinf != 0 } {
	return "NULL"
	}
    if {![ info exists $dingus ]} { 
	set sock $dingus
	} else {
	puts " Open sock : failed to create socket"   
	return "NULL"
	} 
    
    fconfigure $sock -buffering line -blocking 0
    flush $sock
    return $sock    
}

proc close_sock { sock_id } {
    
    if { $sock_id != "NULL" } {
	flush $sock_id
	close $sock_id
	set sock_id "NULL"
    } else { puts "Close sock : Sock not open" }
    return $sock_id
}

proc read_sock { sock } {
# This is a scary routine . The tcl gurus recommend using
# vwait to enter the event loop to wait for input . Some 
# say that this is unreliable . The HTTP 2.0 in tcl uses a
# callback some your milage may vary with this routine .
# further improvements could be made using fileevent which works on
# sockets as well ....
    
    fconfigure $sock -blocking 1
    gets $sock resp
    fconfigure $sock -blocking 0 
    if {![ info exists $resp ]} {
        return $resp
      } else {
    return "NULL"
    }
}
proc read_sock_list { sock } {
    global READ_DELAY1 READ_DELAY2
    
# Note this is a "read all you can for the moment" type of function
# the two numbers to tweak if you have problems 

    after $READ_DELAY1
    set resp [ read $sock ]
    puts " Read sock list : First resp $resp"
    while {![ fblocked $sock ]} {
	after $READ_DELAY2
	set smore [ read $sock ]
	puts "Read sock list : Blocked $smore"
	set resp [ join $resp $smore ]
	}
    return $resp
}

# FIXME
proc write_sock { sock sdata } {

    puts $sock $sdata
    return
}

proc Overtime { $sock } {
    puts "Overtime again !"
    fconfigure $sock -blocking 0
    flush $sock
}
proc conv_string { mess } {
# This proc converts a "\n" seperated list into a space seperated list
# and trims the "READY" off the end .. ( gotta trim a litte of everything ..)

    set dislist [ string trimright $mess ]
    set dislist [ split $dislist "\n" ]
    regsub "READY" $dislist "" dislist
    set dislist [ string trim $dislist ]
    puts " conv string : split list >$dislist<"
    return $dislist
}    



proc check_auth { sock } {

    write_sock $sock "AUTH"
    set $resp [ read_sock $sock ]
    if {[ info exists $resp ]} {
	return $resp 
	} else { return "error no read" }
}

proc client_auth { sock } {
    global username password
    
    if { $sock == "NULL" } { return }
    if {![ info exists $username ]} {
	write_sock $sock "USER:$username"
	read_sock $sock
	}
    if {![ info exists $password ]} {
	write_sock $sock "PASS:$password"
	read_sock $sock
	}
    return
}

proc open_conn_log { filename } {
}
proc close_conn_log { filename } {
}
proc write_conn_log { message } {

}
#############################################################################
#
# The server interaction section . These procs will perform the command
# required as well as updating the window as information becomes available
# These proc's ( at this stage ) take no parameters and return nothing .

proc open_server_conn { } {
    global Sock_id Serv_addr conn_discon_but service_mnu
    global services_avail_but conn_stat_but timer_but
    
    set dumm [open_sock Serv_addr]
    if { $dumm == "NULL" } {
	puts " Open server conn : Failed on response $dumm"
	server_error "Server Address not found"
	return	
    }

# At this point , tcl will give us a socket if the host address	
# exists but the port is not available . Catch the error on the
# first read and complain about it ...

    set errinf [ catch { set resp [ read_sock $dumm ] } ]
    puts "Open server conn : Error Info $errinf"
    if { $errinf != 0 } {
	server_error "Server Port not found"
	close_sock $dumm
	return
	}
    puts "Open server conn : Response $resp"
    if { $resp != "READY" } {
        server_error "Not Ready"
        close_sock $dumm
        return
        }
    set Sock_id $dumm
    array set conn_discon_but { text "Dial" command "{dial_action}" }
    Set_action conn_discon_but
    get_server_status 	 
    set new_list [ get_server_list ]
    Update_menu_button service_mnu $new_list
    client_auth $Sock_id
    set services_avail_but(state) normal
    set conn_stat_but(state) normal
    set timer_but(state) normal
    Set_config services_avail_but state
    Set_config conn_stat_but state
    Set_config timer_but state
    return 
}

# Note : The close sock routine dont care less if the connection
# is up or down , it will close the socket and reset the dial 
# messege to connect

proc close_server_conn { } {
    global Sock_id conn_stat_msg baud_msg timer_msg conn_discon_but
    global timer service_mnu services_avail_but conn_stat_but timer_but

    if { $Sock_id != "NULL" } { 
        write_sock $Sock_id "QUIT"
	flush $Sock_id
	close_sock $Sock_id
	set Sock_id "NULL"
	}
    set conn_stat_msg(text) "Not connected"
    Set_text conn_stat_msg
    set timer_msg(text) "Unavailable"
    Set_text timer_msg
    set baud_msg(text) "Unavailable"
    Set_text baud_msg
    if { $timer(id) != "NULL" } { timer_kill }
    array set conn_discon_but { text "Connect" command "{conn_action}" }
    Set_action conn_discon_but
    Clear_menu_button service_mnu
    set services_avail_but(state) disabled
    set conn_stat_but(state) disabled
    set timer_but(state) disabled
    Set_config services_avail_but state
    Set_config conn_stat_but state
    Set_config timer_but state
    return
}
proc get_server_time { } {
    global Sock_id
    
    if { $Sock_id == "NULL" } { return "NULL" }
    flush $Sock_id
    write_sock $Sock_id "CTIME"
    set resp [ read_sock_list $Sock_id ]
    set resp [ conv_string $resp ]
    return $resp
}
proc get_server_conn_time { } {
    global Sock_id
    
    if { $Sock_id == "NULL" } { return "DOWN" }
    flush $Sock_id    
    write_sock $Sock_id "TIME"
    set resp [ read_sock_list $Sock_id ]
    set resp [ conv_string $resp ]
    return $resp
}
proc set_uptimer { } {
    global timer Sock_id timer_msg 

    if { $Sock_id == "NULL" } { return }
    flush $Sock_id
    if {$timer(istimer) == 1} {timer_kill }
    set start_val [ get_server_conn_time ]
    if { $start_val == "DOWN" } {
	set timer_msg(text) "Down" 
	Set_text timer_msg
	return
    }
    set curr_val [ get_server_time ]
    set timer(curr) [ expr $curr_val - $start_val ]
    set timer(istimer) 1
    timer_loop
    return
}

# The set clock proc was for debuging the timer start / kill operations
# ... it may be usefull at a later date so has been left in ...

proc set_clock { start_val } {
    global timer

    if {$timer(istimer) == 1} {timer_kill}
    set timer(curr) $start_val
    set timer(istimer) 1
    timer_loop
    return
}

proc get_server_list { } {
    global Sock_id 
    
    if { $Sock_id == "NULL" } { return "" }
    flush $Sock_id
    write_sock $Sock_id "LIST"
    set new_list [ read_sock_list $Sock_id ]
    set new_list [ conv_string $new_list ]
# Quick and dirty hack on next line
    set new_list [ string range $new_list 6 [ expr [string length $new_list]-5]]    
    puts "Get server list : $new_list"
    return $new_list 
}
proc get_server_duration { } {
}
proc get_server_status { } {

    global conn_stat_msg baud_msg Sock_id conn_discon_but

    if { $Sock_id == "NULL" } { 
	set conn_stat_msg(text) "Not Connected"
	set baud_msg(text) "Unavailable"
	array set conn_discon_but { text "Connect" command "{conn_action}" }
        set conn_discon_but(enter_opt) ".f.frame2.help_lab configure -text {Attempt to connect to Server}" 
	Bind_obj conn_discon_but
        set timer_msg(text) "Unavailable"
	Set_text timer_msg
	Set_text conn_stat_msg
        Set_text baud_msg 
	Set_action conn_discon_but
	return
	}
    flush $Sock_id
    puts "Get server stat : Begin stat"
    write_sock $Sock_id "CYCLE"
    puts "Get server stat :Written cycle"
    set resp [ read_sock $Sock_id ]
    puts "Get server stat : Response 1 $resp"

    if { $resp != "READY" } {
      server_error $resp
      return
    }
    write_sock $Sock_id "STAT"
    set resp [ read_sock_list $Sock_id ]
    puts "Get server stat : Response 2 $resp"
    set resp [ conv_string $resp ]   
    if { $resp == "DOWN" } {
	set conn_stat_msg(text) "Down"
	array set conn_discon_but { text "Dial" command "{dial_action}" }
	set conn_discon_but(enter_opt) ".f.frame2.help_lab configure -text {Attemp to dial service}" 
    } else { 
	set dingus [ split $resp : ]
	set b 0
	foreach a $dingus {
	    set parm($b) $a
	    incr b
	    }
	puts "Get server stat : Response 3  $dingus bcount $b"
	
	set conn_stat_msg(text) "Connected"
	set baud_msg(text) $parm(2)
	set_uptimer
	array set conn_discon_but { text "Hangup" command "{kill_action}" }
        set conn_discon_but(enter_opt) ".f.frame2.help_lab configure -text {Disconnect from Service}" 

	}
    Bind_obj conn_discon_but
    Set_text conn_stat_msg
    Set_text baud_msg 
    Set_action conn_discon_but
    return $resp
}

proc dial_service { } {
    
# The generic open and initalize connection . This
# operation draws on the read_sock_list function to return as much
# as it can as the transaction is being completed . One of the more
# troublesome routines ...

    global service_mnu Server_addr conn_stat_msg baud_msg timer_msg 
    global conn_discon_but Sock_id tlo
    
    if { $Sock_id == "NULL" } { return }
    flush $Sock_id
    client_auth $Sock_id
    set conn_stat_msg(text) "Dialing $service_mnu(menuselect)"
    Set_text conn_stat_msg
    puts "Connection : $service_mnu(text)"
    write_sock $Sock_id "DIAL:$service_mnu(text)"

# Now here is where the nightmares start ---- FIXME please ...

    set res [ read_sock_list $Sock_id ]
    puts "Dialer : first read $res "
    if {[ regexp (ERROR) $res ]} {
	if {[ regexp (authorized) $res]} {
	 set conn_stat_msg(text) "Authorization failure !"
	 Set_text conn_stat_msg
	 return
	 } else {
	 set conn_stat_msg(text) "PPP Script failed"
	 Set_text conn_stat_msg
	 return
	 }
    } elseif {[ regexp (Executing) $res ]} {
        set conn_stat_msg(text) "Executing Script"
        Set_text conn_stat_msg
	puts "Dialer identified Executing - good"
    } else { 
	set conn_stat_msg(text) "Unknown,this is a bug in the first stage" 
	catch { puts "Dialer couldnt identify reply string - $res" }
	return
	} 
    after 1

# Second go at reading the stats ...

    set res [ read_sock $Sock_id ]
    puts "Dialer : second read $res"
    if {[ regexp (Started) $res ]} {
	set conn_stat_msg(text) "PPPD started"
	Set_text conn_stat_msg
	puts "Dialer identified Started - all is well"
    } elseif {[ regexp (Timeout) $res ]} {
	set conn_stat_msg(text) "Script did not start"
	Set_text conn_stat_msg
	puts "Dialer identified Timeout - Script failure"
	read_sock_list $Sock_id
	return
    } else { 
	set conn_stat_msg(text) "Unknown,this is a bug in the second stage"
	Set_text conn_stat_msg
	catch { puts "Dialer did not identify reply - $res" }
	read_sock_list $Sock_id
	return 
	}
    after 1

# Third go at reading the stats ...

    set res [ read_sock $Sock_id ]
    puts "Dialer : third read $res"
    if {[ regexp (success) $res ]} {
	set conn_stat_msg(text) "Dialup Successful"
	Set_text conn_stat_msg
	puts "Dialer identified success - all is well"
    } elseif {[ regexp (Busy) $res ]} {
	set conn_stat_msg(text) "Line engaged"
	Set_text conn_stat_msg
	puts "Dialer identified Busy - good but try again later"
	read_sock_list $Sock_id
	return
    } elseif {[ regexp (failed) $res ]} {
	set conn_stat_msg(text) "Connect Script failed"
	Set_text conn_stat_msg
	puts "Dialer identified failed - Connect script failed"
	read_sock_list $Sock_id
	return
    } else { 
	set conn_stat_msg(text) "Unknown,this is a bug in the third stage"
	Set_text conn_stat_msg
	catch { puts "Dialer didnt identify reply - $res" }
	read_sock_list $Sock_id
	return 
	}
    after 1

# Now a fourth

    set res [ read_sock $Sock_id ]
    puts "Dialer : fourth read $res"
    if {[ regexp (Established) $res ]} {
	set conn_stat_msg(text) "PPP link established"
	Set_text conn_stat_msg
    } else { 
	set conn_stat_msg(text) "Unknown,this is a bug in the fourth stage"
	Set_text conn_stat_msg
	catch { puts "Dialer didnt identify reply - $res" }
	read_sock_list $Sock_id
	return 
	}
    after 1

# And lastly a fifth -- There must be an easier way

    set res [ read_sock_list $Sock_id ]
    puts "Dialer : fifth read $res"
    if {[ regexp (Connected) $res ]} {
	set conn_stat_msg(text) "Connected!"
	Set_text conn_stat_msg
    } else { 
	set conn_stat_msg(text) "Unknown,this is a bug in the fifth stage"
	Set_text conn_stat_msg
	catch { puts "Dialer didnt identify reply - $res" }
	return 
	}
    array set conn_discon_but { text "Hangup" command "{kill_action}" }
    set conn_discon_but(enter_opt) ".f.frame2.help_lab configure -text {Hangup connection}" 
    Bind_obj conn_discon_but
    Set_action conn_discon_but
    get_server_status
    return
}
proc kill_service { } {
    global Sock_id conn_discon_but timer_msg baud_msg Select_service timer
    global conn_stat_msg
    
    if { $Sock_id == "NULL" } {
	return 
	}
    flush $Sock_id
    write_sock $Sock_id "KILL"
    set resp [read_sock $Sock_id]
    puts "Kill service : response $resp"
    set resp [ conv_string $resp ]
    
    if { $resp == "SUCCESS" } {
	set conn_stat_msg(text) "Connection Terminated"
	Set_text conn_stat_msg
	timer_kill
	set timer_msg(text) "Not Connected"
	Set_text timer_msg
	set baud_msg(text) "Not Available"
	Set_text baud_msg
	array set conn_discon_but { 
	    text "Dial" 
	    command "{dial_action}" 
    	    enter_opt 
	    ".f.frame2.help_lab configure -text {Attempt to connect to Server}" 
	    }
	Bind_obj conn_discon_but
	Set_action conn_discon_but
	return
    } else { 
	set conn_stat_msg(text) "Still Connected..."
	Set_text conn_stat_msg 
	return
    }
}

proc timer_loop { } {
    global timer timer_msg
    
	set timer(id) [ after $timer(interval) timer_loop  ]
	incr timer(curr)
	set timer_msg(text) [ clock format $timer(curr) -format %H:%M:%S -gmt true ]
        Set_text timer_msg
	return
}
proc timer_kill { } {
    global timer
    
	if { $timer(istimer)== 0 } { return } 
    	after cancel $timer(id)
	set timer(id) "NULL"
	set timer(curr) 0
	set timer(istimer) 0
	return 

}
proc update_loop { } {
}
proc update_kill { } {
}
proc get_fortune { } {
}
proc play_sound { } {
}

proc server_error { err_msg } {
    global conn_stat_msg
    
    set conn_stat_msg(text) $err_msg
    Set_text conn_stat_msg
    return
}

##############################################################################
#
# The user interaction section .These routines update the window as needed
# by the various other routines . Further on you will find the button actions
# bound to each displayed button and widget
#
# 

proc create_main_win { } {
    global tkmd frame1 frame2 
    global services_avail_but conn_stat_but baud_lab timer_but help_lab
    global mute_chk conn_stat_msg baud_msg timer_msg 
    global conn_discon_but quit_but conf_but mute_chk
    global service_mnu server_mnu server_name_ent server_port_ent

# This operation just sets the default buttons and messages .
# At the end is an eval to hook external configs to customize
# The buttons and the info panels on tkmasqdials default dial panel

    Set_wm tkmd
    Set_frame frame1
    Set_frame frame2
    Set_button services_avail_but
    Set_button conn_stat_but
    Set_label baud_lab
    Set_button timer_but
    Set_label help_lab
    Set_message conn_stat_msg
    Set_message baud_msg
    Set_message timer_msg
    Set_button conn_discon_but
    Set_button quit_but
    Set_button conf_but
    Set_check_button mute_chk
    Set_menu_button service_mnu
#    Set_menu_button server_mnu
    Set_entry server_name_ent
    Set_entry server_port_ent
    return      

}

##############################################################################
#
# Now for the default actions on the main window
# Note : With the way tkmasqdial has been programmed you can add your own 
# buttons and such to the main window . But remeber the more stuff 
# you put on it , the slower it goes . 'Spose computers are gettin'
# that fast these days that you probly dont give a hoot ...
# Well , that why I designed this so you can add what ya like ...
# 

proc dial_action { } {
    after 1 dial_service
}
proc kill_action { } {
    after 1 kill_service
}
proc conn_action { } {
    open_server_conn
}
proc discon_action { } {
    close_server_conn
}
proc config_action { } {
    after 1 spawn_config_module
}
proc check_service_action { } {
#    puts "Service action works"
    after 1 get_server_list
#    timer_kill
}
proc timer_action { } {

    after 1 set_uptimer

} 
proc update_stat_action { } {
#    puts "Update stat action works"
    after 1 get_server_status
}
proc quit_action { } {

    close_server_conn
    destroy .
    exit 0
}

##############################################################################
#
# Well thats it . The following section is for setting various widget 
# properties . Note that most set all the config properties of a widget
# in one call . Set_text will take a widget "object" as a parameter
# and just set the text message attribute . 
# Later on it will set all relevent text properties ( colours etc )
# Note that if any property is missing , it will generate an error and
# halt the program ....
#
proc Set_wm { Wobj } {

    global ProgramName

    upvar $Wobj tlo 

    wm client .$tlo(root) [info hostname]
    wm focusmodel .$tlo(root) passive
    wm geometry .$tlo(root) $tlo(Geom)
    wm maxsize .$tlo(root) $tlo(max_x) $tlo(max_y)
    wm minsize .$tlo(root) $tlo(min_x) $tlo(min_y)
    wm overrideredirect .$tlo(root) 0
    wm resizable .$tlo(root) $tlo(resize_x) $tlo(resize_y)
    wm title .$tlo(root) $ProgramName
    wm deiconify .$tlo(root)
    Set_frame tlo
    return
    
}
proc Set_frame { Fobj } {
    upvar $Fobj tlo

    frame $tlo(base) -borderwidth $tlo(border) -relief $tlo(style)
    Grid_def tlo
    return
}
proc Set_label { Lobj } {
    upvar $Lobj tlo
    
# To be added anchor and background

    label $tlo(base) -relief $tlo(style) -text $tlo(text) \
	-borderwidth $tlo(border) -width $tlo(width) \
	-foreground $tlo(fg) 
    Grid_def tlo
    return
}

proc Set_button { Bobj } {
    upvar $Bobj tlo
    
    button $tlo(base) -text $tlo(text) -command $tlo(command) \
	-width $tlo(width) -underline $tlo(undl) -state $tlo(state)
    Grid_def tlo
    Bind_obj tlo
    return
}

proc Set_check_button { Bobj } {
    upvar $Bobj tlo
    
    checkbutton $tlo(base) -variable $tlo(var) -onvalue $tlo(onval) \
	-offvalue $tlo(offval) -text $tlo(text) -width $tlo(width) \
	-underline $tlo(undl) 
    Grid_def tlo
    Bind_obj tlo
    return     
}
proc Set_menu_button { Bobj } {
    upvar $Bobj tlo
    
    set tlo(menu) [ tk_optionMenu $tlo(base) $tlo(menuselect) "" ]
    $tlo(menu) configure -relief $tlo(menustyle) 
    $tlo(base) configure -relief $tlo(style) -width $tlo(width)
    puts "menu $tlo(menu)"
    Grid_def tlo
    Bind_obj tlo
    return
}
proc Update_menu_button { Bobj list } {
    upvar $Bobj tlo
    
    $tlo(menu) delete 0
    set a 0
    foreach b $list {
	$tlo(menu) add radiobutton -label $b -variable $tlo(menuselect)
	puts "Update menu button: Adding service $b"
	incr a
	}
    $tlo(menu) invoke 0
}
proc Clear_menu_button { Bobj } {
    upvar $Bobj tlo
    
    set a 0
    foreach b $tlo(menulist) {
	$tlo(menu) delete $a
	incr a
	}
    $tlo(menu) invoke 0
    $tlo(menu) delete end
    set $tlo(menulist) ""
    set $tlo(text) ""
}     

proc Set_message { Mobj } {
    upvar $Mobj tlo
    
    message $tlo(base) -foreground $tlo(fg) -text $tlo(text) \
	-width $tlo(width) -borderwidth $tlo(border) -relief $tlo(style) 
    Grid_def tlo
    return 
}

proc Set_entry { Eobj } {
    upvar $Eobj tlo
    global Serv_addr
    
    entry $tlo(base) -textvariable $tlo(textvariable) -width $tlo(width) \
	-show $tlo(show)
    Grid_def tlo
    Bind_obj tlo
    return
}

proc Set_text { Nobj } {
    upvar $Nobj tlo
    
    $tlo(base) configure -text $tlo(text) 

# Add this later .... -foreground $tlo(fg)
    update
    return 

}
# Some tcl programmers ask why ? Cause its easier to just say
# Set_config <obj> attrib . There is one parameter ( style ) that
# does not conform to this model . That will be changed ...
 
proc Set_config { Uobj attrib } {
    upvar $Uobj tlo
    
    $tlo(base) configure -$attrib $tlo($attrib)
    return
}
     

proc Set_action { Bobj } {
    upvar $Bobj tlo
    
    $tlo(base) configure -command $tlo(command)
    Set_text tlo
    return
}

proc Grid_def { Gobj } {
    upvar $Gobj tlo

    grid config $tlo(base) -column $tlo(column) -row $tlo(row) \
	-ipadx $tlo(ipadx) -ipady $tlo(ipady) -padx $tlo(padx) \
	-pady $tlo(pady) -sticky $tlo(sticky) -columnspan $tlo(columnspan) \
	-rowspan $tlo(rowspan)
    return 
}

proc Bind_obj { Bobj } {
    upvar $Bobj tlo
    
    bind $tlo(base) <Enter> $tlo(enter_opt)
    bind $tlo(base) <Leave> $tlo(leave_opt) 
    return    
}

##############################################################################
#
# This is a big long mess of array set functions to set a default config
# for Tkmasqdial since the intention is that you can configure just
# about everything , so the default has to have a home somewhere ;-)
# Note : When tkmasqdial is configured by the users file , some or possibly
# all of these values will be overwritten and possibly extended .
#

proc create_default_config { } {
    global tkmd frame1 frame2
    global services_avail_but conn_stat_but baud_lab timer_but help_lab
    global mute_chk conn_stat_msg baud_msg timer_msg 
    global conn_discon_but quit_but conf_but service_mnu server_mnu
    global OS_name tcl_version tk_version CPU_type server_name_ent 
    global server_port_ent

    set tkmd(root) ""
    set tkmd(max_x) 358 
    set tkmd(max_y) 166
    set tkmd(min_x) 1 
    set tkmd(min_y) 1
    set tkmd(resize_x) 0
    set tkmd(resize_y) 0
    set tkmd(Position) "200x400"
    set tkmd(Geom) "356x164"
    set tkmd(base) .f
    set tkmd(border) 2
    set tkmd(padx) 0
    set tkmd(pady) 0
    set tkmd(style) "groove"
    set tkmd(column) 0
    set tkmd(row) 0
    set tkmd(columnspan) 3
    set tkmd(rowspan) 5
    set tkmd(ipadx) 0
    set tkmd(ipady) 0
    set tkmd(sticky) {}

#Define the base fames first - two in all - one got shotgunned

array set frame1 {
    base 	.f.frame1
    border 	1
    style 	ridge
    column 	0
    row 	0
    columnspan 	3
    rowspan 	4
    ipadx 	0
    ipady 	0
    sticky 	{}
    padx 	0
    pady 	0
}

    set frame2(base) .f.frame2
    set frame2(border) 1
    set frame2(style) ridge
    set frame2(column) 0
    set frame2(row) 5
    set frame2(columnspan) 3
    set frame2(rowspan) 1
    set frame2(ipadx) 0
    set frame2(ipady) 0
    set frame2(sticky) {}
    set frame2(padx) 0
    set frame2(pady) 0

# now for the labels


    set baud_lab(base) .f.frame1.baud_lab
    set baud_lab(style) raised
    set baud_lab(text) "Baud Rate:"
    set baud_lab(border) 1
    set baud_lab(column) 0
    set baud_lab(row) 4
    set baud_lab(ipadx) 2
    set baud_lab(ipady) 0
    set baud_lab(padx) 2
    set baud_lab(pady) 3
    set baud_lab(sticky) e
    set baud_lab(width) 16
    set baud_lab(fg) "rgb:00/00/00"
    set baud_lab(columnspan) 1
    set baud_lab(rowspan) 1

    set help_lab(base) .f.frame2.help_lab
    set help_lab(style) sunken
    set help_lab(text) "$OS_name using Tcl-$tcl_version/Tk-$tk_version on a $CPU_type"
    set help_lab(border) 1
    set help_lab(column) 0
    set help_lab(row) 0
    set help_lab(ipadx) 0
    set help_lab(ipady) 0
    set help_lab(padx) 0
    set help_lab(pady) 0
    set help_lab(sticky) {}
    set help_lab(width) 48
    set help_lab(fg) "rgb:00/00/00"
    set help_lab(columnspan) 4
    set help_lab(rowspan) 1

# And now for the buttons

array set services_avail_but {
    base .f.frame1.services_avail_but
    style raised
    text "Selected Server"
    border 0
    column 0
    row 1
    ipadx 0
    ipady 0
    padx 0
    pady 0
    sticky e
    width 14
    fg "rgb:00/00/00"
    columnspan 1
    rowspan 1
    undl 0
    command "{check_service_action}"
    enter_opt ".f.frame2.help_lab configure -text {Refresh services available from this server}" 
    leave_opt ".f.frame2.help_lab configure -text { }"
    state disabled
}
array set conn_stat_but { 
    base .f.frame1.conn_stat_but
    style raised
    text "Status:"
    border 1
    column 0
    row 2
    ipadx 0
    ipady 0
    padx 0
    pady 0
    sticky e
    width 14
    fg "rgb:00/00/00"
    columnspan 1
    rowspan 1
    undl 0
    command "{update_stat_action}"
    enter_opt ".f.frame2.help_lab configure -text {Update current server status}" 
    leave_opt ".f.frame2.help_lab configure -text { }"
    state disabled
}
array set timer_but {
    base .f.frame1.timer_but
    style raised
    text "Time Connected:"
    border 1
    column 0
    row 3
    ipadx 0
    ipady 0
    padx 0
    pady 0
    sticky e
    width 14
    fg "rgb:00/00/00"
    columnspan 1
    rowspan 1
    undl 0
    command "{timer_action}"
    enter_opt ".f.frame2.help_lab configure -text {Update current time online}" 
    leave_opt ".f.frame2.help_lab configure -text { }"
    state disabled
}
    set conn_discon_but(base) .f.frame1.conn_dison_but
    set conn_discon_but(text) Connect
    set conn_discon_but(command) "{conn_action}"
    set conn_discon_but(width) 14
    set conn_discon_but(undl) 0
    set conn_discon_but(columnspan) 1
    set conn_discon_but(rowspan) 1
    set conn_discon_but(column) 0
    set conn_discon_but(row) 0
    set conn_discon_but(padx) 0
    set conn_discon_but(pady) 0
    set conn_discon_but(ipadx) 0
    set conn_discon_but(ipady) 0
    set conn_discon_but(sticky) e
    set conn_discon_but(enter_opt) ".f.frame2.help_lab configure -text {Attempt to connect to Server}" 
    set conn_discon_but(leave_opt) ".f.frame2.help_lab configure -text { }"
    set conn_discon_but(state) normal

    set quit_but(base) .f.frame1.quit_but
    set quit_but(command) "{quit_action}"
    set quit_but(text) "Quit"
    set quit_but(width) 7
    set quit_but(undl) 0
    set quit_but(columnspan) 1
    set quit_but(rowspan) 1
    set quit_but(column) 2
    set quit_but(row) 4
    set quit_but(padx) 2
    set quit_but(pady) 0
    set quit_but(ipadx) 0
    set quit_but(ipady) 0
    set quit_but(sticky) e
    set quit_but(enter_opt) ".f.frame2.help_lab configure -text {Save current and exit}"
    set quit_but(leave_opt) ".f.frame2.help_lab configure -text { }"
    set quit_but(state) normal

    set conf_but(base) .f.frame1.conf_but
    set conf_but(command) "{config_action}"
    set conf_but(text) "Configure"
    set conf_but(width) 7
    set conf_but(undl) 0
    set conf_but(columnspan) 1
    set conf_but(rowspan) 1
    set conf_but(column) 2
    set conf_but(row) 3
    set conf_but(padx) 2
    set conf_but(pady) 0
    set conf_but(ipadx) 0
    set conf_but(ipady) 0
    set conf_but(sticky) e
    set conf_but(enter_opt) ".f.frame2.help_lab configure -text {Open configuration and Extension window}"
    set conf_but(leave_opt) ".f.frame2.help_lab configure -text { }"
    set conf_but(state) normal

# the messages
array set conn_stat_msg {
    base .f.frame1.con_stat_msg
    fg "rgb:ba/00/00"
    border 1
    style flat
    text "Not Connected"
    width 180
    columnspan 2
    rowspan 1
    column 1
    row 2
    ipadx 0
    ipady 0
    padx 0
    pady 3
    sticky w
}

array set timer_msg {
    base .f.frame1.timer_msg
    fg "rgb:00/00/00"
    border 1
    style flat
    text "No time Available"
    width 150
    column 1
    row 3
    columnspan 1
    rowspan 1
    ipadx 0
    ipady 0
    padx 0
    pady 3
    sticky w
}

array set baud_msg {
    base .f.frame1.baud_msg
    fg "rgb:00/00/00"
    border 1
    style flat
    text "No Rate Available"
    width 150
    columnspan 1
    rowspan 1
    column 1
    row 4
    ipadx 0
    ipady 0
    padx 0
    pady 3
    sticky w
}

# Entries .. Text entry boxes for server name and port ...
array set server_name_ent {
    base .f.frame1.server_name_ent
    text ""
    show ""
    textvariable Serv_addr(addr)
    exportSelection 1
    width 18
    column 1
    row 1
    ipadx 0
    ipady 0
    padx 0
    pady 0
    sticky w
    columnspan 1
    rowspan 1
    enter_opt ".f.frame2.help_lab configure -text {Server host name}"
    leave_opt ".f.frame2.help_lab configure -text { }"
}

array set server_port_ent {
    base .f.frame1.server_port_ent
    text ""
    show ""
    textvariable Serv_addr(port)
    exportSelection 1
    width 10
    column 2
    row 1
    ipadx 0
    ipady 0
    padx 0
    pady 0
    sticky e
    columnspan 1
    rowspan 1
    enter_opt ".f.frame2.help_lab configure -text {Server port}"
    leave_opt ".f.frame2.help_lab configure -text { }"
}


# And finally a check box
array set mute_chk {
    base .f.frame1.mute_chk
    var mute
    onval "on"
    offval "off"
    text "Mute"
    width 7
    undl 0
    columnspan 1
    rowspan 1
    column 2
    row 0
    enter_opt ".f.frame2.help_lab configure -text {Enable or Disable audio effects}"
    leave_opt ".f.frame2.help_lab configure -text { }"
    sticky w
    ipadx 0
    ipady 0
    padx 0
    pady 0
}

# The menu lists . This part is in flux . To get the basic config
# out the door , instead of a server menu ( which will allow 
# connections to multiple mservers on a network ) the current version
# of new frame work will use two text entry boxes ala tkmasqdial 1.04
# so that the user can enter the server name and port directly into the 
# panel . This will take the pressure off me until I get the config
# program written to do all the nice stuff I have been promising .

array set service_mnu {
    base 	.f.frame1.service
    command 	"{service_action}"
    text 	"Select service"
    style	sunken
    width 	14
    undl 	0
    columnspan 	1
    rowspan 	1
    column 	1
    row 	0
    padx 	0
    pady 	0
    ipadx 	0
    ipady 	0
    sticky 	w
    enter_opt ".f.frame2.help_lab configure -text {Select a new Service}"
    leave_opt ".f.frame2.help_lab configure -text { }"
    menu	""
    menulist	"Unavailable"
    menustyle	raised
    menuselect	"service_mnu(text)"
}

# For the moment server menu is not used ...

array set server_mnu {
    base 	.f.frame1.serv
    command 	"{server_action}"
    text 	"Select server"
    style	sunken
    width 	14
    undl 	0
    columnspan 	1
    rowspan 	1
    column 	1
    row 	1
    padx 	0
    pady 	0
    ipadx 	0
    ipady 	0
    sticky 	w
    enter_opt ".f.frame2.help_lab configure -text {Select a new server}" 
    leave_opt ".f.frame2.help_lab configure -text { }"
    menu	""
    menulist	"Unavailable"
    menustyle	raised
    menuselect	"server_mnu(text)"
}


} 
# End of create_default_config
puts "Just a test -- thats all - a test"

tkmasqdial
