152 lines
3.7 KiB
Perl
152 lines
3.7 KiB
Perl
package Bot::BasicBot::Pluggable::Module::MineCraftCoords;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Data::Dumper;
|
|
|
|
use Text::LevenshteinXS qw(distance);
|
|
use List::Util qw(reduce);
|
|
use Data::Dumper;
|
|
use YAML qw(LoadFile);
|
|
|
|
use JSON::XS;
|
|
use Time::Duration;
|
|
use LWP::Simple qw();
|
|
|
|
# TODO this might need to change if dynmap fixes their json
|
|
our $world_url = "http://map.dirkocraft.com/standalone/dynmap_main.json";
|
|
our $playerstate = {}; # keep these global! is something funny happenign with the modules?
|
|
|
|
our $resdb;
|
|
|
|
sub checkres {
|
|
my ($res, $world, $x, $y, $z) = @_;
|
|
my $areas = $res->{Areas};
|
|
|
|
for my $area (keys %$areas) {
|
|
my ($mx, $my, $mz, $nx, $ny, $nz) = @{$res->{Areas}{$area}}{qw(X2 Y2 Z2 X1 Y1 Z1)};
|
|
my $rworld = $res->{Permissions}{World};
|
|
|
|
print "WORLD: $rworld $world\n";
|
|
|
|
if ($world eq $rworld && $x >= $mx && $y >= $my && $z >= $mz && $x < $nx && $y < $ny && $z < $nz) { # check the rectangle
|
|
return 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub getsubzone
|
|
{
|
|
my ($zones, $world, $x, $y, $z) = @_;
|
|
|
|
for my $zone (keys %$zones) {
|
|
print "CHECKING $zone\n";
|
|
my $zhr = $zones->{$zone};
|
|
if (checkres($zhr, $world, $x, $y, $z)) {
|
|
return ($zone, getsubzone($zhr->{Subzones}, $world, $x, $y, $z));
|
|
}
|
|
}
|
|
|
|
return ();
|
|
}
|
|
|
|
sub findres {
|
|
my ($world, $x, $y, $z) = @_;
|
|
|
|
print Dumper \@_;
|
|
|
|
my @names = getsubzone($resdb->{Residences}, $world, $x, $y, $z);
|
|
|
|
return join ".", @names;
|
|
}
|
|
|
|
sub loadres
|
|
{
|
|
$resdb = LoadFile("var/res.yml");
|
|
}
|
|
|
|
sub get_player_pos {
|
|
my ($user) = @_;
|
|
|
|
return "I don't work from IRC" if ($user eq "IRC");
|
|
|
|
no warnings 'uninitialized';
|
|
if (time - $playerstate->{lastupdate} >= 60) { # only actually update every 60 seconds
|
|
print "FETCHING\n";
|
|
$playerstate->{players} = {}; #clear the users, since i don't want to figure out when people disconnnect
|
|
my $cont = LWP::Simple::get($world_url); # get the json for the server
|
|
my $strut = decode_json($cont);
|
|
|
|
for my $player (@{$strut->{players}}) {
|
|
my $key = lc $player->{name};
|
|
$playerstate->{players}{$key} = $player;
|
|
}
|
|
|
|
$playerstate->{lastupdate} = time;
|
|
loadres();
|
|
}
|
|
|
|
my @peeps = keys %{$playerstate->{players}};
|
|
|
|
my $peep = reduce {$a->[0] > $b->[0] ? $b : $a} map {optipeep($_, $user)} @peeps;
|
|
#print Dumper($peep);
|
|
$user = $peep->[1] if ($peep->[0] < 5); # don't set it if it's too large
|
|
|
|
if (exists($playerstate->{players}{lc $user})) { # we know where that user was
|
|
my $pl = $playerstate->{players}{lc $user};
|
|
my $time = ago(time - $playerstate->{lastupdate}); # TODO does this need to be in perfect sync with above? probably not
|
|
my ($world, $x, $y, $z) = @{$pl}{qw/world x y z/};
|
|
my $resname = findres($world, $x, $y, $z);
|
|
my $coords = sprintf "world '%s' at %dx %dy %dz", $world, int $x, $y+1, int $z, $resname;
|
|
my $realname = $pl->{name};
|
|
my $out = "$realname was in ";
|
|
|
|
if ($resname) {
|
|
$out .= $resname . " ($coords)";
|
|
} else {
|
|
$out .= "($coords)";
|
|
}
|
|
|
|
$out .= " $time";
|
|
return $out;
|
|
} else {
|
|
return "Are you sure that '$user' is on? They might be in the nether where I can't see.";
|
|
}
|
|
}
|
|
|
|
sub optipeep {
|
|
my ($peep, $input) = @_;
|
|
|
|
my $l = length($input);
|
|
|
|
#print "CHECKING $input $peep\n";
|
|
|
|
my $min = [length($peep)*10, $peep]; # set maxes
|
|
for my $p (0..length($peep)-length($input)) {
|
|
my $subpeep = substr($peep, $p, $l);
|
|
my $d = distance($input, substr($peep, $p, $l));
|
|
# print "LOOKING $p $subpeep $d\n";
|
|
if ($d <= $min->[0]) {
|
|
$min = [$d, $peep]
|
|
}
|
|
}
|
|
|
|
return $min;
|
|
}
|
|
|
|
sub told {
|
|
my ($self, $mess) = @_;
|
|
|
|
if ($mess->{body} =~ /^\s*\?coords\s*(.*?)?\s*$/ && $mess->{channel} eq "#main") {
|
|
my $person = $1;
|
|
|
|
$person = $mess->{who} unless $person;
|
|
|
|
return get_player_pos($person);
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
1;
|