#!/usr/bin/perl -w

##
## A very basic MUD client. Use at your own risk.
##
## Bugs:
##     - Error handling still needs some cleaning.
##     - resizing is flaky. Don't do it.
##     - sequences of auto-responses don't seem to work right
##
## $Id: mulmo.pl,v 1.56 2004/06/06 16:19:18 magic Exp magic $
##

use strict;
use Tk;
use Tk::HList;

use FileHandle;
use IO::Socket;
use IO::Select;
use Getopt::Long;

use Term::ANSIColor;

$SIG{'INT'} = 'dokill';
$SIG{'PIPE'} = sub { die "The server apparantly doesn't want you. Check your host and port,\n" .
			 "and, if those are correct, the server is probably down. Sorry.\n$!\n" };

my $version = "1.8.9-5";

## global GUI objects
my ($mw,                                      # MainWindow object
    $output_window,                           # The output window object
    $command,                                 # The command input object
    $timer_ent,                               # The timer-value input object
    $timer,                                   # The timer on/off button object
    $savebut,                                 # The save button (save config)
    $recon,                                   # The re-connect button object
    $quit,                                    # The quit button object
    $colorbut,                                # The button for color configuration
    $autorespbut,                             # The button for bind configuration
    $ar_menu,                                 # The HList for the auto-response list
    $ar_edit_but,                             # The edit button for the auto-response list
    $bindbut,                                 # The button for bind configuration
    $timebut,                                 # The button for configuring the timer
    $noscroll,                                # The checkbutton that stopps the scrolling
    $noauto,                                  # The checkbutton that stops auto-responses
    $noargmw,                                 # The main window to display if host, port, and name are 
                                              #     not supplied
    $mmtop,                                   # The selection window
    $mm_go_but,                               # The go button in the selection window
    $mm_char_ent,                             # The character entry in the selection window
    $mm_host_ent,                             # The host entry in the selection window
    $mm_port_ent,                             # The port entry in the selection window
    $mudmenu,                                 # The menu of muds and users in .mulmorc
    );

my ($timer_id, $timer_var);                   # The cancel ID for the timed events and the state of $timer
my ($ns_var);                                 # The state of no_scroll
my ($na_var);                                 # The state of no_auto
my $cr_var = 0;                               # The state of the initial config read
my ($can_id, $read_freq) = (0, 200);          # The cancel ID for the read_MUD timer, and how often we read
                                              #    from the MUD

## Getopt global variables
my ($h,                                       # host name/address
    $p,                                       # port number/name
    $char,                                    # character name
    $char_info,                               # character info file
    $config_file,                             # MuLMo config file
    $height,                                  # height of $output_window
    $width,                                   # width of $output_window
    $bg,                                      # background color
    $fg,                                      # foreground color
    $fn,                                      # font name
    $timer_delay,                             # freqency for $timer->repeat( ... )
    $quiet_timer,                             # should timed_actions use a list, or simply a newline?
    $auto_MUD,                                # should we do post-printing parsing?
    $help,                                    # print a usage statement
    );

## Other global variables
my ($passwd);                                 # The password from $config_file

my ($s);                                      # The socket object (file descriptor)
my ($select);                                 # The IO::Select object

my @command_history = ('quit');               # make the command history, and seed it with "quit"
my ($ch_index, $ch_count) = (0, 0);           # The index mark for @command_history

my $de_color_string;                          # The big list of ANSI color codes to be stripped
                                              #    for auto_MUD

my @timer_actions = ( 'score',
		      'who',
		      'users',
		      'time',
		      'inv',
		      'sit',
		      'stand',
		      'quests', 
		      );             # default timer actions

## Default user-defined bindings
my %def_bindings = ( '<Control-c>' => '',
		     '<Control-d>' => '',
		     '<Control-g>' => '',
		     '<Control-l>' => '',
		     '<Control-o>' => '',
		     '<Control-q>' => '',
		     '<Control-r>' => '',
		     '<Control-s>' => '',
		     '<Control-v>' => '',
		     '<Control-x>' => '',
		     '<Control-z>' => '',
		     );

## Default auto responses
my %auto_responses;
my @auto_resp_keys;

#  my %auto_responses = ( 
#  		       '(\w+) tells you .*\bgimme your version' => 
#  		                        "%a I am running $version, and I think it is better than Cats!",
#  		       'has entered the game'                   => 'ust',
#  		       '(\w+) tells you .*\b(hello|high)\b'     => '%a Hey there, %a.',
#  		       '(\w+) says .*\b(hello|high)\b'          => "say Hey there, %a.\ndance",
#  		       's( at|) you\.'                          => 'RANDOM[smile:frown:giggle:snort:poke %a:worship %a]',
#  		     );


my $config_ref;
my $config_index = -1;

my @string_config_tags = ('password',
			  'foreground',
			  'background',
			  'font',
			  'height',
			  'width',
			  'timervalue', );
my @array_config_tags = ('timeraction');
my %nesting_config_tags = ( shortcut => ['key', 'binding'],
			    autoresp => ['trigger', 'action'] );

$auto_MUD = 1;                                      # turn auto-responses on by default

Getopt::Long::config("auto_abbrev");

my $ret = GetOptions ("host=s", \$h, 
		      "port=s", \$p,
		      "name=s", \$char,
		      "file=s", \$char_info, 
		      "config=s", \$config_file,
		      "height=i", \$height,
		      "width=i", \$width,
		      "bg=s", \$bg,
		      "fg=s", \$fg,
		      "fn=s", \$fn,
		      "timer=i", \$timer_delay,
		      "qtimer!", \$quiet_timer,
		      "autoresp!", \$auto_MUD,
		      "help|usage|?", \&help);

$config_file = $ENV{HOME} . "/.mulmorc" unless $config_file;

if (!$auto_MUD) {
    $auto_MUD = 1;                                      # turn auto-responses on by default
    print STDERR "\tThe '-noautoresp' flag has been depreciated, and is only\n",
                 "\tincluded to let old scripts continue to work.\n";
}

if ($char_info) {
    print STDERR "\tThe '-file' flag has been depreciated, and is only\n",
                 "\tincluded to let old scripts continue to work.\n";
}

#$p = 6715 unless $p;
#$h = 'localhost' unless $h;

my $fill_mudmenu = 0;

read_config($config_file);

if ($p && $h) {
    $config_index = fill_config();
} else {
    $fill_mudmenu = 1;
    my $tmp_bg = "#7a7abb" unless $bg;
    my $tmp_fg = "#151769" unless $fg;
    my $tmp_fn = "lucidasanstypewriter-12" unless $fn;

    $mmtop = MainWindow->new( -background => $tmp_bg,
			       -title      => "MuLMo Host selection",
			       -foreground => $tmp_fg);
    my $mmtop_label = $mmtop->Label ( -text       => "Host and Name list",
				      -background => $tmp_bg,
				      -foreground => $tmp_fg )->pack(-side=>"top");
    my $tp_frame = $mmtop->Frame( -width=>40,
				  -fg      => $tmp_fg,
				  -bg      => $tmp_bg)->pack(-side=>"top", -fill=>'x');
    my $md_frame = $mmtop->Frame( -width=>40,
				  -fg      => $tmp_fg,
				  -bg      => $tmp_bg)->pack(-side=>"top", -fill=>'x');
    my $bt_frame = $mmtop->Frame( -width   => 30,
				  -fg      => $tmp_fg,
				  -bg      => $tmp_bg)->pack(-side=>"bottom", -fill=>'x');

    $mm_char_ent = $tp_frame->Entry( -width=>10 )->pack(-side   => 'left',
							-fill   => 'x',
							-expand => 1,
							-pady   => 2);
    my $host_label = $tp_frame->Label ( -text       => "@",
  					-justify    => 'left',
  					-width      => 1,
  					-background => $tmp_bg,
  					-foreground => $tmp_fg )->pack(-side=>"left");
    $mm_host_ent = $tp_frame->Entry( -width=>19 )->pack(-side   => 'left',
							-fill   => 'x',
							-expand => 1,
							-pady   => 2);
    my $port_label = $tp_frame->Label ( -text       => ":",
  					-justify    => 'left',
  					-width      => 1,
  					-background => $tmp_bg,
  					-foreground => $tmp_fg )->pack(-side=>"left");
    $mm_port_ent = $tp_frame->Entry( -width           => 7,
				     -validate        => 'focus',
				     -validatecommand => sub { $mm_go_but->configure( -state => 'normal' ) }
				     )->pack(-side   => 'left',
					     -fill   => 'x',
					     -expand => 1,
					     -pady   => 2);
    $mm_go_but = $bt_frame->Button( -text    => 'Connect',
				    -fg      => $tmp_fg,
				    -bg      => $tmp_bg,
				    -font    => $tmp_fn,
				    -state   => 'disabled',
				    -command => sub { mud_select(0) })->pack(-side=>'left', -fill=>'both');
    $mudmenu = $md_frame->Scrolled("HList",
				-width      => 30,
				-height     => 4,
#					   -bg         => 'white', #$options{'outbg'},
				-fg         => 'black', #$options{'outfg'},
				-font       => $tmp_fn,
				-relief     => 'sunken',
				-drawbranch => 0,
				-scrollbars => 'osoe',
				-selectmode => 'single',
				-browsecmd  => \&fill_mm_fields,
				-command    => \&mud_select,
				)->pack(-side   => 'left',
					-fill   => 'both',
					-expand => 1);
    my $quit = $bt_frame->Button(-text    => 'Quit', 
				 -fg      => $tmp_fg,
				 -bg      => $tmp_bg,
				 -font    => $tmp_fn,
				 -command => sub { dokill() } )->pack(-side=>'right', -fill=>'both');

#    $mmtop->bind('all', '<Tab>', '');
#    $mm_char_ent->bind("<Tab>", sub { $mm_host_ent->focus });
#    $mm_char_ent->bind("<Return>", sub { $mm_host_ent->focus });
#    $mm_host_ent->bind("<Tab>", sub { $mm_port_ent->focus });
#    $mm_host_ent->bind("<Return>", sub { $mm_port_ent->focus });
#    $mm_port_ent->bind("<Tab>", sub { $mm_go_but->focus });
#    $mm_host_ent->bind("<Return>", sub { mud_select(0) });


# X mousewheel
    $mmtop->bind('all', "<4>", sub{ $mudmenu->yview('scroll', $mudmenu->cget(-height)*-.5, 'units')}); 
    $mmtop->bind('all', "<5>", sub{ $mudmenu->yview('scroll', $mudmenu->cget(-height)*.5, 'units')});    
# Windows mousewheel
    $mmtop->bind('all', '<MouseWheel>',
		   [ sub { $mudmenu->yview('scroll',-($_[1]/120)*3,'units') },
		     Tk::Ev("D")]);

    fill_mudmenu();
}

my %new_bindings;
my %options;

if ($config_index == -1) {
    # no match for the character
} else {
    setup_vars();

}

my $color_output = "ROTextANSIColor";

# check to see if these exist. If not, then use Tk::ROText

eval ("use Tk::ROTextANSIColor");
if ($@) {
    use Tk::ROText;
    $color_output = "ROText";
    print STDERR "No ANSI color capabilities.\n";
}

srand ( time() ^ ($$ + ($$<< 15)) );

build_de_color();

#make_main_window();

if (!$fill_mudmenu) {
    init_window();
# give 2 seconds for the windows to open before making the connections
    $mw->after(2000, sub { do_MUD() });
}



MainLoop;

sub setup_vars {
    $height = 24 unless ($height && $height >= 1);
    $width = 80 unless ($width && $height >= 1);

    $bg = "#7a7abb" unless $bg;
    $fg = "#151769" unless $fg;
    $fn = "lucidasanstypewriter-12" unless $fn;

    %new_bindings = %def_bindings;

    %options = (normal => "$fg",
		input  => 'blue',
		mybg   => "#7a7abb",
		outbg  => "$bg",
		outfg  => "$fg",
		outfn  => "$fn",
		myfg   => '#151769');          # colors for the GUI windows

    $quiet_timer = 0 unless $quiet_timer;
    $timer_var = 0;
    $ns_var = 0;
    $timer_delay = $timer_delay * 1000 if $timer_delay;    # convert from seconds to milleseconds
# issuing timed commands faster than 1 second is probably bad
    $timer_delay = 600000 if (!$timer_delay || $timer_delay < 2000);
}

##
## read the configuration file
##
sub read_config {
    my ($file) = @_;

    use XML::Simple;

    my $xs1 = XML::Simple->new();

    if (-e $file) {
	
	$config_ref = eval { $xs1->XMLin($file) };
	($cr_var = 1 && warn "Corrupt configuration file.  Config saving disabled.\n") if $@;
    }
}

## 
## fill the configuration variables from $config_ref
##
sub fill_config {
    my $c_ref;
    my $ref_type = ref $config_ref->{mud};

    if ($ref_type eq "ARRAY") {
	$c_ref = $config_ref;
    } elsif ($ref_type eq "HASH") {
	push (@{$c_ref->{mud}}, $config_ref->{mud});
    } else {
	return -1;
    }

    # read the config reference
    for ( my $i = 0; $i <= $#{$c_ref->{mud}}; $i++ ) {
	# if the host and port for this entry match the host and port specified
	if ($c_ref->{mud}->[$i]->{host} eq $h &&
	    $c_ref->{mud}->[$i]->{port} eq $p) {
	    # if $char is defined, and this entry's char attribute matches
	    if ($char && ($c_ref->{mud}->[$i]->{char} eq $char)) {
		$passwd = $c_ref->{mud}->[$i]->{password};
	    } else {
		next;
	    }

	    $height      = $c_ref->{mud}->[$i]->{height};
	    $width       = $c_ref->{mud}->[$i]->{width};
	    $bg          = $c_ref->{mud}->[$i]->{background};
	    $fg          = $c_ref->{mud}->[$i]->{foreground};
	    $fn          = $c_ref->{mud}->[$i]->{font};
	    $timer_delay = $c_ref->{mud}->[$i]->{timervalue};

	    @timer_actions = @{$c_ref->{mud}->[$i]->{timeraction}};

# user-defined key bindings
  	    my ($nested_tag0, $nested_tag1);
  	    my $key;
	    my $value;

  	    ($nested_tag0, $nested_tag1) = @{$nesting_config_tags{shortcut}};
  	    my $ref_type = ref $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag0};
  	    if ($ref_type eq "ARRAY") {
  		# This assumes that the config file is not foo
  		for ( my $foo = 0; $foo <= $#{$c_ref->{mud}->[$i]->{shortcut}->{$nested_tag0}}; $foo++) {
  		    $key = $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag0}->[$foo];
  		    if (!(ref $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag1}->[$foo])) {
  			$def_bindings{"<$key>"} = $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag1}->[$foo];
  		    }
  		}
  	    } else {
  		$key = $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag0};
  		$def_bindings{"<$key>"} = $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag1};
  	    }

# auto-responses
  	    ($nested_tag0, $nested_tag1) = @{$nesting_config_tags{autoresp}};
  	    $ref_type = ref $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0};
  	    if ($ref_type eq "ARRAY") {
  		# This assumes that the config file is not foo
  		for ( my $foo = 0; $foo <= $#{$c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0}}; $foo++) {
  		    $key = $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0}->[$foo];
  		    if (!(ref $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1}->[$foo])) {
			$value = $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1}->[$foo];
			$value =~ s/\\n/\n/g;
  			$auto_responses{"$key"} = "$value";
			push @auto_resp_keys, $key;
  		    }
  		}
  	    } else {
  		$key = $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0};
		$value = $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1};
		$auto_responses{"$key"} = "$value";
  	    }

	    return $i;
		
	}
    }

    return -1;

}

##
## Fill $mudmenu from config_ref
##

sub fill_mudmenu {

    $mudmenu->delete( "all" );

    my ($tmp_h, $tmp_p, $tmp_c); 

    my $c_ref;
    my $ref_type = ref $config_ref->{mud};

    if ($ref_type eq "ARRAY") {
	$c_ref = $config_ref;
    } elsif ($ref_type eq "HASH") {
	push (@{$c_ref->{mud}}, $config_ref->{mud});
    } else {
	$mudmenu->add( 0,
		       -text => "You have no host list.",
		       -data => 0,
		       -state=> 'disabled');
	return;
    }

    for ( my $i = 0; $i <= $#{$c_ref->{mud}}; $i++ ) {
	$tmp_h = $c_ref->{mud}->[$i]->{host};
	$tmp_p = $c_ref->{mud}->[$i]->{port};
	$tmp_c = $c_ref->{mud}->[$i]->{char};
	
	$tmp_c = "unknown" unless $tmp_c;
	
	$mudmenu->add( $i + 1,
		       -text => "$tmp_c\@$tmp_h:$tmp_p",
		       -data => $i);
    }

}

sub fill_mm_fields {
    my ($path) = @_;

    $mm_go_but->configure( -state   => 'normal',
			   -command => sub { mud_select($path) } );

    my $mudkey = "";
    $mudkey = $mudmenu->entrycget($path, -text) if ($path);

    my ($c, $tmp_hp) = split '@', $mudkey;

    my ($h, $p) = split ':', $tmp_hp;

    # clear the current contents.
    $mm_char_ent->delete(0, 'end');
    $mm_host_ent->delete(0, 'end');
    $mm_port_ent->delete(0, 'end');

    # insert the new values
    $mm_char_ent->insert('end', $c);
    $mm_host_ent->insert('end', $h);
    $mm_port_ent->insert('end', $p);
}

sub mud_select {
    my $path = $_[0];

# The right way to do this is to use the values in $mm_(char|host|port)_ent

    $char = $mm_char_ent->get();
    $h    = $mm_host_ent->get();
    $p    = $mm_port_ent->get();

    $config_index = fill_config();

    setup_vars();

    init_window();
# give 2 seconds for the windows to open before making the connections
    $mw->after(2000, sub { do_MUD() });

    # destroy the selection window
    $mmtop->destroy;

}

##
## now we want to write the configuration file
##

sub write_conf {
    
    use XML::Writer;
    use IO;

    my $skip_read = 0;

    read_config($config_file);

    my $c_ref;
    my $ref_type = ref $config_ref->{mud};

    if ($ref_type eq "ARRAY") {
	$c_ref = $config_ref;
    } elsif ($ref_type eq "HASH") {
	push (@{$c_ref->{mud}}, $config_ref->{mud});
    } else {
	$skip_read = 1;
#	return;
    }

##
## We aren't doing the right thing when the character isn't already in the config file.
##
    my $i = 0;
    # read the config reference
    for ( $i = 0; $i <= $#{$c_ref->{mud}}; $i++ ) {
	# if the host and port for this entry match the host and port specified
	if ($c_ref->{mud}->[$i]->{host} eq $h &&
	    $c_ref->{mud}->[$i]->{port} eq $p) {

	    if (defined $c_ref->{mud}->[$i]->{char}) {
		# if this configuration entry has a character defined
		if ($char) {
		    # if the user defined a character
		    if ($c_ref->{mud}->[$i]->{char} eq $char) {
			# if they match, save and move on to the writing
			last;
		    } else {
			# if they don't match, skip to the next config entry
			next;
		    }
		} else {
		    # if the character hasn't defined a character, skip to the next entry
		    next;
		}
	    } else {
		# the config entry is more general
		if ($char) {
		    # the user has defined a character, so skip to the next
		    next;
		}
		last;
	    }

	}
    }

    save_config($i);

    my $output = new IO::File(">$config_file");

    my $writer = XML::Writer->new(OUTPUT => $output, DATA_MODE => 1, DATA_INDENT => 1);

    $writer->xmlDecl();
    $writer->startTag('mulmo', 'version' => "$version");

    for ( my $i = 0; $i <= $#{$config_ref->{mud}}; $i++ ) {
	$writer->startTag('mud', 
			  'char' => $config_ref->{mud}->[$i]->{char},
			  'host' => $config_ref->{mud}->[$i]->{host},
			  'port' => $config_ref->{mud}->[$i]->{port});

	foreach my $strings (@string_config_tags) {
	    if (defined $config_ref->{mud}->[$i]->{$strings}) {
		$writer->dataElement("$strings", $config_ref->{mud}->[$i]->{$strings});
	    }
	}

	foreach my $strings (@array_config_tags) {
	    foreach my $time_index (@{$config_ref->{mud}->[$i]->{$strings}}) {
		$writer->dataElement("$strings", $time_index);
	    }
	}

	foreach my $nester (keys %nesting_config_tags) {
	    $writer->startTag($nester);

	    my ($nested_tag0, $nested_tag1) = @{$nesting_config_tags{$nester}};
	    my $ref_type = ref $config_ref->{mud}->[$i]->{$nester}->{$nested_tag0};
	    if ($ref_type eq "ARRAY") {

		# This assumes that the config reference is not foo
		for ( my $foo = 0; $foo <= $#{$config_ref->{mud}->[$i]->{$nester}->{$nested_tag0}}; $foo++) {
		    $writer->dataElement("$nested_tag0", 
					 $config_ref->{mud}->[$i]->{$nester}->{$nested_tag0}->[$foo]);
  		    if (!(ref $config_ref->{mud}->[$i]->{shortcut}->{$nested_tag1}->[$foo])) {
			$writer->dataElement("$nested_tag1", 
					     $config_ref->{mud}->[$i]->{$nester}->{$nested_tag1}->[$foo]);
		    } else {
			$writer->dataElement("$nested_tag1", "");
		    }
		}
	    } else {
		$writer->dataElement("$nested_tag0", $config_ref->{mud}->[$i]->{$nester}->{$nested_tag0});
		$writer->dataElement("$nested_tag1", $config_ref->{mud}->[$i]->{$nester}->{$nested_tag1});
	    }


	    $writer->endTag($nester);
	}

	$writer->endTag('mud');
    }

    $writer->endTag('mulmo');

    $writer->end();

}

##
## Save the configuration into $config_ref
##

sub save_config {
    my ($i) = @_;

    my $c_ref;
    my $ref_type = ref $config_ref->{mud};

    if ($ref_type eq "ARRAY") {
	$c_ref = $config_ref;
    } elsif ($ref_type eq "HASH") {
	push (@{$c_ref->{mud}}, $config_ref->{mud});
    } else {
	# it's not an array, and it's not a HASH.  That probably means that it isn't
	#    anything
#	return;
    }

    if (!defined $c_ref->{mud}->[$i]) {
	# we have a new entry
	$c_ref->{mud}->[$i]->{host} = $h;
	$c_ref->{mud}->[$i]->{port} = $p;
	$c_ref->{mud}->[$i]->{char} = $char if $char;
    }

# if $char is defined, and this entry's char attribute matches
    if ($char && defined $c_ref->{mud}->[$i]->{char} && ($c_ref->{mud}->[$i]->{char} eq $char)) {
	$c_ref->{mud}->[$i]->{password} = $passwd;
    }

    $c_ref->{mud}->[$i]->{height}     = $height;
    $c_ref->{mud}->[$i]->{width}      = $width;
    $c_ref->{mud}->[$i]->{background} = $bg;
    $c_ref->{mud}->[$i]->{foreground} = $fg;
    $c_ref->{mud}->[$i]->{font}       = $fn;
    $c_ref->{mud}->[$i]->{timervalue} = int ($timer_delay/1000);

    @{$c_ref->{mud}->[$i]->{timeraction}} = @timer_actions;

# user-defined key bindings
    my ($nested_tag0, $nested_tag1);
    my $key;
    my $value;
    my @key;
    my @binding;

    foreach $key (keys %new_bindings) {
	push @key, $key;
	push @binding, $new_bindings{$key};
    }

    ($nested_tag0, $nested_tag1) = @{$nesting_config_tags{shortcut}};

    if ($#key) {
	for ( my $foo = 0; $foo <= $#key; $foo++) {
	    $key[$foo] =~ s/<//g;
	    $key[$foo] =~ s/>//g;
	    $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag0}->[$foo] = $key[$foo];
	    $c_ref->{mud}->[$i]->{shortcut}->{$nested_tag1}->[$foo] = $binding[$foo];
	}
    } else {
	$c_ref->{mud}->[$i]->{shortcut}->{$nested_tag0} = $key[0];
	$c_ref->{mud}->[$i]->{shortcut}->{$nested_tag1} = $binding[0];
    }

    @key = ();
    @binding = ();
# auto-responses
    foreach $key (@auto_resp_keys) {
	push @key, $key;
	push @binding, $auto_responses{$key};
    }

    ($nested_tag0, $nested_tag1) = @{$nesting_config_tags{autoresp}};

    if (ref $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0} eq "ARRAY") {
	@{$c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0}} = ();
    }
    if (ref $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1} eq "ARRAY") {
	@{$c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1}} = ();
    }

    if ($#key) {
	for ( my $foo = 0; $foo <= $#key; $foo++) {
	    $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0}->[$foo] = $key[$foo];
	    $c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1}->[$foo] = $binding[$foo];
	}
    } else {
	$c_ref->{mud}->[$i]->{autoresp}->{$nested_tag0} = $key[0];
	$c_ref->{mud}->[$i]->{autoresp}->{$nested_tag1} = $binding[0];
    }

    $config_ref = $c_ref;

    return;
}

##
## initialize the window
##

sub make_main_window {
    $mw=MainWindow->new( -title      => "MuLMo",
			 -background => $options{'mybg'},
			 );
}

sub init_window { 
    my $menu_width = 12;

    if ($char) {
 	$mw=MainWindow->new( -title      => "$char\@$h",
			     -background => $options{'mybg'},
			     );
    } else {
 	$mw=MainWindow->new( -title      => "$h",
			     -background => $options{'mybg'},
			     );
    }

    $mw->bind('all', '<Tab>', '');                  # unbind "Tab" everywhere

    my ($lframe) = $mw->Frame( -background => $options{'mybg'} )->pack(-side => 'left',
								       -fill => 'y');    

    my ($rframe) = $mw->Frame( -background => $options{'mybg'} )->pack(-side => 'right',
								       -fill => 'y');    


# input field
    $command = $lframe->Entry()->pack(-side   => 'bottom',
				      -fill   => 'x',
				      -expand => 1,
				      -pady   => 2);
    $command->bind("<F9>",        \&start_reading );    
    $command->bind("<Return>",    \&Command_Return);
    $command->bind("<Control-u>", \&clearcommand);
    $command->bind("<Control-p>", \&up_history_list );
    $command->bind("<Control-n>", \&down_history_list );
    $command->bind("<Meta-p>",    \&grep_up_history_list );
    $command->bind("<Meta-n>",    \&grep_down_history_list );
    $command->bind("<Tab>",       \&insert_tab );
# X mousewheel
    $command->bind("<4>", sub{ $output_window->yview('scroll', $output_window->cget(-height)*-.5, 'units')}); 
    $command->bind("<5>", sub{ $output_window->yview('scroll', $output_window->cget(-height)*.5, 'units')});    
# Windows mousewheel
    $command->bind('<MouseWheel>',
		   [ sub { $output_window->yview('scroll',-($_[1]/120)*3,'units') },
		     Tk::Ev("D")]);



# setup the outout window
    $output_window = $lframe->Scrolled($color_output,
				       -width      => $width,
				       -height     => $height,
				       -bg         => $options{'outbg'},
				       -fg         => $options{'outfg'},
				       -font       => $fn,
				       -wrap       => 'word',
				       -relief     => 'sunken',
				       -scrollbars => 'osoe',
				       )->pack(-side   => 'top',
					       -fill   => 'both',
					       -expand => 1);
    
# X mousewheel
    $output_window->bind("<4>", sub{ $output_window->yview('scroll', $output_window->cget(-height)*-.5, 'units')}); 
    $output_window->bind("<5>", sub{ $output_window->yview('scroll', $output_window->cget(-height)*.5, 'units')});    
# Windows mousewheel
    $output_window->bind('<MouseWheel>',
		   [ sub { $output_window->yview('scroll',-($_[1]/120)*3,'units') },
		     Tk::Ev("D")]);

    #setup the version label
    my $vlabel = $rframe->Label( -text    => "MuLMO v. $version",
				 -justify => 'center',
				 -font    => $fn,
				 -fg      => $options{'myfg'},
				 -bg      => $options{'mybg'} )->pack( -side => 'bottom' );

    $command->focus;

    #setup the quit button
    $quit = $rframe->Button(-text    => 'Quit', 
			    -width   => $menu_width,
			    -fg      => $options{'myfg'},
			    -bg      => $options{'mybg'},
			    -font    => $fn,
			    -command => sub { dokill() } )->pack(-side=>'bottom');

    #setup the reconnect button
    $recon = $rframe->Button(-text    => 'Connect', 
			     -width   => $menu_width,
			     -fg      => $options{'myfg'},
			     -bg      => $options{'mybg'},
			     -state   => 'disabled',
			     -font    => $fn,
			     -command => sub { do_MUD() } )->pack(-side=>'bottom');

    #setup the "save" button
    $savebut = $rframe->Button(-text    => 'Save Setup', 
			       -width   => $menu_width,
			       -fg      => $options{'myfg'},
			       -bg      => $options{'mybg'},
#			       -state   => 'disabled',
			       -font    => $fn,
			       -command => sub { write_conf() } )->pack(-side=>'bottom');

    $savebut->configure( -state => 'disabled' ) if $cr_var;

    #setup the color configure button
    $colorbut = $rframe->Button(-text    => 'Colors & font', 
				   -width   => $menu_width,
				   -fg      => $options{'myfg'},
				   -bg      => $options{'mybg'},
				   -font    => $fn,
				   -command => sub { do_color_config() } )->pack(-side=>'top');

    #setup the auto-response configure button
    $autorespbut = $rframe->Button(-text    => 'Auto-responder', 
				   -width   => $menu_width,
				   -fg      => $options{'myfg'},
				   -bg      => $options{'mybg'},
				   -font    => $fn,
				   -command => sub { do_auto_resp_config() } )->pack(-side=>'top');

    $noauto = $rframe->Checkbutton( -variable => \$na_var,
				    -text     => 'No auto-resp', 
				    -fg       => $options{'myfg'},
				    -bg       => $options{'mybg'},
				    -font     => $fn,
				    -command  => sub {  })->pack( -side => 'top',
								  -fill => 'x');

    #setup the binding configure button
    $bindbut = $rframe->Button(-text    => 'Short-cuts', 
			       -width   => $menu_width,
			       -fg      => $options{'myfg'},
			       -bg      => $options{'mybg'},
			       -font    => $fn,
			       -command => sub { do_bind_config() } )->pack(-side=>'top');

    # setup the timer entry
    my ($tframe) = $rframe->Frame( -background  => $options{'mybg'}, 
				   -width       => $menu_width,
				   -borderwidth => '2',
				   -relief      => 'groove')->pack(-side => 'top',
								   -fill => 'x');    

    my ($ttframe) = $tframe->Frame( -background  => $options{'mybg'}, 
				    -width       => $menu_width,
				    -borderwidth => '2',
				    -relief      => 'flat')->pack(-side => 'top',
								    -fill => 'y');    
    my ($timer_label) = $ttframe->Label( -text    => "Timer",
					 -justify => 'left',
					 -width   => ($menu_width * 2 / 3),
					 -font    => $fn,
					 -fg      => $options{'myfg'},
					 -bg      => $options{'mybg'} )->pack( -side => 'left',
									       -fill => 'x');

    #setup the timer configure button
    $timebut = $ttframe->Button(-text    => "Conf", 
				-width   => ($menu_width / 3),
				-justify => 'right',
				-fg      => $options{'myfg'},
				-bg      => $options{'mybg'},
				-font    => $fn,
				-padx    => 1,
				-pady    => 1,
				-command => sub { do_timer_config() } )->pack( -side => 'right',
									      -fill => 'x');

    $timer_ent = $tframe->Entry( -width => 5 )->pack(-side   => 'right',
						     -fill   => 'x',
						     -expand => 1,
						     -pady   => 2);
    $timer_ent->insert('end', $timer_delay/1000);
    $timer_ent->bind("<Return>", sub { change_delay() });

    $timer = $tframe->Checkbutton( -variable => \$timer_var,
				    -text     => 'Off', 
				    -fg       => $options{'myfg'},
				    -bg       => $options{'mybg'},
				    -font     => $fn,
				    -command  => sub { start_timer();
						       input_stuff("\n", 'input'); })->pack( -side => 'left',
									       -fill => 'x');

    # setup the cheat-sheet entry
    my ($mframe) = $rframe->Frame( -background  => $options{'mybg'}, 
				   -width       => $menu_width,
				   -borderwidth => '2',
				   -relief      => 'groove')->pack(-side => 'top',
								   -fill => 'x');    
    #setup the history label
    my $huplabel = $mframe->Label( -text    => "History",
				   -justify => 'left',
				   -font    => $fn,
				   -fg      => $options{'myfg'},
				   -bg      => $options{'mybg'} )->pack( -side => 'left' );
    #setup the history up button
    my $hupbut = $mframe->Button( -text    => "Up",
				  -width   => 5,
				  -justify => 'center',
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -padx    => 0,
				  -font    => $fn,
				  -command => sub { up_history_list() } )->pack( -side => 'top' );

    #setup the history down button
    my $hdownbut = $mframe->Button( -text    => "Down",
				    -width   => 5,
				    -justify => 'center',
				    -fg      => $options{'myfg'},
				    -bg      => $options{'mybg'},
				    -padx    => 0,
				    -font    => $fn,
				    -command => sub { down_history_list() } )->pack( -side => 'bottom' );

    $noscroll = $rframe->Checkbutton( -variable => \$ns_var,
				       -text     => 'No scroll', 
				       -fg       => $options{'myfg'},
				       -bg       => $options{'mybg'},
				       -font     => $fn,
				       -command  => sub {  })->pack( -side => 'top',
								     -fill => 'x');

    make_owin_tags();
}

sub make_owin_tags {
    foreach (keys %options) {
	$output_window->tagConfigure( $_, -foreground=>$options{$_} ) if ($_ ne "outfn");
    }
}

sub do_MUD {

    output_stuff("Press the F9 key to start output.\n");
    if (make_connection($h, $p)) {

	$select = IO::Select->new();

	$select->add(*$s);

	read_MUD();

	$command->eventGenerate("<F9>") unless $can_id;
	$command->after(1000, \&start_reading) unless $can_id;

	# log in the character
	if (defined $char && defined $passwd && length $char && length $passwd) {
	    login_char($char, $passwd);
	}

	$recon->configure( -state => 'disabled' );
    } else {
	output_stuff("Unable to connect to $h port $p.\n");
    }

}

sub Command_Return {
    my ($foo, $bar);
    my ($text) = $command->get();
    if ($text) {
	$command->delete(0, 'end');
	input_stuff("$text", 'normal');
    } else {
	input_stuff("", 'normal');
    }
}

sub dokill {
    exit 0;
}

sub build_de_color {
    my $counter = 0;
    my $color = "";
    my @mod_codes = ('clear',
#		     'dark',
		     'bold',
		     'underscore',
		     'blink',
		     'reverse',
#		     'concealed',
		     );

    my @color_codes = ('black',
		       'red',
		       'green',
		       'yellow',
		       'blue',
		       'magenta',
		       'cyan',
		       'white',
		       );
    ## Get rid of color

    $de_color_string = "(";

    foreach (@mod_codes) {
	$de_color_string .= "(" . color ( $_ ) . ")|";
    }

    foreach $color (@color_codes) {
	$de_color_string .= "(" . color ( $color ) . ")|";
	foreach (@mod_codes) {
	    $de_color_string .= "(" . color ( "$_ $color" ) . ")|";
	    $de_color_string .= "(" . color ( "$_ on_$color" ) . ")|";
	}
	    
	
	$de_color_string .= "(" . color ( "on_$color" ) . ")";
	# Unless we are the very last color....
	if ($counter < $#color_codes) {
	    $de_color_string .= "|";
	}
	$counter++;
    }

    $de_color_string .= ")";

    $de_color_string =~ s/\[/\\[/g;
}

sub make_connection {
    my ($h, $p) = @_;

    $s = IO::Socket::INET->new( PeerAddr => "$h",
				PeerPort => "$p",
				Proto    => "tcp");

    if (defined $s) {
	$s->autoflush(1);
	return $s;
    } else {
	connection_died();
	return 0;
    }
}

sub login_char {
    my ($c, $p) = @_;
    
    silent_input_stuff("$c");
    output_stuff("Logging in as \"$c.\"\n");
    silent_input_stuff("$p");
#      $mw->after(1000);
#      input_stuff("\n");
#      $mw->after(1000);
#      input_stuff("\n");
#      $mw->after(1000);
#      input_stuff("\n");
#      input_stuff("who\n");
}

##
## read from the socket
##

sub read_MUD {
    my ($i) = (0);
    my @ready;

    if (@ready = $select->can_read(0)) {
    # input waiting on the filehandles in @ready

	foreach $i (@ready) {
	    my $res = 0;
	    my $fub = "";

	    $res = sysread $i, $fub, 2048;

	    if (defined($res) && $res > 0) {
		# We should use Net::Telnet and either strip out or properly interpret
		#    telnet commands
		$fub =~ tr/\r\xff\xf9//d;
#		$fub =~ tr/\xff\xf9//d;

		my $bell_count = ($fub =~ s/\a//g);
		
		for (; $bell_count > 0; $bell_count--) {$output_window->bell;}

		my $last_char = chop $fub;
		$fub .= $last_char;
		my @bar = split /\n/, $fub;
		my $counter = 0;
		foreach (my @foo = @bar) {
		    if (++$counter < scalar(@foo)) {
			output_stuff("$_\n");
		    } else {
			if ($last_char eq "\n") {
			    $_ .= $last_char;
			}
			output_stuff("$_");
		    }
		    auto_MUD("$_") if ($auto_MUD && !$na_var);
		}
	    } else {
		connection_died();
	    }
	}
    }
}
	
##
## input and output functions
##

sub input_stuff {
    my ($text, $color) = @_;
    print $s "$text\n";
    if ($color) {
	output_stuff("$text\n", $color);
    } else {
	output_stuff("$text\n");
    }
    $text =~ s/\n//;
    if ($text) {
	push @command_history, $text;
	$ch_index = $#command_history;
    }
}

sub silent_input_stuff {
    my ($text) = @_;
    print $s "$text\n";
}

sub output_stuff {
    my ($text, $color) = @_;
    if ($color) {
	$output_window->insert('end', "$text", $color);
    } else {
	$output_window->insert('end', "$text");
    }
    if (!$ns_var) {
	$output_window->see('end');
    }
    $output_window->update;
}

##
## Anti-idleness
##

sub timed_actions {
    my @subacts = @timer_actions;

    my $subact = $quiet_timer ? "" : @subacts[int (rand ($#subacts + 1))];

    input_stuff("$subact\n", 'input');
}

sub start_timer {
    $timer->configure(-text=>"On ", -command => sub { stop_timer() });
    if (!$timer_var) {
	$timer->toggle;
    }
    $timer->update;
    $timer_id = $timer->repeat($timer_delay, \&timed_actions);
}

sub stop_timer {
    $timer->afterCancel($timer_id);
    $timer->configure(-text=>"Off", -command => sub { start_timer() });
    if ($timer_var) {
	$timer->toggle;
    }
    $timer->update;
    $timer_id = 0;
}

sub change_delay {
    my ($inval) = $timer_ent->get();
    if ($inval =~ /^\d+$/) {
	$timer_delay = ( $inval * 1000 );
	if ($timer_var == 1) {
	    stop_timer();
	}
	start_timer();
    } else {
	$timer_ent->delete('0.0', 'end');
	$timer_ent->insert('end', $timer_delay / 1000);
    }
    $command->focus;
}

sub start_reading {
    $can_id = $command->repeat($read_freq, sub { read_MUD() });
}

sub connection_died {
    $command->afterCancel($can_id);
    stop_timer();
    $can_id = 0;
    $recon->configure( -state => 'normal' );
}

sub clearcommand {
    $command->delete(0,'end');
}

sub up_history_list {
    my ($new_comm);

    $ch_index-- unless ($ch_index == 0 || $#command_history > $ch_count);
    $new_comm = $command_history[$ch_index];
    $command->delete(0, 'end');
    $command->insert('end', "$new_comm");
    $ch_count = $#command_history;
}

sub down_history_list {
    my ($new_comm);

    $ch_index++ unless ($ch_index == $#command_history);
    $new_comm = $command_history[$ch_index];
    $command->delete(0, 'end');
    $command->insert('end', "$new_comm");
}

sub grep_up_history_list {
    my ($new_comm);

    $ch_index-- unless ($ch_index == 0 || $#command_history > $ch_count);
    $new_comm = $command_history[$ch_index];
    $command->delete(0, 'end');
    $command->insert('end', "$new_comm");
    $ch_count = $#command_history;
}

sub grep_down_history_list {
    my ($new_comm);
    my ($text) = $command->get();

    if ($text) {
#	@command_grep = grep "$text" 
    }

    $ch_index++ unless ($ch_index == $#command_history);
    $new_comm = $command_history[$ch_index];
    $command->delete(0, 'end');
    $command->insert('end', "$new_comm");
}

sub insert_tab {
    $command->insert('end', "\t");
}

##
## Make the top level window to do the color and font configuration
##

sub do_color_config {
    my $config_win = $mw->Toplevel( -background => $options{'mybg'},
				    -title      => "Color and font configuration",
				    -foreground => $options{'myfg'});
    my $config_label = $config_win->Label ( -text       => "Color and font configuration",
					    -background => $options{'mybg'},
					    -foreground => $options{'myfg'} )->pack(-side=>"top");
    my $fg_frame = $config_win->Frame( -width=>40,
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $fg_label = $fg_frame->Label ( -text       => "Foreground",
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $fg_ent = $fg_frame->Entry( -width => 13 )->pack(-side   => 'right',
						    -fill   => 'x',
						    -expand => 1,
						    -pady   => 2);
    $fg_ent->insert('end', $fg);
    $fg_ent->bind("<Return>", sub { change_fg( $fg_ent->get() ) });

    my $bg_frame = $config_win->Frame( -width=>40,
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $bg_label = $bg_frame->Label ( -text       => "Background",
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $bg_ent = $bg_frame->Entry( -width => 13 )->pack(-side   => 'right',
						    -fill   => 'x',
						    -expand => 1,
						    -pady   => 2);
    $bg_ent->insert('end', $bg);
    $bg_ent->bind("<Return>", sub { change_bg( $bg_ent->get() ) });

    my $fn_frame = $config_win->Frame( -width=>40,
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $fn_label = $fn_frame->Label ( -text       => "Font",
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $fn_ent = $fn_frame->Entry( -width => 13 )->pack(-side   => 'right',
						    -fill   => 'x',
						    -expand => 1,
						    -pady   => 2);
    $fn_ent->insert('end', $fn);
    $fn_ent->bind("<Return>", sub { change_fn( $fn_ent->get() ) });

    my $bt_frame = $config_win->Frame( -width=>40,
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'})->pack(-side=>"top", -fill=>'x');
    my $set_button = $bt_frame->Button(-text    => 'Set', 
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'},
				       -font    => $fn,
				       -command => sub { change_fg( $fg_ent->get() );
							 change_bg( $bg_ent->get() );
							 change_fn( $fn_ent->get() );
						     } 
				       )->pack(-side=>'left');
    my $reset = $bt_frame->Button(-text    => 'Reset', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $fg_ent->delete('0.0', 'end');
						    $bg_ent->delete('0.0', 'end');
						    $fn_ent->delete('0.0', 'end');
						    
						    # fill everything
						    $fg_ent->insert('end', "$options{'outfg'}");
						    $bg_ent->insert('end', "$options{'outbg'}");
						    $fn_ent->insert('end', "$options{'outfn'}");

						    # set everything
						    change_fg( $options{'outfg'} );
						    change_bg( $options{'outbg'} );
						    change_fn( $options{'outfn'} );
						} 
				  )->pack(-side=>'left');
    my $close = $bt_frame->Button(-text    => 'Close', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $config_win->destroy } )->pack(-side=>'right');

}

sub change_fg {
    my ($new_fg) = @_;

    $output_window->configure( -fg => $new_fg );
    $output_window->update;
    $options{'normal'} = $new_fg;
    make_owin_tags();
    $fg = $new_fg;
}
sub change_bg {
    my ($new_bg) = @_;

    $output_window->configure( -bg => $new_bg );
    $output_window->update;
    $bg = $new_bg;
}
sub change_fn {
    my ($new_fn) = @_;

    $output_window->configure( -font => $new_fn );
    $output_window->update;
    $fn = $new_fn;
}

##
## Make the top level window to do the shortcuts configuration
##

sub do_bind_config {
    my $label_width = 12;
    my $entry_width = 13;

    my $bind_win = $mw->Toplevel( -title      => "Shortcut bindings",
				  -background => $options{'mybg'},
				  -foreground => $options{'myfg'});
    my $bind_label = $bind_win->Label ( -text       => "Shortcut bindings",
					-background => $options{'mybg'},
					-foreground => $options{'myfg'} )->pack(-side=>"top");

    ## unused control-letters: c d g l o q r s v x z

    # make control-c
    my $cc_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cc_label = $cc_frame->Label ( -text       => "Control-c",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cc_ent = $cc_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cc_ent->insert('end', "$new_bindings{'<Control-c>'}");
    $cc_ent->bind("<Return>", sub { do_command_bind( "<Control-c>", $cc_ent->get() ) });

    # make control-d
    my $cd_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cd_label = $cd_frame->Label ( -text       => "Control-d",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cd_ent = $cd_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cd_ent->insert('end', "$new_bindings{'<Control-d>'}");
    $cd_ent->bind("<Return>", sub { do_command_bind( "<Control-d>", $cd_ent->get() ) } );

    # make control-g
    my $cg_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cg_label = $cg_frame->Label ( -text       => "Control-g",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cg_ent = $cg_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cg_ent->insert('end', "$new_bindings{'<Control-g>'}");
    $cg_ent->bind("<Return>", sub { do_command_bind( "<Control-g>", $cg_ent->get() ) });

    # make control-l
    my $cl_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cl_label = $cl_frame->Label ( -text       => "Control-l",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cl_ent = $cl_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cl_ent->insert('end', "$new_bindings{'<Control-l>'}");
    $cl_ent->bind("<Return>", sub { do_command_bind( "<Control-l>", $cl_ent->get() ) });

    # make control-o
    my $co_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $co_label = $co_frame->Label ( -text       => "Control-o",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $co_ent = $co_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $co_ent->insert('end', "$new_bindings{'<Control-o>'}");
    $co_ent->bind("<Return>", sub { do_command_bind( "<Control-o>", $co_ent->get() ) });

    # make control-q
    my $cq_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cq_label = $cq_frame->Label ( -text       => "Control-q",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cq_ent = $cq_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cq_ent->insert('end', "$new_bindings{'<Control-q>'}");
    $cq_ent->bind("<Return>", sub { do_command_bind( "<Control-q>", $cq_ent->get() ) });

    # make control-r
    my $cr_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cr_label = $cr_frame->Label ( -text       => "Control-r",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cr_ent = $cr_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cr_ent->insert('end', "$new_bindings{'<Control-r>'}");
    $cr_ent->bind("<Return>", sub { do_command_bind( "<Control-r>", $cr_ent->get() ) });

    # make control-s
    my $cs_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cs_label = $cs_frame->Label ( -text       => "Control-s",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cs_ent = $cs_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cs_ent->insert('end', "$new_bindings{'<Control-s>'}");
    $cs_ent->bind("<Return>", sub { do_command_bind( "<Control-s>", $cs_ent->get() ) });

    # make control-v
    my $cv_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cv_label = $cv_frame->Label ( -text       => "Control-v",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cv_ent = $cv_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cv_ent->insert('end', "$new_bindings{'<Control-v>'}");
    $cv_ent->bind("<Return>", sub { do_command_bind( "<Control-v>", $cv_ent->get() ) });

    # make control-x
    my $cx_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cx_label = $cx_frame->Label ( -text       => "Control-x",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cx_ent = $cx_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cx_ent->insert('end', "$new_bindings{'<Control-x>'}");
    $cx_ent->bind("<Return>", sub { do_command_bind( "<Control-x>", $cx_ent->get() ) });

    # make control-z
    my $cz_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $cz_label = $cz_frame->Label ( -text       => "Control-z",
				      -width      => $label_width,
				      -justify    => 'left',
				      -background => $options{'mybg'},
				      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $cz_ent = $cz_frame->Entry( -width => $entry_width )->pack(-side   => 'right',
								  -fill   => 'x',
								  -expand => 1,
								  -pady   => 2);
    $cz_ent->insert('end', "$new_bindings{'<Control-z>'}");
    $cz_ent->bind("<Return>", sub { do_command_bind( "<Control-z>", $cz_ent->get() ) });

    # make the reset and close frame and buttons
    my $bt_frame = $bind_win->Frame( -width=>40,
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'})->pack(-side=>"top", -fill=>'x');
    my $set_but = $bt_frame->Button( -text    => 'Set',
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'},
				     -font    => $fn,
				     -command => sub { do_command_bind( "<Control-c>", $cc_ent->get() );
						       do_command_bind( "<Control-d>", $cd_ent->get() );
						       do_command_bind( "<Control-g>", $cg_ent->get() );
						       do_command_bind( "<Control-l>", $cl_ent->get() );
						       do_command_bind( "<Control-o>", $co_ent->get() );
						       do_command_bind( "<Control-q>", $cq_ent->get() );
						       do_command_bind( "<Control-r>", $cr_ent->get() );
						       do_command_bind( "<Control-s>", $cs_ent->get() );
						       do_command_bind( "<Control-v>", $cv_ent->get() );
						       do_command_bind( "<Control-x>", $cx_ent->get() );
						       do_command_bind( "<Control-z>", $cz_ent->get() );
						   } 
				     )->pack(-side=>'left');

    my $reset = $bt_frame->Button(-text    => 'Reset', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { %new_bindings = %def_bindings;
						    
						    # clear everything
						    $cc_ent->delete('0.0', 'end');
						    $cd_ent->delete('0.0', 'end');
						    $cg_ent->delete('0.0', 'end');
						    $cl_ent->delete('0.0', 'end');
						    $co_ent->delete('0.0', 'end');
						    $cq_ent->delete('0.0', 'end');
						    $cr_ent->delete('0.0', 'end');
						    $cs_ent->delete('0.0', 'end');
						    $cv_ent->delete('0.0', 'end');
						    $cx_ent->delete('0.0', 'end');
						    $cz_ent->delete('0.0', 'end');
						    
						    # fill everything
						    $cc_ent->insert('end', "$new_bindings{'<Control-c>'}");
						    $cd_ent->insert('end', "$new_bindings{'<Control-d>'}");
						    $cg_ent->insert('end', "$new_bindings{'<Control-g>'}");
						    $cl_ent->insert('end', "$new_bindings{'<Control-l>'}");
						    $co_ent->insert('end', "$new_bindings{'<Control-o>'}");
						    $cq_ent->insert('end', "$new_bindings{'<Control-q>'}");
						    $cr_ent->insert('end', "$new_bindings{'<Control-r>'}");
						    $cs_ent->insert('end', "$new_bindings{'<Control-s>'}");
						    $cv_ent->insert('end', "$new_bindings{'<Control-v>'}");
						    $cx_ent->insert('end', "$new_bindings{'<Control-x>'}");
						    $cz_ent->insert('end', "$new_bindings{'<Control-z>'}");

						    # set everything
						    do_command_bind( "<Control-c>", $cc_ent->get() );
						    do_command_bind( "<Control-d>", $cd_ent->get() );
						    do_command_bind( "<Control-g>", $cg_ent->get() );
						    do_command_bind( "<Control-l>", $cl_ent->get() );
						    do_command_bind( "<Control-o>", $co_ent->get() );
						    do_command_bind( "<Control-q>", $cq_ent->get() );
						    do_command_bind( "<Control-r>", $cr_ent->get() );
						    do_command_bind( "<Control-s>", $cs_ent->get() );
						    do_command_bind( "<Control-v>", $cv_ent->get() );
						    do_command_bind( "<Control-x>", $cx_ent->get() );
						    do_command_bind( "<Control-z>", $cz_ent->get() );
						} 
				  )->pack(-side=>'left');
    my $close = $bt_frame->Button(-text    => 'Close', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $bind_win->destroy } )->pack(-side=>'right');

}

sub do_command_bind {
    my ($binding, $action) = @_;

    $command->bind( "$binding", sub { $command->insert('end', "$action") });
    $new_bindings{"$binding"} = "$action";
}

##
## make the top level window to configure the anti-idle timer
##

sub do_timer_config {
    my $timer_config_win = $mw->Toplevel( -title      => "Timer actions",
					  -background => $options{'mybg'},
					  -foreground => $options{'myfg'});
    my $timer_label = $timer_config_win->Label ( -text       => "Timer actions",
						 -background => $options{'mybg'},
						 -foreground => $options{'myfg'} )->pack(-side=>"top");
    my $tc_ent = $timer_config_win->Entry( -width => 40 )->pack(-side   => 'top',
								-fill   => 'x',
								-expand => 1,
								-pady   => 2);
    $tc_ent->insert('end', join ":", @timer_actions);
    $tc_ent->bind("<Return>",  sub { @timer_actions = split ':', $tc_ent->get();
				     $timer_config_win->destroy;
				 }
		  );
    my $bt_frame = $timer_config_win->Frame( -width=>40,
					     -fg      => $options{'myfg'},
					     -bg      => $options{'mybg'})->pack(-side=>"bottom", -fill=>'x');
    my $set_but = $bt_frame->Button( -text    => 'Set',
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'},
				     -font    => $fn,
				     -command => sub { @timer_actions = split ':', $tc_ent->get() } 
				     )->pack(-side=>'left');


    my $close = $bt_frame->Button(-text    => 'Close', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $timer_config_win->destroy } 
				  )->pack(-side=>'right');
}

##
## make the tope level window to display the auto-responses
##

sub do_auto_resp_config {

    my $ar_config_win = $mw->Toplevel( -title      => "Auto-responder configuration",
				       -background => $options{'mybg'},
				       -foreground => $options{'myfg'});
    my $ar_label = $ar_config_win->Label ( -text       => "Auto-responder configuration",
					   -background => $options{'mybg'},
					   -foreground => $options{'myfg'} )->pack(-side=>"top");
    $ar_menu = $ar_config_win->Scrolled("HList",
					-width      => 50,
					-height     => 20,
#					   -bg         => 'white', #$options{'outbg'},
					-fg         => 'black', #$options{'outfg'},
					-font       => $fn,
					-relief     => 'sunken',
					-drawbranch => 0,
					-scrollbars => 'osoe',
					-selectmode => 'single',
					-browsecmd  => \&ar_edit_but_mod,
					-command    => \&auto_resp_edit,
				   )->pack(-side   => 'top',
					   -fill   => 'both',
					   -expand => 1);

    ar_menu_fill();


#    $ar_menu->bind("<Return>",  sub { @ar_actions = split ':', $ar_menu->get();
#				     $ar_config_win->destroy;
#				 }
#		  );
    my $bt_frame = $ar_config_win->Frame( -width=>40,
					     -fg      => $options{'myfg'},
					     -bg      => $options{'mybg'})->pack(-side=>"bottom", -fill=>'x');
    $ar_edit_but = $bt_frame->Button( -text    => 'Edit',
				      -fg      => $options{'myfg'},
				      -bg      => $options{'mybg'},
				      -font    => $fn,
				      -state   => 'disabled',
				      -command => sub { auto_resp_edit() } 
				      )->pack(-side=>'left');

    my $creat_but = $bt_frame->Button( -text    => 'Create',
				     -fg      => $options{'myfg'},
				     -bg      => $options{'mybg'},
				     -font    => $fn,
				     -command => sub { auto_resp_edit() } 
				     )->pack(-side=>'left');


    my $close = $bt_frame->Button(-text    => 'Close', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $ar_config_win->destroy } 
				  )->pack(-side=>'right');
}

sub ar_edit_but_mod { 
    my ($path) = @_; 

    $ar_edit_but->configure( -command => sub { auto_resp_edit($path) },
			     -state   => 'normal');
}

sub ar_menu_fill {
    my $count = 0;
    $ar_menu->delete( "all" );

    foreach (@auto_resp_keys) {
	$ar_menu->add( ++$count,
		       -text  => "$count)\t$_",
		       -data  => "$_");
    }
}

##
## make the top level window to edit auto-responses
##

sub auto_resp_edit {
    my $path = $_[0];                      # I think i like the "my ($path) = @_" construct better

    my $ar_key = "";
    my $action = "";
    $ar_key = $ar_menu->entrycget($path, -data) if ($path);
#    $ar_menu->info(selection);
    $action = $auto_responses{$ar_key} if (defined $auto_responses{$ar_key}) ;
    my $win_width = 80;

    my ($old_key, $old_action) = ($ar_key, $action);
    my ($new_key, $new_action) = ($ar_key, $action);

    my $config_win = $mw->Toplevel( -title      => "Auto-responder action",
				    -background => $options{'mybg'},
				    -foreground => $options{'myfg'},
				    );
    my $config_label = $config_win->Label ( -text       => "Auto-response action",
					    -width      => $win_width,
					    -background => $options{'mybg'},
					    -foreground => $options{'myfg'} )->pack(-side=>"top");

    my $trigger_frame = $config_win->Frame( -fg      => $options{'myfg'},
					    -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $trigger_label = $trigger_frame->Label ( -text       => "Trigger",
						-justify    => 'left',
						-width      => 7,
						-background => $options{'mybg'},
						-foreground => $options{'myfg'} )->pack(-side=>"left");
    my $trigger_ent = $trigger_frame->Entry( )->pack(-side   => 'right',
						     -fill   => 'x',
						     -expand => 1,
						     -pady   => 2);
    $trigger_ent->insert('end', $ar_key);
    $trigger_ent->bind("<Return>", sub { ar_clear_key($old_key);
					 $old_key = $new_key = $trigger_ent->get();
                                         $auto_responses{ $new_key } = $action;
					 push (@auto_resp_keys, $new_key);
                                         ar_menu_fill();
                                     });

    $trigger_ent->focus;

    my $action_frame = $config_win->Frame( -fg      => $options{'myfg'},
					   -bg      => $options{'mybg'} )->pack(-side=>"top", -fill=>'x');
    my $action_label = $action_frame->Label ( -text       => "Action",
					      -justify    => 'left',
					      -width      => 7,
					      -background => $options{'mybg'},
					      -foreground => $options{'myfg'} )->pack(-side=>"left");
    my $action_ent = $action_frame->Entry( )->pack(-side   => 'right',
						   -fill   => 'x',
						   -expand => 1,
						   -pady   => 2);
    $action_ent->insert('end', $action);
    $action_ent->bind("<Return>", sub { $old_action = $new_action = $action_ent->get();
					$auto_responses{ $new_key } = $new_action;
				    });

    my $bt_frame = $config_win->Frame( -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'})->pack(-side=>"top", -fill=>'x');

    my $del_button = $bt_frame->Button(-text    => 'Delete', 
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'},
				       -font    => $fn,
				       -command => sub { ar_clear_key($old_key);
							 ar_menu_fill();
						       } 
				       )->pack(-side=>'left');

    my $set_button = $bt_frame->Button(-text    => 'Set', 
				       -fg      => $options{'myfg'},
				       -bg      => $options{'mybg'},
				       -font    => $fn,
				       -command => sub { ar_clear_key($old_key);
							 $old_key = $new_key = $trigger_ent->get();
							 $old_action = $new_action = $action_ent->get();
							 $auto_responses{ $new_key } = $new_action;
							 push (@auto_resp_keys, $new_key);
							 ar_menu_fill();
						       } 
				       )->pack(-side=>'left');

    my $reset = $bt_frame->Button(-text    => 'Reset', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $trigger_ent->delete('0.0', 'end');
						    $action_ent->delete('0.0', 'end');
						    
						    # fill everything
						    $trigger_ent->insert('end', "$ar_key");
						    $action_ent->insert('end', "$action");

						    # set everything
						    ar_clear_key($new_key);
						    ($auto_responses{$ar_key} = $action &&
						     push (@auto_resp_keys, $ar_key))
							if ( !(exists $auto_responses{$ar_key}) );
						    ar_menu_fill();
						    $config_win->destroy;
						} 
				  )->pack(-side=>'left');
    my $close = $bt_frame->Button(-text    => 'Close', 
				  -fg      => $options{'myfg'},
				  -bg      => $options{'mybg'},
				  -font    => $fn,
				  -command => sub { $config_win->destroy } )->pack(-side=>'right');

    $trigger_ent->bind("<Tab>", sub { $action_ent->focus });
    $action_ent->bind("<Tab>", sub { $set_button->focus });
    $set_button->bind("<Tab>", sub { $close->focus });

}

sub ar_clear_key {
    my ($key) = @_;

    delete $auto_responses{$key} if (exists $auto_responses{$key});

    for ( my $i = 0 ; $i <= $#auto_resp_keys ; $i++ ) {
	(splice (@auto_resp_keys, $i, 1) && last) if ($auto_resp_keys[$i] eq $key);
    }
}

##
## The help list
##

sub help {
    my ($progname) = @_;
    print STDERR "Usage: $progname [-host hostname] [-port portnum] [-name character]\n",
                 "\t[-config config_file] [-height lines] [-width rows] [-bg color]\n",
	         "\t[-fg color] [-fn fontname] [-timer seconds] [-[no]qtimer]\n";
    exit 0;
}

####
#### auto_MUD is what automagically responds to output from the server
####     We use regular expressions, so some things might be dicey
####

sub auto_MUD {
    my ($ins) = @_;
    my $key;
    my $resp;
    my $creature;


    $ins =~ s/$de_color_string//g;

    foreach $key (@auto_resp_keys) {
	if ($ins =~ /$key/i) {
	    $creature = $1;
	    $resp = $auto_responses{$key};
	    $resp =~ s/%a/$creature/g;

	    if ($resp =~ /^RANDOM\[(.*)\]/) {
		my @resp = split ":", $1;

		$resp = @resp[int (rand ($#resp + 1))];
	    }

	    if ($resp =~ /^SEQ\[(.*)\]/) {
		my @resp = split ":", $1;

		$resp = join "\n", @resp;
	    }

	    $resp .= "\n";

	    input_stuff($resp, 'input');
	    last;
	}
    }

}

#### Perl doc info should go here
=head1 NAME

mulmo

=head1 Synopsis

mulmo [-host hostname] [-port portnum] [-name character] 
      [-config config_file] [-height lines] [-width rows] 
      [-bg color] [-fg color] [-fn fontname] [-[no]qtimer] 
      [-timer seconds] [-help]

=head1 Description

MuLMO is a client written primarily to interface with the timeless and
ever-popular Internet culture that is I<AberMUD>, although it
should be able to interface equally well with other similar
societies. It uses the Tk modules for Perl (also known as
"PerlTk" -- see I<www.perltk.org>
for more information) to produce a native-look GUI interface.

=head1 Features

MuLMO features repeat timed events, automatic reactions to output from
the MUD, the ability to automatically log-in a persona, and a
navigatible command history. The command history is navigated via
Control-p and Control-n, and, thus, provides immediate familiarity
with users of bash, tcsh, and Emacs.

=head1 Flags

=over 4

=item B<-host hostname>

The address of the machine on which the server is running. This
defaults to "localhost."

=item B<-port portnum>

The port number upon which the server is running. This defaults to
"6715."

=item B<-file char_file>

The name of the file containing a character name and password.

=item B<-height rows>

The number of rows in the output window. This defaults to 24.

=item B<-width columns>

The number of columns in the output window. This defaults to 80.

=item B<-bg color>

The background color for the windows. Defaults to a color in the 
author's eyes.

=item B<-fg color>

The foreground color for the windows. Defaults to a color in the 
author's eyes.

=item B<-fn fontname>

The font to use. This defaults to "lucinasanstypewriter-12".

=item B<-[no]qtimer>

Should the timer use a list of actions, or simply send a newline?
Defaults to "-noqtimer," which uses the list of actions.

=item B<-[no]autoresp>

Should the auto-response feature be active? Defaults to "-autoresp."

=item B<-timer seconds>

The number of seconds to wait before performing a timed
action. This defaults to 600.

=back

=head1 Character File Format

Character files should consist of a single colon (:) delimited line
containing the character name and the password, like this:

B<    name:password>

Anything after the initial colon is taken as part of the password.

=head1 Download

The most recent version of MuLMO can always be retrieved at
I<http://www.jiffyscript.com/files/mulmo>.

=head1 Requirements

MuLMO requires Perl 5.003 or better, the Perl Tk module, the Perl
module Tk::TextANSIColor, and the Perl module Term::ANSIColor. All
of the modules should be available from I<search.cpan.org>.