#!/usr/bin/perl

###############################################################################
##
## Copyright (C) 2004-2005 Philip Walls (www.rabidgeek.com)
##
## This program is free software; you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by the
## Free Software Foundation; either version 2, or (at your option) any
## later version.
##
## This program is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
## General Public License for more details.
##
###############################################################################

package Furcadia;

# Disable when stable, slows down application
#use strict;
#use warnings;

my $VERSION = "0.6.45";

use IO::Socket::INET;
use IO::Select;

$| = 1;

my $SELECT = IO::Select->new;
my $STDIN = IO::Handle->new;

# Socket handles
my $FURC_SOCKET = 0;
my $PROXY_SOCKET = 0;
my %ProxyClients = ();

# Debugging options (TODO: move out of here)
my %DebugMessages =
(
	"events"	=> 1, # Debug events (handlers and such)
	"social"	=> 1, # Debug whispers, chat, etc

	"goto"		=> 0, # Debug path finding code
	"seen"		=> 0, # Debug how furres/dreams/etc are found
	"objects"	=> 0, # Debug object movements

	"proxy"		=> 1, # Debug proxy related messages
	"print_proxy"	=> 0, # Debug writing to proxy socket
	"proxy_read"	=> 0, # Debug incoming proxy socket data

	"connection"	=> 1, # Debug Furcadia server connecting/disconnecting
	"settings"	=> 1, # Debug INI loading/writing functions
	"read_socket"	=> 0, # Debug Furcadia server incoming socket data

	"read_stdin"	=> 0, # Debug standard input data

	"timers"	=> 0, # Debug timer creation/execution/removal
);
my $DebugPretend = 0;

# Enable colorful debugging by default except in Win32
my $ConsoleColors = 1;
my $WindowsHost = 0;
my $Win32Tray;
if ($^O eq "MSWin32")
{
	$ConsoleColors = 0;
	$WindowsHost = 1;

	require Win32Tray;

	$Win32Tray = new Win32Tray();
	$Win32Tray->RunEvents();
}

my (%FurcInfo, %FurcHandlers, @FurcTimers);

my %Temp =
(
	"specitag"	=> undef, # Last displayed specitag
	"lookreason"	=> undef, # Reason for $Furcadia->look()
);

my %FurcData =
(
	"xpos"		=> undef, # Current X position
	"ypos"		=> undef, # Current Y position
	"imxpos"	=> undef, # "In middle" X position
	"dir"		=> undef, # Direction
	"frame"		=> undef, # Current Furc notation frame

	"map"		=> undef, # Current map

	"lastx"		=> undef, # Previous X position
	"lasty"		=> undef, # Previous Y position
);

my ($FurcReaching, %FurcTried, %FurcAvoid, %FurcDreams, %FurreList, %FurrePosList, %MapFurres);

# Explanation of data structures:
#
#	%FurreList  =
#	(
#		"Furre|Name" => "colorcode"
#	)
#
#	%FurrePosList =
#	(
#		"xpos|ypos" =>
#		{
#			"color" => ...
#			"frame" => ...
#			"dir" => ...
#		}
#	)
#

my %FurcTarget =
(
	"xpos"		=> undef, # Target's X position
	"ypos"		=> undef, # Target's Y position
	"imxpos"	=> undef, # Target's "In middle" X position

	"color"		=> undef, # Target's color
	"name"		=> undef, # Target's name
);

# Direction to number mappings
my %Directions =
(
	'sw'	=> 1,
	'se'	=> 3,
	'nw'	=> 7,
	'ne'	=> 9,
);

# Color codes for error levels
my @DebugLevels =
(
	"\e[1;31m", # Red
	"\e[1;33m", # Yellow
	"\e[1;37m", # White
	"\e[1;32m", # Green
	"\e[1;34m", # Blue
);

sub new
{
	my $self = {};
	my $proto = shift;

	my $furcdata = shift;
	my $handlers = shift;

	%FurcInfo = %{$furcdata};
	%FurcHandlers = %{$handlers};

	bless $self, $proto;
}

# Main event loop
sub event_loop
{
	my $self = shift;

	$self->debug("events", 4, "Entered event loop\n");

	# Handle STDIN data if handler is set up
	if (defined $FurcHandlers{"read_stdin"})
	{
		$self->debug("read_stdin", 4, "Enabling standard input handling\n");
		$self->select_stdin();
	}

	# Handle proxy connections
	if (defined $FurcInfo{"proxy"})
	{
		$self->debug("proxy", 4, "Initializing proxy server\n");

		$self->select_proxy($FurcInfo{"proxy_addr"}, $FurcInfo{"proxy_port"});
	}

	# Add timer to do a who
	# FIXME: Is there a better way to pass this function ref?
	# Don't add the timer unless they want to see when people join/part
	if (defined $FurcHandlers{"list_join"} || defined $FurcHandlers{"list_part"})
	{
		$self->timer_add_interval(3, \&who, $self);
	}

	# While the socket is still readable
	while ($self->can_read || $FurcInfo{"proxy"})
	{
		# Check for timers
		$self->timer_check;

		# Check all read handles (proxy, stdin, socket)
		$self->read_handles;

		# Update the systray window
		if ($WindowsHost)
		{
			if ($Win32Tray->RunEvents() < 0)
			{
				exit(0);
			}
		}
	}

	$self->debug("events", 4, "Exiting event loop\n");
}

###########################
# Handler related functions

sub handle
{
	my $self = shift;
	my $handlename = shift;
	my $retdata = shift;

	# If we've defined a handle, call it with %retdata as an argument
	if (defined $handlename && defined $FurcHandlers{$handlename})
	{
		my $handlerfunction = $FurcHandlers{$handlename};

		# Attempt to run the function
		eval $handlerfunction->($retdata);

		# If unsuccessful
		if ($@)
		{
			$self->debug("events", 2, "Failed to execute handler for $handlename\n");
		}
	}
}

sub add_handler
{
	# Add a new function handler
	# First argument should be the handler name
	# Second argument should be a function reference

	my $self = shift;
	my $handler = shift;
	my $function = shift;

	$self->debug("events", 4, "Added event handler for $handler\n");
	if (defined $handler && defined $function)
	{
		$FurcHandlers{$handler} = $function;
		return 1;
	}
	return 0;
}

sub rem_handler
{
	# Remove a handler by name

	my $self = shift;
	my $handler = shift;

	$self->debug("events", 4, "Removed event handler for $handler\n");
	if (defined $handler)
	{
		$FurcHandlers{$handler} = undef;
		return 1;
	}
	return 0;
}


####################################
# Timer control (ripped from Idiots)

sub timer_check
{
	my $self = shift;

	# Check for waiting timers
	for ( my $timer = 1; $timer <= $#FurcTimers; $timer++ )
	{
		next unless $FurcTimers[$timer][0] && $FurcTimers[$timer][1];

		# Check to see if it's past the time when the timer should have run
		if ( $FurcTimers[$timer][0] <= time )
		{
			$self->debug ( "timers", 4, "Timer $timer activated at " . time . "\n" );

			# Try to run the function
			eval $FurcTimers[$timer][1]->($FurcTimers[$timer][2]);

			# If the eval was unsuccessful
			if ($@)
			{
				$self->debug ( "timers", 4, "Couldn't execute timer: $@\n" );
			}
			else
			{
				$self->debug ( "timers", 4, "Timer executed successfully\n" );
			}

			# If there's an interval set up
			if ($FurcTimers[$timer][3])
			{
				# Recreate the timer with the same interval
				$self->timer_add_interval
				(
					$FurcTimers[$timer][3],
					$FurcTimers[$timer][1],
					$FurcTimers[$timer][2]
				);
			}

			# Remove the old timer
			$self->timer_remove ( $timer );
		}
	}
}

sub timer_add
{
	my $self = shift;

	my $time = shift;
	my $function = shift;
	my $arguments = shift;
	my $repeat = shift;

	my $timer = @FurcTimers + 1;

	$FurcTimers[$timer][0] = $time;
	$FurcTimers[$timer][1] = $function;
	$FurcTimers[$timer][2] = $arguments;
	$FurcTimers[$timer][3] = $repeat;

	$self->debug ( "timers", 4,"Created timer goes off at $time\n" );

	return $timer;
}

sub timer_add_offset
{
	my $self = shift;

	my $offset = shift;
	my $function = shift;
	my $arguments = shift;

	my $timer = @FurcTimers + 1;

	$self->debug("timers", 4, "Created timer with offset of $offset seconds\n");

	$self->timer_add ( time + $offset, $function, $arguments );
}

sub timer_add_interval
{
	my $self = shift;

	my $interval = shift;
	my $function = shift;
	my $arguments = shift;

	my $timer = @FurcTimers + 1;

	$self->debug ("timers", 4, "Created timer to go off every $interval seconds\n");

	$self->timer_add( time + $interval, $function, $arguments, $interval);
}

sub timer_remove
{
	my $self = shift;

	my $timer = shift;

	$self->debug ( "timers", 4, "Removed timer $timer\n" );
	splice ( @FurcTimers, $timer, 1 );

	return 1;
}


####################
# Connection related

sub connect
{
	my $self = shift;
	my $addr = shift;
	my $port = shift;

	# Use default values if none given
	$addr ||= "lightbringer.furcadia.com";

	# Pulled from the Furcadia settings editor (Connection tab)
	my @portlist = ( 6500, 5000, 2300, 80, 22, 21 );

	# If they specified a port, only try that port
	if ($port)
	{
		@portlist = ( $port );
	}

	$self->debug("connection", 2, "Connecting to Furcadia\n");

	# Try connecting to each port in turn
	foreach my $tryport (@portlist)
	{
		if ($WindowsHost)
		{
			$Win32Tray->RunEvents();
		}

		#$self->debug ("connection", 2, "Trying server [$addr:$tryport]\n");

		# while (!$FURC_SOCKET)
		if (!$FURC_SOCKET)
		{
			$FURC_SOCKET = IO::Socket::INET->new (
					PeerAddr => $addr,
					PeerPort => $tryport,
					Proto => 'tcp'
			);
		}

		if ($FURC_SOCKET)
		{
			$self->debug
			(
				"connection", 2,
				"Connected successfully.\n"
			);

			last;
		}
		else
		{
			#$self->debug("connection", 0, "Connection to Furcadia server failed.\n");
			sleep(1);
		}
	}

	# If we have no connection after all of that...
	if (! $FURC_SOCKET)
	{
		$self->debug("connection", 0, "Unable to connect to Furcadia server!\n");
		return 0;
	}

	# Add the socket into our list of selectable handles
	$FURC_SOCKET->autoflush(1);
	$SELECT->add($FURC_SOCKET);

	return 1;
}

sub disconnect
{
	my $self = shift;

	# Remove the socket from selectable handles
	$SELECT->remove($FURC_SOCKET);
	$FURC_SOCKET->close;

	$FURC_SOCKET = undef;

	$self->debug
	(
		"connection", 0,
		"Connection to Furcadia server closed.\n"
	);

	$self->handle("disconnect", { } );
}

sub can_read
{
	my $self = shift;

	# $self->debug("can_read", 4, "$FURC_SOCKET\n");

	#if (!$FURC_SOCKET)
	#{
	#	$self->debug
	#	(
	#		"connection", 0,
	#		"Connection to Furcadia server was lost.\n"
	#	);
	#}

	return $FURC_SOCKET;
}


sub select_stdin
{
	my $self = shift;

	if ($^O eq "MSWin32")
	{
		$self->debug("read_stdin", 0, "Win32 doesn't handle non-blocking IO, disabling keyboard input support\n");
		delete $FurcHandlers{"read_stdin"};
		return 0;
	}

	# Open standard input and make selectable
	if (! $STDIN->fdopen(fileno(STDIN),"r"))
	{
		$self->debug("read_stdin", 0, "Couldn't open standard input, disabling support\n");
		delete $FurcHandlers{"read_stdin"};
		return 0;
	}

	$STDIN->autoflush(1);
	$SELECT->add($STDIN);

	return 1;
}

sub select_proxy
{
	my $self = shift;

	my $bindaddr = shift || "127.0.0.1";
	my $port = shift || 6850;

	$self->debug("proxy", 2, "Starting proxy listen socket on port $bindaddr:$port\n");

	# Open an "accept" socket
	if (!$PROXY_SOCKET)
	{
		$PROXY_SOCKET = IO::Socket::INET->new (
			LocalPort => $port,
			LocalAddr => $bindaddr,
			Listen => 1,
			Reuse => 1,
		);
	}

	if ($PROXY_SOCKET)
	{
		$self->debug
		(
			"proxy", 2,
			"Socket started successfully.\n"
		);
	}
	else
	{
		$self->debug
		(
			"proxy", 0,
			"Couldn't create proxy socket!\n"
		);
		return 0;
	}

	# Add the socket into our list of selectable handles
	$PROXY_SOCKET->autoflush(1);
	$SELECT->add($PROXY_SOCKET);

	return 1;
}

sub print_socket
{
	my $self = shift;

	$self->debug ("print_socket", 4, "@_");

	return 0 unless $FURC_SOCKET;
	$FURC_SOCKET->print("@_") if (!$DebugPretend);
}

sub print_proxy
{
	my $self = shift;

	$self->debug ("print_proxy", 4, "@_");

	return 0 unless $PROXY_SOCKET;

	# Print to each of the connected proxy clients
	foreach my $wh ($SELECT->can_write(0.1))
	{
		if ($ProxyClients{$wh})
		{
			$wh->print("@_") if (!$DebugPretend);
		}
	}

	return 1;
}

# FIXME: Merge this into one function with read_socket and read_proxy
sub read_stdin
{
	my $self = shift;

	# Cycle through selectable handles
	foreach my $rh ($SELECT->can_read(0.1))
	{
		# If the read handle is standard input
		if ($rh == $STDIN)
		{
			if (my $stdin_data = <$STDIN>)
			{
				$self->debug ("read_stdin", 4, $stdin_data);

				# Pass the data on to a handler if one exists
				$self->handle ("read_stdin", { "data" => $stdin_data });

				# Return the data in case it called directly
				return $stdin_data;
			}
			else
			{
				# stdin got closed somehow
				$SELECT->remove($STDIN);
				close($STDIN);

				return 0;
			}
		}
	}
}

sub read_socket
{
	my $self = shift;

	# The argument to can_read tells it how long to block waiting for data
	foreach my $rh ($SELECT->can_read(0.1))
	{
		# If it our Furcadia socket handle
		if ($rh == $FURC_SOCKET)
		{
			my $socket_data;

			# Read one character at a time until EOL (non-blocking)
			while (sysread ($rh,my $buf,1))
			{
				$socket_data .= $buf;
				last if ($buf eq "\n");
			}

			if ($socket_data)
			{
				$self->debug("read_socket", 4, $socket_data);

				# Do something with $socket_data
				$self->scour_socket($socket_data);
				$self->handle("read_socket", { "data" =>  $socket_data });

				return $socket_data;
			}
			else
			{
				# The socket was closed
				$self->disconnect;
				return 0;
			}
		}
	}
}

sub read_proxy
{
	my $self = shift;

	# The argument to can_read tells it how long to block waiting for data
	foreach my $rh ($SELECT->can_read(0.1))
	{
		# If we have a new proxy connection
		if ($rh == $PROXY_SOCKET)
		{
			# Add this to the select list
			my $new = $PROXY_SOCKET->accept;
			$SELECT->add($new);

			my $host = $new->peerhost;

			$ProxyClients{$new} = $host;

			$self->debug("proxy", 4, "Received new proxy connection from $host\n");
			$self->handle("proxy_connect", { "host" => $host });
		}

		# If it's an existing proxy connection
		elsif ($ProxyClients{$rh})
		{
			my $socket_data;

			# Read one character at a time until EOL (non-blocking)
			while (sysread ($rh,my $buf,1))
			{
				$socket_data .= $buf;
				last if ($buf eq "\n");
			}

			if ($socket_data)
			{
				# Do something with $socket_data
				$self->debug ("proxy_read", 4, $socket_data);
				$self->handle ("proxy_read", { "data" => $socket_data });

				return $socket_data;
			}
			else
			{
				# The socket was closed
				$SELECT->remove($rh);
				$rh->close;

				my $host = $ProxyClients{$rh};

				delete($ProxyClients{$rh});

				$self->handle("proxy_disconnect", { "host" => $host });
				$self->debug("proxy", 0, "Proxy client $host disconnected\n");

				return 0;
			}
		}
	}
}

sub read_handles
{
	my $self = shift;
	
	# Name of the handle that we read from
	my $handle;

	# The argument to can_read tells it how long to block waiting for data
	foreach my $rh ($SELECT->can_read(0.1))
	{
		# If it our Furcadia socket handle
		if ($rh == $FURC_SOCKET)
		{
			my $socket_data;

			# Read one character at a time until EOL (non-blocking)
			while (sysread ($rh,my $buf,1))
			{
				$socket_data .= $buf;
				last if ($buf eq "\n");
			}

			if ($socket_data)
			{
				# Do something with $socket_data
				$self->debug("read_socket", 4, $socket_data);
				$self->scour_socket($socket_data);
				$self->handle("read_socket", { "data" =>  $socket_data });

				return $socket_data;
			}
			else
			{
				# The socket was closed
				$self->disconnect;
				return 0;
			}
		}

		# If the read handle is standard input
		elsif ($rh == $STDIN)
		{
			if (my $stdin_data = <$STDIN>)
			{
				$self->debug ("read_stdin", 4, $stdin_data);

				# Pass the data on to a handler if one exists
				$self->handle ("read_stdin", { "data" => $stdin_data });

				# Return the data in case it called directly
				return $stdin_data;
			}
			else
			{
				# stdin got closed somehow
				$SELECT->remove($STDIN);
				close($STDIN);

				return 0;
			}
		}
		
		# If we have a new proxy connection
		elsif ($rh == $PROXY_SOCKET)
		{
			# Add this to the select list
			my $new = $PROXY_SOCKET->accept;
			$SELECT->add($new);

			my $host = $new->peerhost;

			$ProxyClients{$new} = $host;

			$self->debug("proxy", 4, "Received new proxy connection from $host\n");
			$self->handle("proxy_connect", { "host" => $host });
		}

		# If it's an existing proxy connection
		elsif ($ProxyClients{$rh})
		{
			my $socket_data;

			# Read one character at a time until EOL (non-blocking)
			while (sysread ($rh,my $buf,1))
			{
				$socket_data .= $buf;
				last if ($buf eq "\n");
			}

			if ($socket_data)
			{
				# Do something with $socket_data
				$self->debug ("proxy_read", 4, $socket_data);
				$self->handle ("proxy_read", { "data" => $socket_data });

				return $socket_data;
			}
			else
			{
				# The socket was closed
				$SELECT->remove($rh);
				$rh->close;

				my $host = $ProxyClients{$rh};

				delete($ProxyClients{$rh});

				$self->handle("proxy_disconnect", { "host" => $host });
				$self->debug("proxy", 0, "Proxy client $host disconnected\n");

				return 0;
			}
		}
	}
}

sub proxy_clients
{
	my $self = shift;

	# Return the number of connected proxy clients

	my $clients;
	foreach my $key (keys(%ProxyClients))
	{
		$clients++;
	}

	return $clients;
}

sub swallow_socket
{
	# This blocks and is in general not good to use unless you know
	# EXACTLY what is going to be returned from the socket

	# Please see how "seen()" accomplishes safe use of this function
	# It's not recommended that you grab more than a single line at
	# a time. As it could result in some really nasty problems.

	my $self = shift;
	my $lines = shift || 1;

	my @data;

	foreach (1..$lines)
	{
		my $data = <$FURC_SOCKET>;
		push (@data, $data);

		# FIXME: This can cause frustration with proxies
		# Consider using a different handle name for this?
		#$self->handle("read_socket", { "data" => $data });

		$self->debug ("swallow_socket", 4, $data);
	}

	return @data;
}

sub furc_command
{
	# Prints all arguments to socket with newline

	my $self = shift;

	$self->print_socket("@_\n");
}

sub position
{
	my $self = shift;

	return $FurcData{xpos},$FurcData{ypos},$FurcData{imxpos};
}

sub seen
{
	# Find out where someone is

	# ((You see Malverian.)
	#
	# ]f 7  != ===!"!Malverian

	my $self = shift;
	my $who = shift;
	my $color;

	# Who is a required argument
	if (!$who)
	{
		return 0;
	}

	# Turn spaces into | symbol
	$who =~ s/\s/\|/g;

	# If we've got them in our list already
	# With the proper casing
	if (defined $FurreList{$who})
	{
		$color = $FurreList{$who};
	}

	# If the casing is wrong or we have a partial name
	else
	{
		foreach my $furre (keys %FurreList)
		{
			if ($furre =~ /^\Q$who\E/i)
			{
				$color = $FurreList{$furre};
				$who = $furre;
			}
		}
	}

	####################################################
	# Let's really hope we never get here
	# Looks at the furre to grab their color code

	unless (defined $color)
	{
		$self->look($who);

		my $retrieved = 0;

		until ($retrieved)
		{
			my @data = $self->swallow_socket(1);
			my $data = "@data";

			if ($data =~ /^\]f(.{10})(.{3})(.*)/)
			{
				$color = $1;
				$who = $3;

				$FurreList{$who} = $color;

				$retrieved = 1;
			}
			elsif ($data =~ /^\(\* Sorry, that furre is/)
			{
				return undef;
			}
			elsif (/^\(\* More than one furre\'s name begins that way\./)
			{
				return undef;
			}
			
			else
			{
				# Try to pass unrelated data to the scourer
				$self->scour_socket($data);
			}
		}
	}
		
	#####################################################

	return unless $color;

	# Find the position based on their color code
	foreach my $furre (keys (%FurrePosList))
	{
		next unless defined $furre;
		next unless defined $FurrePosList{$furre};

		my $fpcolor = $FurrePosList{$furre}{"color"};

		if ($fpcolor eq $color && $furre ne "0|0")
		{
			my @pos = split(/\|/,$furre);
			my $xpos = shift @pos;
			my $ypos = shift @pos;
			my $imxpos = $self->get_imx_pos($xpos,$ypos);

			my $frame = $FurrePosList{$furre}{"frame"};
			my $dir = $FurrePosList{$furre}{"dir"};

			$self->debug("seen", 4, "Found $who in list: $furre ($fpcolor) -- Facing $dir\n");			

			return ($who, $xpos, $ypos, $dir, $color);
		}
	}

	return undef;
}

sub seen_dream
{
	my $self = shift;
	my $dream = shift;

	foreach my $tdream (keys %FurcDreams)
	{
		if ($FurcDreams{$tdream} =~ /^\Q$dream\E/i)
		{
			my $name = $FurcDreams{$tdream};
			my ($xpos, $ypos) = split(/\|/, $tdream);

			$self->debug("seen", 4, "Found dream $name at $xpos, $ypos\n");

			return ($name, $xpos, $ypos);
		}
	}
}

sub target
{
	my $self = shift;

	return
	(
		$FurcTarget{xpos}, $FurcTarget{ypos},
		$FurcTarget{imxpos}, $FurcTarget{name}, $FurcTarget{dream}
	);
}

sub map
{
	my $self = shift;

	return $FurcData{map};
}

# FIXME: This is a stupid function
sub status
{
	my $self = shift;
	my $xpos = shift;
	my $ypos = shift;

	return $FurcDreams{"$xpos|$ypos"};
}

# TODO: Add handlers for all scour_socket areas..
# Q: What order should the handlers be called in?
# A: Probably after any %FurcData variables have been set
sub scour_socket
{
	# Scour the socket data for position codes
	# and other persistant data
	# Call any function handlers

	# Function handler specified in $handlename
	# is called with %retdata as an argument

	my $self = shift;
	my $data = shift;

	$_ = $data;
	chop;

	if (/^\@(.{4})(.{4})?/)
	{
		# The bot moved (screen recenter)

		# @ ( . ) /
		# @<new x><new y><old x><old y>

		my $position = $1;
		my $last = $2;

		my ($xpos,$ypos,$imxpos) = $self->furc_to_pos($position);

		$FurcData{xpos} = $xpos;
		$FurcData{ypos} = $ypos;
		$FurcData{imxpos} = $imxpos;

		my ($lastxpos, $lastypos, $lastimxpos) = $self->furc_to_pos($last);

		$FurcData{lastx} = $lastxpos;
		$FurcData{lasty} = $lastypos;

		# TODO: Set up other things similar to this
		$self->handle("game_screen_move", $lastxpos, $lastypos, $xpos, $ypos);
	}
	elsif (/^\/(.{10})(.{4})(.{2})(.{4})?/ || /^\<(.{10})(.{4})(.{2})/)
	{
		# Avatar moves to new location
		# /)-B& %!%8- ) / K ) .

		# Avatar frame update (sitting, spinning, etc)
		# <)-B& %!%8- ) / I

		my $color = $1;
		my $position = $2;
		my $frame = $3;
		my $from = $4;

		# Convert to human readable positions/directions
		my ($xpos,$ypos,$imxpos) = $self->furc_to_pos($position);
		my ($oldxpos,$oldypos,$oldimxpos) = $self->furc_to_pos($from);
		my $dir = $self->frame_to_dir($frame);


		# Determine if it's a movement code
		my $movement = /^\//;

		# Determine if we were the one that moved
		my $wemoved = ($xpos == $FurcData{xpos} && $ypos == $FurcData{ypos});

		# Determine if we're seeking some place
		my $pathfinding = (defined $FurcTarget{xpos} && defined $FurcTarget{ypos});

		# Determine if there is a vector (successful movement)
		my $vector = $self->get_vector($oldxpos, $oldypos, $xpos, $ypos);


		if ($vector)
		{
			#$self->debug("goto", 4, "Furre ($color) moved to $xpos [$imxpos], $ypos (direction: $vector)\n");
		}

		# FIXME: This is so the bot can't follow himself, use a better method
		unless ($wemoved)
		{
			$FurrePosList{"$xpos|$ypos"}{"color"} = $color;
			$FurrePosList{"$xpos|$ypos"}{"frame"} = $frame;
			$FurrePosList{"$xpos|$ypos"}{"dir"} = $dir;

			#$self->handle("game_other_moved", $color, $frame, $dir);
		}

		$self->handle
		(
			"move",
			{
				"color"		=> $color,
				"xpos"		=> $xpos,
				"ypos"		=> $ypos,
				"imxpos"		=> $imxpos,
				"fpos"		=> $position,
				"frame"		=> $frame,
				"from"		=> $from
			}
		);

		# If the position spoken of is where we stand
		if ($wemoved)
		{
			# If we reached our lock position
			if ($FurcReaching eq "$xpos|$ypos")
			{
				# Remove the lock
				$FurcReaching = undef;
			}

			# Update our current direction and frame
			$FurcData{dir} = $dir;
			$FurcData{frame} = $frame;

			# If it's a movement code (not spinning/sitting/etc)
			if ($movement)
			{
				# If we ran into something
				if ($from eq $position)
				{
					# Figure out where we tried moving to
					my ($nxpos, $nypos, $nimxpos) = $self->relative_position($xpos, $ypos, $dir);

					$self->debug("goto", 4, "Failed moving $dir from $xpos, $ypos to $nxpos [$nimxpos], $nypos\n");

					# If we're currently seeking
					if ($pathfinding && ! $self->next_to($FurcTarget{name}))
					{
						# Don't go there again
						$self->avoid($nxpos, $nypos, $xpos, $ypos);

						# If we're seeking a person
						if ($FurcTarget{name})
						{
							# Recalculate the "nearest" position to the person we're going to

							# FIXME: Should probably only do this if we found out our target
							# position is occupied. Also.. this $tdir doesn't work as intended :-P
							my ($twho,$txpos,$typos) = $self->seen($FurcTarget{name});
							my $tdir = $self->get_vector($txpos,$typos,$xpos,$ypos);
							my ($tnx, $tny) = $self->get_nearest($txpos, $typos, $tdir);

							$self->goto($tnx, $tny);
						}
						else
						{
							# Otherwise just keep trying our current target positions
							#$self->goto($FurcTarget{xpos}, $FurcTarget{ypos});
						}
					}
				}

				# If it was a successful move
				else
				{
					# "Close" that position we came from so we don't go back there
					$self->debug("goto", 4, "Successfully moved from $oldxpos, $oldypos to $xpos, $ypos\n");

					if ($pathfinding)
					{
						$self->tried($oldxpos, $oldypos);
						$self->avoid($oldxpos, $oldypos);
					}
				}

				# Once we've moved and recalculated, go again
				if ($pathfinding)
				{
					$self->reach_dest();
				}
			}
		}

		# If we are following the furre that moved
		elsif (defined $FurcTarget{color} && defined $color && $FurcTarget{color} eq $color)
		{
			# When we update our target, clear out the avoid list
			%FurcAvoid = ();

			$FurcTarget{dir} = $dir;

			# If we're not already next to our target
			if (! $self->next_to($FurcTarget{name}))
			{
				# Go to the position behind them (or nearest empty place)

				my $flip = $self->flip_direction($dir);
				my ($goxpos, $goypos, $goimxpos) = $self->get_nearest($xpos, $ypos, $flip);

				#$self->debug("goto", 4, "Target is now facing $dir\n");

				$self->goto($goxpos,$goypos);

				# If we're not already processing movement
				if (! $FurcReaching)
				{
					$self->reach_dest();
				}
			}
		}
	}

	elsif (/^>(.*)$/)
	{
		# Tell about an object position

		# Usually sent as >XXYYNN
		# But on map join, sent as >XXYYNN[XXYYNN[...]]

		my $olist = $1;

		while ($olist =~ /(.{4})(.{2})/g)
		{
			my $position = $1;
			my $object = $2;

			my ($xpos,$ypos,$imxpos) = $self->furc_to_pos($position);
			my $onum = $self->furc_to_int($object);

			if ($onum)
			{
				$self->debug("objects", 4, "Placing object $onum at position $xpos, $ypos\n");
			}
			else
			{
				$self->debug("objects", 4, "Clearing object at position $xpos, $ypos\n");
			}
		}
	}

	elsif (/^\)(.{4})$/)
	{
		# Clear furre from position

		my $position = $1;

		my ($xpos,$ypos,$imxpos) = $self->furc_to_pos($position);

		#$self->debug("goto", 4, "Clearing furre at position $xpos, $ypos\n");

		delete $FurrePosList{"$xpos|$ypos"};
	}
	elsif (/\]-\#(.)(.{10})(.{3})$/)
	{
		# Someone spoke or whispered
		# Displays specitag before line

		my $modifier = $1;
		my $color = $2;
		my $spec = $3;

		$Temp{specitag} = $color;
	}
	elsif (/^\]s(.{4})(..)(.*?) (.*)?/)
	{
		# Set up dream list eg: ]s 7 gLost|Lakes

		my ($xpos,$ypos,$imxpos) = $self->furc_to_pos($1);
		my $sponsored = $2; # FIXME: Just a guess
		my $dreamname = $3;
		my $title = $4;

		$FurcDreams{"$xpos|$ypos"} = $dreamname;
	}
	elsif (/^\]t(.{4})(.*)/)
	{
		# When a dream disappears, remove it from the list

		my ($xpos,$ypos,$imxpos) = $self->furc_to_pos($1);

		$FurcDreams{"$xpos|$ypos"} = undef;
	}
	elsif (/^]f(.{10})(.)(.)(.)(.*)/)
	{
		# Looked at someone

		my $color = $1;
		my $gender = $2;
		my $species = $3;
		my $form = $4;
		my $name = $5;

		my $gname = $self->furc_to_gender($gender);
		my $sname = $self->furc_to_species($species);

		# If we're supposed to be following this person
		if (defined $FurcTarget{name} && $FurcTarget{name} eq $name)
		{
			$self->debug("goto", 4, "Located target $name ($color)\n");
			$FurcTarget{color} = $color;
		}

		$self->handle
		(
			"look",
			{
				"color"		=> $color,
				"species"	=> $species,
				"name"		=> $name,
			}
		);

		$self->debug("goto", 4, "$name is a $gname $sname\n");
	}
	elsif (/\]cc.+/)
	{
		# New map / dream

		%FurrePosList = ();
		%FurreList = ();
		%MapFurres = ();
		%FurcDreams = ();

		# Clear path finding data
		$self->stop;

		if (! $FurcInfo{"proxy"})
		{
			$self->furc_command("vascodagama");
		}
	}
	elsif (/^\]q/)
	{
		# Entered a dream

	}
	elsif (/^\]\#xxxx 0 Whoops\! The username and password did not match -- please check your spelling\./)
	{
		# Incorrect login

		$self->debug("connection", 2, "Login incorrect, username and password do not match\n");
	}
	elsif (/^END$/)
	{
		# If we're not acting as a proxy and aren't reconnecting
		if ($FurcInfo{name} && $FurcInfo{password})
		{
			# Log in the bot
			$self->login (
				$FurcInfo{name},
				$FurcInfo{password},
				$FurcInfo{colors},
				$FurcInfo{species}
			);

			# Set the bot's description
			$self->desc ($FurcInfo{desc});
		}
	}
	elsif (/^<font/)
	{
		# Pass data off to handler
		$self->handle("social", { "data" => $1 });

		$self->debug("social", 4, "$1\n");

		if (/^\(\(You enter the dream of (.*)\.\)$/)
		{
			# Entered a dream

			$FurcData{'map'} = "dream_$1";

			$self->handle("map", { "map" => "dream_$1" });
		}
		elsif (/^\(\[\*\] (.*?) asks you to join his \/ her company\./)
		{
			# Someone summons you

			$self->handle ("summon", { "name" => $1 });
		}
		elsif (/\(\[\%\] (.*?) just gave you a cookie\!/)
		{
			$self->handle("gift", { "name" => $1, "type" => "cookie" });
		}
		elsif (/\(\[\*\] (.*?) requests permission to join your company\./)
		{
			$self->handle("join", { "name" => $1 });
		}
		elsif (/\(\* Current players: (.*)/)
		{
			my @players = split(/,\s|\./, $1);
			my %newfurres;

			foreach my $player (@players)
			{
				$newfurres{$player} = 1;
				if (!$MapFurres{$player} && %MapFurres != ())
				{
					# New Furre arrived

					$self->handle("list_join", { "name" => $player });
				}
			}
			foreach my $player (keys(%MapFurres))
			{
				if (!$newfurres{$player})
				{
					# Player left

					$self->handle("list_part", { "name" => $player });
				}
			}
			%MapFurres = %newfurres;
		}
		elsif (/^<font color='whisper'>\[ <name shortname='(.*?)' src='whisper\-from'>(.*)<\/name> whispers, "(.*?)" to you\. \]<\/font>$/)
		{
			# Someone whispered you

			$FurreList{$1} = $Temp{specitag};

			$self->handle
			(
				"whisper",
				{
					"from"		=> $1,
					"message"	=> $3,
				}	
			);

			$self->debug("social", 4, "$1 whispered \"$2\"\n");
		}
		elsif (/^\((\S*?): (.*)/)
		{
			# Someone spoke

			$FurreList{$1} = $Temp{specitag};

			$self->handle
			(
				"say",
				{
					"from"		=> $1,
					"message"	=> $2,
				}	
			);

			#$self->debug("social", 4, "$1 said \"$2\"\n");
		}
	}
	elsif (/^;(.+)\.map$/)
	{
		# Changed maps

		my $mapname = $1;


		$FurcData{'map'} = $mapname;

		$self->handle("map", { "map" => $mapname });

		$self->stop;

		# Hardcoded dreams to avoid in certain maps -- lame!
		# FIXME: Once map parsing is done, I can do this by object type
		if ($mapname eq "allegria")
		{
			$FurcDreams{"50|59"} = "Sponsor dream";
		}
	}

	return 1;
}

sub get_heuristic
{
	my $self = shift;

	my $startx = shift;
	my $starty = shift;
	my $startimx = $self->get_imx_pos($startx, $starty);

	my $endx = shift;
	my $endy = shift;
	my $endimx = $self->get_imx_pos($endx, $endy);

	# Use the smallest possible heuristic value
	my $heuristic = abs($startx - $endx) + abs($starty - $endy);
	my $imheuristic = abs($startimx - $endimx) + abs($starty - $endy);
	if ($imheuristic < $heuristic) { $heuristic = $imheuristic }

	$self->debug("goto", 4, "Heuristic for ($startx [$startimx], $starty -- $endx [$endimx], $endy) is $heuristic\n");

	return $heuristic;
}

sub calculate_next_move
{
	my $self = shift;

	my $startx = shift;
	my $starty = shift;

	my $endx = shift;
	my $endy = shift;

	my $lowest = undef;

	my $nextx = undef;
	my $nexty = undef;

	foreach my $tdir ($self->each_direction())
	{
		my ($xpos, $ypos, $imxpos) = $self->relative_position($startx,$starty,$tdir);

		if ($self->occupied($xpos, $ypos))
		{
			$self->debug("goto", 4, "Next position is occupied: $xpos, $ypos [D=$tdir]\n");
			next;
		}

		my $heuristic = $self->get_heuristic($xpos, $ypos, $endx, $endy);

		my $tried1 = $FurcTried{"$xpos|$ypos"};
		my $tried2 = $FurcTried{"$nextx|$nexty"};

		if (! defined $lowest || $heuristic < $lowest)
		{
			$self->debug("goto", 4, "Found better move to $xpos, $ypos [H=$heuristic, T=$tried1]\n");
			#$self->debug("goto", 4, "New move replaces $nextx, $nexty [H=$lowest, T=$tried2]\n");

			$nextx = $xpos;
			$nexty = $ypos;

			$lowest = $heuristic;

			#$self->tried($xpos,$ypos);
		}
	}

	$self->debug("goto", 4, "Found best move ($nextx, $nexty)\n");

	return ($nextx, $nexty);
}

sub reach_dest
{
	my $self = shift;

	my $botx = $FurcData{xpos};
	my $boty = $FurcData{ypos};

	my $targetx = $FurcTarget{xpos};
	my $targety = $FurcTarget{ypos};

	my $distance = $self->get_heuristic($botx,$boty,$targetx,$targety);

	# If we've reached our destination pause/stop
	if (($FurcTarget{name} && $self->next_to($FurcTarget{name})) || $distance < 1)
	{
		# If we're following someone
		if ($FurcTarget{color})
		{
			$self->debug("goto", 4, "Reached target, pausing next to them\n");
			$self->pause;
		}

		# If we were seeking to someone
		elsif ($FurcTarget{name})
		{
			$self->debug("goto", 4, "Reached furre, stopping next to them\n");

			# Sit and face them		
			$self->sit;

			my ($name,$xpos,$ypos) = $self->seen($FurcTarget{name});
		        $self->face($xpos, $ypos);

			$self->stop;
		}

		# If we're seeking to a position
		else
		{
			$self->debug("goto", 4, "Reached position, stopping here\n");
			$self->stop;
			$self->twitch;
		}

		return;
	}

	my $maxtries = 3;

	my ($nextx, $nexty);

	for (my $i = 0; $i <= $maxtries; $i++)
	{
		($nextx,$nexty) = $self->calculate_next_move($botx,$boty,$targetx,$targety);

		if ($nextx && $nexty)
		{
			last;
		}
		else
		{
			$self->debug("goto", 4, "Couldn't determine next move\n");
			$self->pause;
		}
	}

	my $direction = $self->get_vector($botx,$boty,$nextx,$nexty);

	# If we've got a direction
	if (defined $direction)
	{
		$self->debug("goto", 4, "Moving toward target ($targetx, $targety): $direction\n");

		$FurcReaching = "$nextx|$nexty";

		$self->godir($direction);
	}

	# We couldn't find a direction
	else
	{
		$self->debug("goto", 4, "Giving up, couldn't find our target after $maxtries tries\n");
		$self->stop;
		$self->twitch;
	}
}

sub tried
{
	my $self = shift;

	my $xpos = shift;
	my $ypos = shift;

	$FurcTried{"$xpos|$ypos"}++;

	#$self->debug("goto", 4, "Adding $xpos, $ypos to tried list (Tried: " . $FurcTried{"$xpos|$ypos"} . ")\n");
}

sub avoid
{
	# Tell the bot to avoid a specific position

	my $self = shift;

	my $xpos = shift;
	my $ypos = shift;

	my $lastx = shift;
	my $lasty = shift;

	# Determine which way we failed going
	# TODO: Read in map data, propogate this list with object locations

	# Also, set "value" to be the direction from which you can't move to that
	# location (needed eg. for walls..)

	$FurcAvoid{"$xpos|$ypos"} = 1;

	if ($lastx && $lasty)
	{
		$FurcAvoid{"$xpos|$ypos"} = "$lastx|$lasty";
	}

	#$self->debug("goto", 4, "Adding $xpos, $ypos to avoid list (from $lastx, $lasty)\n");
}

sub occupied
{
	# Determines if a position is occupied

	my $self = shift;

	my $xpos = shift;
	my $ypos = shift;

	my $occupied = 0;

	if ($FurcDreams{"$xpos|$ypos"})
	{
		# If it's not the dream we're seeking
		if ($FurcTarget{dream} ne $FurcDreams{"$xpos|$ypos"})
		{
			$occupied = 1;
		}
	}
	if ($FurrePosList{"$xpos|$ypos"})
	{
		$occupied = 1;
	}
	if ($FurcAvoid{"$xpos|$ypos"})
	{
		my $botx = $FurcData{xpos};
		my $boty = $FurcData{ypos};

		if ($FurcAvoid{"$xpos|$ypos"} eq "$botx|$boty")
		{
			$self->debug("goto", 4, "Can't move to $xpos, $ypos from $botx, $boty\n");

			$occupied = 1;
		}
		elsif ($FurcAvoid{"$xpos|$ypos"} == 1)
		{
			$occupied = 1;
		}
	}

	#$self->debug("goto", 4, "Checking if $xpos, $ypos is occupied (O=$occupied)\n");

	return $occupied;
}

sub get_vector
{
	# Determine direction of movement

	my $self = shift;

	my $xpos1 = shift;
	my $ypos1 = shift;
	my $xpos2 = shift;
	my $ypos2 = shift;

	# Use the "in middle" X position for vectorizing
	my $imxpos1 = $self->get_imx_pos($xpos1, $ypos1);
	my $imxpos2 = $self->get_imx_pos($xpos2, $ypos2);

	# Get the real distance on each axis
	#my $xdist = sqrt(($xpos1 - $xpos2) ** 2);
	#my $ydist = sqrt(($ypos1 - $ypos2) ** 2);

	my $direction;

	# If we haven't defined both, there is no vector
	unless ($imxpos1 && $ypos1 && $imxpos2 && $ypos2)
	{
		return undef;
	}

	# If they're the same, we have no vector
	if ($imxpos1 == $imxpos2 && $ypos1 == $ypos2)
	{
		return undef;
	}

	# X Axis different (Furre directly east or west)
	if ($imxpos2 > $imxpos1 && $ypos2 == $ypos1)
	{
		# Furre directly east
		#$direction = "e";
		$direction = "ne";
	}
	elsif ($imxpos2 < $imxpos1 && $ypos2 == $ypos1)
	{
		# Furre directly west
		#$direction = "w";
		$direction = "sw";
	}

	# Y Axis different (Furre directly north or south)
	elsif ($imxpos2 == $imxpos1 && $ypos2 > $ypos1)
	{
		# Furre directly south
		#$direction = "s";
		$direction = "se";
	}
	elsif ($imxpos2 == $imxpos1 && $ypos2 < $ypos1)
	{
		# Furre directly north
		#$direction = "n";
		$direction = "nw";
	}

	# Both axis different
	elsif ($imxpos2 > $imxpos1 && $ypos2 < $ypos1)
	{
		$direction = "ne";
	}
	elsif ($imxpos2 < $imxpos1 && $ypos2 > $ypos1)
	{
		$direction = "sw";
	}
	elsif ($imxpos2 > $imxpos1 && $ypos2 > $ypos1)
	{
		$direction = "se";
	}
	elsif ($imxpos2 < $imxpos1 && $ypos2 < $ypos1)
	{
		$direction = "nw";
	}

	#$self->debug("goto", 4, "Vector for ($xpos1 [$imxpos1], $ypos1) to ($xpos2 [$imxpos2], $ypos2) is $direction\n");

	return $direction;
}

sub get_nearest
{
	# Return nearest clear position

	my $self = shift;

	my $xpos = shift;
	my $ypos = shift;
	my $dir = shift;

	foreach my $tdir ($dir, $self->each_direction)
	{
		my ($goxpos,$goypos,$goimxpos) = $self->relative_position($xpos,$ypos,$tdir);

		if (! $self->occupied($goxpos, $goypos))
		{
			return ($goxpos, $goypos);
		}

		# Eeeeeek.. recursive function with no maximum depth!
		# FIXME: Enable this after depth checks added
		#return $self->get_nearest($goxpos, $goypos, $tdir);
	}

	$self->debug("goto", 2, "Couldn't find an open spot near $xpos, $ypos\n");

	return undef;
}

sub each_direction
{
	# Return an array of all directions

	my $self = shift;

	return ("se", "sw", "nw", "ne");
}

sub direction_to
{
	my $self = shift;

	my $targetx = shift;
	my $targety = shift;

	my $botx = $FurcData{xpos};
	my $boty = $FurcData{ypos};

	my $vector = $self->get_vector($botx,$boty,$targetx,$targety);

	return $vector;
}

sub direction
{
	# Return the direction I'm facing

	my $self = shift;

	return $FurcData{dir};
}

sub relative_position
{
	# Get the relative position based on a position and direction

	my $self = shift;

	my $xpos = shift;
	my $ypos = shift;
	my $direction = shift;

	my $imxpos = $self->get_imx_pos($xpos, $ypos);

	if ($direction eq "nw")
	{
		$imxpos--;
		$ypos--;
	}
	elsif ($direction eq "ne")
	{
		$imxpos++;
		$ypos--;
	}
	elsif ($direction eq "se")
	{
		$imxpos++;
		$ypos++;
	}
	elsif ($direction eq "sw")
	{
		$imxpos--;
		$ypos++;
	}
	else
	{
		$self->debug("goto", 1, "Unhandled direction: $direction\n");
	}

	# FIXME: WTF is going on in this function? Use get_imx_pos?
	$xpos = $imxpos;

	# If the Y position is even, add 1 to the y position
	if ($ypos & 1) { $xpos++ }

	return ($xpos, $ypos, $imxpos);
}

sub flip_direction
{
	my $self = shift;
	my $direction = shift;

	my %flips = (
		"nw" => "se",
		"se" => "nw",
		"ne" => "sw",
		"sw" => "ne"
	);

	return $flips{$direction};
}

sub flip_axis
{
	my $self = shift;
	my $axis = shift;

	my %faxis = (
		"x" => "y",
		"y" => "x",
	);

	return $faxis{$axis};
}


sub get_axis
{
	my $self = shift;

	my $direction = shift;

	my %axis = (
		"nw" => "x",
		"se" => "x",
		"ne" => "y",
		"sw" => "y"
	);

	return $axis{$direction};
}

sub distance_to
{
	my $self = shift;

	my $name = shift;

	# Get the position of the person
	my ($tname,$xpos,$ypos) = $self->seen($name);

	my $distance = $self->distance_to_pos($xpos,$ypos);

	return $distance;
}

sub distance_to_pos
{
	my $self = shift;

	my $targetx = shift;
	my $targety = shift;

	my $botx = $FurcData{xpos};
	my $boty = $FurcData{ypos};

	my $distance = $self->get_heuristic($botx, $boty, $targetx, $targety);

	return $distance;
}

sub next_to
{
	my $self = shift;

	my $name = shift;

	# FIXME: If name is blank, hangs forever. Could have further implications.
	if (!$name)
	{
		return 0;
	}

	# Get the position of the person
	my ($tname,$xpos,$ypos) = $self->seen($name);

	my $nextto = $self->next_to_pos($xpos,$ypos);

	$self->debug("goto", 4, "Checking if we're next to $name: $nextto\n");

	return $nextto;
}

sub next_to_pos
{
	my $self = shift;
	my $targetx = shift;
	my $targety = shift;

	my $nextto = 0;

	my $distance = $self->distance_to_pos($targetx, $targety);
	if ($distance <= 1)
	{
		$nextto = 1;
	}

	$self->debug("goto", 4, "Checking if we're next to $targetx, $targety [D=$distance R=$nextto]\n");

	return $nextto;
}


#####################
# Furcadia specific #

sub login
{
	my $self = shift;

	my $name = shift;
	my $pass = shift;
	my $colors = shift;
	my $species = shift;

	my $speccode;
	if ($species)
	{
		my @spec = split(//,$species);
		foreach my $num (@spec)
		{
			$speccode .= chr($num + 32);
		}
	}

	$self->debug("connection", 2, "Logging in with username $name\n");

	$self->furc_command("connect $name $pass");
	$self->furc_command("color $colors$speccode");
}

sub desc
{
	my $self = shift;

	my $desc = shift;

	$self->furc_command("desc $desc [<a href=\"http://trac.rabidgeek.com/wiki/RGLibFurc\">RG</a>]");
}

# Append "tags" to end of %FurcInfo description
sub desc_tag
{
	my $self = shift;
	my $tag = shift;

	my $desc = $FurcInfo{"desc"};

	$self->desc("$desc $tag");
}

sub who
{
	my $self = shift;

	$self->furc_command("who");
}

sub whisper
{
	my $self = shift;

	my $furre = shift;
	my $message = shift;


	$furre = $self->pipe_space($furre);
	$self->furc_command("wh $furre $message");
}

sub say
{
	my $self = shift;

	my $message = shift;

	$self->furc_command("\"$message");
}

sub emote
{
	my $self = shift;

	my $emote = shift;

	$self->furc_command(":$emote");
}

sub look
{
	my $self = shift;
	my $look = shift;

	return unless $look;

	$self->furc_command("\"look $look");
}

sub online
{
	my $self = shift;
	my $name = shift;

	return unless $name;

	$self->furc_command("onln $name");

	while (1)
	{
		my @data = $self->swallow_socket(1);
		my $data = "@data";

		if ($data =~ /^\]\%(\d)/)
		{
			my $online = $1;
			return $online;
		}
		else
		{
			# Try to pass unrelated data to the scourer
			$self->scour_socket($data);
		}
	}
}

sub gomap
{
	my $self = shift;
	my $map = shift;

	$self->furc_command("gomap $map");
}

sub goto
{
	my $self = shift;
	my $xpos = shift;
	my $ypos = shift;

	# If the target hasn't changed, don't bother trying to reach it again
	if ($FurcTarget{xpos} eq $xpos && $FurcTarget{ypos} == $ypos) { return }

	$FurcTarget{xpos} = $xpos;
	$FurcTarget{imxpos} = $self->get_imx_pos($xpos,$ypos);
	$FurcTarget{ypos} = $ypos;

	$self->debug("goto", 4, "Updated target location: $xpos [$FurcTarget{imxpos}], $ypos\n");
}

sub follow
{
	my $self = shift;
	my $who = shift;

	my ($name,$xpos,$ypos) = $self->seen($who);

	return undef unless ($name && $xpos && $ypos);

	$self->stop;

	$FurcTarget{name} = $name;
	$Temp{lookreason} = "follow";

	$self->look($name);

	return $name;
}

sub seek
{
	my $self = shift;
	my $who = shift;

	my ($name,$xpos,$ypos,$dir) = $self->seen($who);

	return undef unless ($name && $xpos && $ypos);

	if($self->seek_pos($xpos,$ypos,$dir))
	{
		$FurcTarget{name} = $name;

		return $name;
	}
}

sub seek_dream
{
	my $self = shift;
	my $dream = shift;

	my ($name,$xpos,$ypos) = $self->seen_dream($dream);

	return undef unless ($name && $xpos && $ypos);

	$self->goto($xpos,$ypos);

	$self->reach_dest();

	$FurcTarget{dream} = $name;

	return $name;
}

sub seek_pos
{
	my $self = shift;

	my $xpos = shift;
	my $ypos = shift;
	my $dir = shift;

	$self->stop;

	my ($goxpos,$goypos) = $self->get_nearest($xpos,$ypos,$dir);

	if ($goxpos && $goypos)
	{
		$self->goto($goxpos,$goypos);

		$self->reach_dest();

		return 1;
	}

	# Give up if there are no open spots near them :-/
	return 0;
}

sub face
{
	my $self = shift;
	my $xpos = shift;
	my $ypos = shift;

	my $botd = $FurcData{dir};
	my $targetd = $self->direction_to($xpos,$ypos);

	my %dirs = ('nw' => 1,'ne' => 2, 'se' => 3,'sw' => 4);

	my $difference = $dirs{$targetd} - $dirs{$botd};

	my $times;
	my $direction;


	if ($difference > 0)
	{
		$times = $difference;
		$direction = 0;
	}
	elsif ($difference < 0)
	{
		$times = $difference * -1;
		$direction = 1;
	}

	if ($times == 3)
	{
		$times = 1;
		$direction = $direction ^ 1;
	}

	return unless $times;

	foreach my $i (1 .. $times)
	{
		if ($direction == 0)
		{
			$self->right;
		}
		if ($direction == 1)
		{
			$self->left;
		}
	}
}

sub stop
{
	my $self = shift;

	$self->debug("goto", 4, "Stopping path finding\n");

	$self->pause;

	%FurcTarget = ();

	#$self->twitch;
}

sub pause
{
	my $self = shift;

	%FurcAvoid = ();
	%FurcTried = ();

	$FurcReaching = undef;

	#$self->twitch;
}

sub join
{
	my $self = shift;
	my $name = shift;

	$self->furc_command("join $name");
}

sub summon
{
	my $self = shift;
	my $name = shift;

	$self->furc_command("summon $name");
}

sub left
{
	my $self = shift;

	$self->furc_command("<");
}

sub right
{
	my $self = shift;

	$self->furc_command(">");
}

sub nw
{
	my $self = shift;
	$self->furc_command("m 7");
}

sub ne
{
	my $self = shift;
	$self->furc_command("m 9");
}

sub sw
{
	my $self = shift;
	$self->furc_command("m 1");
}

sub se
{
	my $self = shift;
	$self->furc_command("m 3");
}

sub godir
{
	my $self = shift;
	my $direction = shift;

	return unless defined $Directions{$direction};
	$direction = $Directions{$direction};

	$self->furc_command("m $direction");
}

sub twitch
{
	my $self = shift;

	$self->left;
	$self->right;
}

sub stand
{
	my $self = shift;

	$self->furc_command("stand");
}

sub sit
{
	my $self = shift;

	$self->furc_command("sit");
}

sub lie
{
	my $self = shift;

	$self->furc_command("lie");
}

sub liedown
{
	my $self = shift;

	$self->furc_command("liedown");
}

sub quit
{
	my $self = shift;

	$self->furc_command("quit");
}

# FIXME: Pointless?
sub exit
{
	my $self = shift;

	$self->quit;
}

###############################
# Furcadia Conversion related #

sub pipe_space
{
	# Convert whitespace to pipes

	my $self = shift;

	my $conv = shift;

	$conv =~ s/\s/|/g;
	return $conv;
}

sub int_to_furc
{
	# Convert single integer to Furc

	my $self = shift;
	my $int = shift;

	my $tmp1 = (int($int / 95)) + 32;
	my $tmp2 = (int($int % 95)) + 32;

	return (chr($tmp1) . chr($tmp2));
}

sub furc_to_int
{
	# Convert Furc to integer

	my $self = shift;
	my $furc = shift;

	# FIXME: This is probably a hack ("0" pads Furc numbers)
	if (length($furc) == 1)
	{
		$furc = " $furc";
	}

	my $tmp1 = substr($furc, 0,1);
	my $tmp2 = substr($furc, 1,1);

	return ((ord($tmp1) - 32) * 95) + (ord($tmp2) - 32);
}

sub furc_to_dir
{
	# Convert m 1/3/7/9 to dir

	my $self = shift;
	my $m = shift;

	foreach my $dir (keys %Directions)
	{
		if ($Directions{$dir} == $m)
		{
			return $dir;
		}
	}

	return undef;
}

sub furc_to_gender
{
	my $self = shift;

	my $gender = shift;

	my $gint = $self->furc_to_int($gender);

	# FIXME: Make these global!
	my @glist =
	(
		"female",
		"male",
		"unspecified"
	);

	my $gname = $glist[$gint];

	if (! $gname)
	{
		$self->debug("goto", 4, "Couldn't find gender name from '$gint' ($gender)\n");
	}

	return $gname;
}

sub furc_to_species
{
	my $self = shift;

	my $species = shift;

	my $sint = $self->furc_to_int($species);

	# FIXME: Make these global!
	my @slist =
	(
		"rodent",
		"equine",
		"feline",
		"canine",
		"musteline",
		"lapine",
	);

	my $sname = $slist[$sint];

	if (! $sname)
	{
		$self->debug("goto", 4, "Couldn't find species name from '$sint' ($species)\n");
	}

	return $sname;
}

sub furc_to_pos
{
	# Convert full Furc coordinate to x,y

	my $self = shift;
	my $furc = shift;

	if (!$furc) { return undef }

	my $furcx = substr($furc,0,2);
	my $furcy = substr($furc,2,2);

	my $intx = $self->furc_to_int($furcx) * 2;
	my $inty = $self->furc_to_int($furcy);

	my $imagx = $self->get_imx_pos($intx,$inty);

	#$self->debug("goto", 4, "Converting '$furc' to position: $intx, $inty\n");

	return ($intx, $inty, $imagx);
}

sub pos_to_furc
{
	# Convert x,y to Furc coordinate

	my $self = shift;
	my $xpos = shift;
	my $ypos = shift;

	my $furc = $self->int_to_furc($xpos/2) .
			$self->int_to_furc($ypos);

	return $furc;
}

sub get_imx_pos
{
	my $self = shift;
	my $xpos = shift;
	my $ypos = shift;

	my $imagx = $xpos;

	# If Y is odd number, subtract one from "in middle" number
	if ($ypos & 1) { $imagx-- }

	return $imagx;
}

sub near_furres
{
	my @result;
	foreach my $furre (keys %FurreList)
	{
		push (@result, $furre);
	}
	return @result;
}

sub frame_to_dir
{
	my $self = shift;
	my $frame = shift;

	my $fint = $self->furc_to_int($frame);
	my $direction;

	# Ignore "frameless" furres
	if ($fint == 0)
	{
		return undef;
	}

	# Propagate this using lowest SW frame
	#my @species =
	#(
	#	"1",	# Standard rodent
	#	"41",	# Standard feline
	#	"161",	# Winged feline
	#	"261",	# Dragon
	#	"781",	# Gryphin
	#	"941",	# Squirrel
	#);

	my @frames =
	(
		"sw",
		"se",
		"nw",
		"ne",
	);

	# Example matrix (feline standard)

	# 41-44,57 -- SW
	# 45-48,58 -- SE
	# 49-52,59 -- NW
	# 53-56,60 -- NE

	# Determine the correct bracket
	my $bracket = int ($fint / 10) * 10;
	if ($bracket % 20 == 0 && $bracket > 0)
	{
		if ($bracket == $fint)
		{
			$bracket -= 20;
		}
	}
	elsif ($bracket > 0)
	{
		$bracket -= 10;
	}

	my $min = $bracket + 1;
	my $max = $min + 3;
	my $lie = $min + 16;

	# Loop through and find the appropriate frame
	foreach my $i (0..3)
	{
		if ($fint >= $min && $fint <= $max || $fint == $lie)
		{
			$direction = $frames[$i];

			# Doesn't make any sense... They swapped NE and NW
			if ($fint == $lie)
			{
				if ($direction eq "ne")
				{
					$direction = "nw";
				}
				elsif ($direction eq "nw")
				{
					$direction = "ne";
				}
			}

			#$self->debug("goto", 4, "Calculated direction ($min - $max, $lie) from frame '$frame' [F=$fint,B=$bracket]: $direction\n");

			last;
		}

		$lie++;
		$min += 4;
		$max = $min + 3;
	}


	if (! $direction)
	{
		$self->debug("goto", 1, "Couldn't find direction from frame '$frame' [$fint] -- ($_)\n");
	}

	return $direction;
}

# Read in Furcadia INI file

sub load_ini
{
	my $self = shift;
	my $file = shift;

	my %conf;

	if (!open (CONF, $file))
	{
		$self->debug("settings", 0, "Error parsing INI file $file: $!\n");
		return 0;
	}

	while (<CONF>)
	{
		if (/(.*?)=(.*)/)
		{
			my $key = lc($1);
			my $val = $2;

			# Enable "hash" style configuration options
			# Eg: owners@=Malverian
			#     owners@=Cinder|Bear
			if ($key =~ /(.*?)\@/)
			{
				$key = $1;
				$conf{$key}{$val} = 1;
			}
			else
			{
				$conf{$key} = $val;
			}
		}
	}

	return %conf;
}

sub write_ini
{
	my $self = shift;
	my $file = shift;
	my %conf = @_;

	if (!open (CONF, ">$file"))
	{
		$self->debug("settings", 0, "Couldn't open INI file $file for writing: $!\n");
		return 0;
	}

	foreach my $key (keys (%conf))
	{
		my $val = $conf{$key};
		$key = "\u$key";

		next unless defined($val);

		# If it's an array, print it out with foo@
		if (ref($val) eq 'ARRAY')
		{
			foreach my $sub (@{$val})
			{
				print CONF "$key\@=$sub\n";
			}
		}

		# Same thing for hashes.. so that write_ini(load_ini('some.ini')) will work :-P
		elsif (ref($val) eq 'HASH')
		{
			foreach my $sub (keys %{$val})
			{
				print CONF "$key\@=$sub\n";
			}
		}

		# Anything else should be printed as flat value
		else
		{
			print CONF "$key=$val\n";
		}
	}

	close(CONF);
	
	return 1;
}

####################
# Accessor Methods #

sub ret_pos_list
{
	my $self = shift;
	
	return (%FurrePosList);
}

sub ret_furc_data
{
	my $self = shift;

	return (%FurcData);	
}



##################
# DEBUGGING ONLY #

sub debugmessages
{
	my $self = shift;
	my @messages = @_;
	
	foreach my $debugmsg (@messages)
	{
		if ($debugmsg =~ /^\-(.*)/)
		{
			$DebugMessages{$1} = -1;
		}
		elsif ($debugmsg =~ /^\+?(.*)/)
		{
			$DebugMessages{$1} = 1;
		}
	}
	
	return (%DebugMessages);
}

sub debug
{
	my $self = shift;

	my $package = shift;
	my $level = shift;
	my $data = shift;

	my $nlevel = $DebugLevels[$level];

	return 0 if (defined $DebugMessages{'all'} && $DebugMessages{'all'} < 0);

	if ($DebugMessages{$package} || $DebugMessages{'all'})
	{
		if (!defined $DebugMessages{$package} || $DebugMessages{$package} >= 0)
		{
			if ($WindowsHost)
			{
				$Win32Tray->WriteDebug("[Furcadia->${package}] $data");
			}
			else
			{
				print STDERR "[${nlevel}Furcadia->${package}\e[m] $data";
				#print STDERR "[($$) ${nlevel}Furcadia->${package}\e[m] $data";
			}
		}
		#cluck;
	}
}

sub pretend
{
	my $self = shift;

	$DebugPretend = shift;
}

sub dump_hash
{
	my $hashref = shift;
	foreach my $key ( keys %{$hashref} )
	{
		if ( ref ($hashref->{$key} ) )
		{
			print STDOUT "!! '$key' !!\n";
			dump_hash($hashref->{$key});
		}
		else
		{
			print STDOUT "'$key' = '".$hashref->{$key}."'\n";
		}
	}
}

sub version
{
	# Return the module version

	my $self = shift;
	return $VERSION;
}

1;