#!/usr/bin/perl -w
use strict;

use Term::ANSIColor;
use Term::ReadLine;  # also required:
use IO::Handle;      # Term::ReadLine::Gnu
use IPC::Open2;         

$|=1;

print "\e]2;T H C B;)\7";

print "User: ";
my $User=<>;
print "Pass: ";
my $Pass=<>;

open2(*TNIN, *TNOUT, "telnet desert-island.dynodns.net 4040");
TNOUT->autoflush(1);
open(LOG, ">THCB.log");
LOG->autoflush(1);

print TNOUT "auth ]$User [ $Pass";

my @c=("red","green","yellow","magenta");
my $n=0; my %hash; my $C=0; my $history=0;
my @ray = ("blue on_yellow", "red on_green", "magenta on_blue", "black
+ on_magenta", "magenta on_cyan");
my $RLterm = new Term::ReadLine 'THCB input';
my $prompt="\nchat> ";

alarm 120; my $m=2; my $dm=1;

$RLterm->add_defun('F1-clip', sub{print TNOUT "<i>you talkin' to <b>me
+</b></i> "});
$RLterm->bind_keyseq('\eOP','F1-clip');
$RLterm->add_defun('F2-clip', sub{print TNOUT "<i>reflects...</i>\n"})
+;
$RLterm->bind_keyseq('\eOQ','F2-clip');
$RLterm->add_defun('F3-clip', sub{print TNOUT "<b>HELLO WORLD!</b>\n"}
+);
$RLterm->bind_keyseq('\eOR','F3-clip');

while (<TNIN>) {
        $SIG{ALRM}=sub{rearm()};
        $SIG{INT}=sub{process()};
        print LOG "$_"; chomp $_;
        if ($_ =~ /^Found you!\s?$/) {print "\e]0;$User\7" ;}
        my @line = split / /; my $chunk = shift @line; chomp @line;
        if ($chunk =~ /:$/) {
                if (exists($hash{$chunk})) {print color("$hash{$chunk}
+"), "$chunk"}
                else {$hash{$chunk}="$ray[$C]"; $C++;
                        print color("$hash{$chunk}"), "$chunk";
                        my $name; ($name = $chunk) =~ s/:/]/;
                        $RLterm->add_history("[$name"); $history++;
                        if ($C == 5) {$C=0} }
                print color("reset");
        }
        else {print color("$c[$n]"), "$chunk "}
        print color("$c[$n]"), "@line "; print color("reset");
        if ($n == 3) {$n=0}
        else {$n++}
}

sub process {
        my $input=$RLterm->readline($prompt);
        if ($input eq "DONE") {exit 0}
        elsif ($input =~/\*!\*$/) {return}
        else {print TNOUT "$input\n"}
        $RLterm->remove_history("$history");
}

sub rearm {
        print color("white on_red"), "$m"; print "m";
        print color("reset");
        if ($dm == 4) {print LOG "***$m Minutes***\n";$dm=0;}
        alarm 120; $m += 2; $dm++;
}
[download]