#!/usr/bin/perl -w
use strict;
######################################################################
# This is best used like...
# ./parser.pl --nodmx --hook spawn.pm captures/artemis-blah | perl
# It will output proximity info about spawned and deleted objects,
# so you can (EG) find out who spawned a Torp or a Drone, who it was
# near when it was deleted, or what got sucked into a blackhole
######################################################################

BEGIN { require "parser.pl"; } # we are based on parser.pl EXCEPT...
our %ObjTypes; # will come from parser.pl

my %obj; # will store all the details of all the objects "in-game"

# because we are about to legitimately redefine some functions...
no warnings qw(redefine);

# Override this so we do NOT attempt to output DEADBEEF binary from
# any of the "normal" parser.pl perl-to-binary functions we've NOT
# overridden:
sub SendPacket {}

# Override this so we keep strings printable, NOT convert to Artemis UTF16:
sub UTF16 { return Data::Dumper::qquote(shift); }

# Override this so we can store the params passed to ObjNPC or whatever:
sub ObjGeneric {
    my ($type, $id, @params) = @_;
    return $id unless @params; # because objectDelete(ObjTorpedo(1960)) needs to work
    my $name = $ObjTypes{$type}[0];
    
    # if this is the first time we have seen it...
    my $this = $obj{$id} //= {
	_type => $type,
	_name => $name,
	_id   => $id,
    };
    # store all the other values:
    while (@params) {
	my $key = shift @params;
	$this->{$key} = shift @params;
    }
    
    return if $this->{_done}++;
    
    # This is a newly-spawned object! Find out what it's near!
    proximity($name, $id, 'spawned', $this);
}

sub objectDelete {
    my $id = shift;
    # delete this object
    my $this = delete $obj{$id} or return;
    proximity($this->{_name}, $this->{_id}, 'deleted', $this);
}

sub Kaboom {
    my $id = shift;
    my $this = $obj{$id} or return;
    proximity($this->{_name}, $this->{_id}, 'kaboom', $this);
}

sub proximity {
    my ($name, $id, $what, $this) = @_;
    
    my $x1 = $this->{X} // -100000;
    my $y1 = $this->{Y} // 0;
    my $z1 = $this->{Z} // -100000;
    my %dist;
    for my $obj2 (values %obj) {
	my $x2 = ($obj2->{X} // -100000) - $x1;
	my $y2 = ($obj2->{Y} // 0)       - $y1;
	my $z2 = ($obj2->{Z} // -100000) - $z1;
	# actually the SQUARE of the distance but we only care about sort order anyway:
	$dist{$obj2->{_id}} = ($x2*$x2) + ($y2*$y2) + ($z2*$z2) // 10000000000;
    }
    my $n = 0;
    print ObjDesc($this), " $what near";
    for (sort {$dist{$a} <=> $dist{$b}} keys %dist) {
	next if $_ == $id;
	print " ", ObjDesc($obj{$_});
	last if ++$n >= 10;
    }
    print "\n";
}

sub ObjDesc {
    my $obj  = shift;
    my $name = $obj->{_name} // '?';
    my $side = $obj->{Side}  // '?';
    my $Y    = $obj->{Y} // '?';
    my $un16 = $obj->{Unknown16} // '?';
    return "$name(Side=$side,Y=$Y,Un16=$un16)";
}

1; # valid perl modules need to return true