#!/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.
##
## $Id: mulmo.pl,v 1.38 2002/08/01 16:10:53 magic Exp $
##

use strict;
use Tk;
use Tk::ROTextANSIColor;
use Term::ANSIColor;
use FileHandle;
use IO::Socket;
use IO::Select;
use Getopt::Long;

$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.0";

## 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
    $recon,                                   # The re-connect button object
    $quit,                                    # The quit button object
    $colorbut,                                # The button for color configuration
    $bindbut,                                 # The button for bind configuration
    $timebut,                                 # The button for configuring the timer
    $noscroll,                                # The checkbutton that stopps the scrolling
    );

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 ($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_info,                               # character info 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 ($char, $passwd);                          # The character and password from $char_info

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',
		     'sit',
		     'inv',
		     'stand',
		     'time',
		     '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>' => '',
		     );

my %new_bindings = %def_bindings;


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

$auto_MUD = 1;                                      # turn auto-responses on by default
my $ret = GetOptions ("host=s", \$h, 
		      "port=s", \$p,
		      "file=s", \$char_info, 
		      "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);

my $progname = $0;
help($progname) if $help;

$p = 6715 unless $p;
$h = 'localhost' unless $h;
$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;

my %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);

if (defined $char_info) {
    read_char($char_info);
} else {
    $char = $passwd = "";
}

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

build_de_color();

init_window();

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

MainLoop;

##
## read the character file
##
sub read_char {
## character:password
    my ($char_file) = @_;

    die if !$char_file;

    open (CHAR_FILE, "<$char_file") or die "kinna open $char_file\n";

    while (<CHAR_FILE>) {
	($char, $passwd) = split /:/, $_, 2;
	last;
    }

    close CHAR_FILE;
}

##
## initialize the window
##

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'},
 			     );
    }

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

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


# setup the outout window
    $output_window = $lframe->Scrolled("ROTextANSIColor",
				       -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);
    
# 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 );

    #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 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 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() })->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 (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");
}

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;
		}
	    } else {
		connection_died();
	    }
	}
    }
}
	
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;
}

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;
#    $command->update;
}

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");
#    $command->update;
}

sub do_color_config {
    my $config_win = $mw->Toplevel( -background => $options{'mybg'},
				    -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;
}

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

    my $bind_win = $mw->Toplevel( -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";
}

sub do_timer_config {
    my $timer_config_win = $mw->Toplevel( -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');
}

sub help {
    my ($progname) = @_;
    print STDERR "Usage: $progname [-host hostname] [-port portnum] [-file char_file]\n",
                 "\t[-height lines] [-width rows] [-bg color] [-fg color]\n",
	         "\t[-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 ($retd_val);

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

    if ($ins =~ /has entered the game/) {input_stuff("ust\n", 'input');}

    if ($ins =~ /(\w+) tells you\s/) {
	if ($retd_val = dotell($1, $ins)) {
	    input_stuff($retd_val, 'input');
	}
    }
    elsif ($ins =~ /(\w+) says\s/) {
	if ($retd_val = dosay($1, $ins)) {
	    input_stuff($retd_val, 'input');
	}
    }
    elsif ($ins =~ /s( at|) you\b/) {
	&doother;
    }
}

sub dotell {
    my ($creature, $message) = @_;

    if ($message =~ /\b(hello|hi)\b/oi) {
	return "$creature Hey there.\n";
    } elsif ($message =~ /gimme your version/) {
	return "$creature I'm running $version, and I think it is better than Cats!\n";
    }
    return "";
}

sub dosay {
    my ($creature, $message) = @_;

    if ($message =~ /\b(hello|hi)\b/oi) {
	return "say Hey there, $creature.\n";
    } 
    return "";
}

sub doother {
    return "smile\n";
}

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

mulmo

=head1 Synopsis

mulmo [-host hostname] [-port portnum] [-file char_file] 
      [-height lines] [-width rows] [-bg color] [-fg color] 
      [-fn fontname] [-[no]qtimer] [-[no]autoresp ] [-timer seconds]

=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>.