#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my $SHOWWARN = 0;

use Getopt::Long;
GetOptions(
	"verbose|v!" => \$SHOWWARN,
);

use constant { APM_FIRSTFRAME => 80 / .042 };

{

package Data::StarCraft::Replay;

use Data::Dumper;

use constant {
	CMD_REPEAT => 4,
};

my %build = (
	0x19 => "morph",
	0x1E => "build",
	0x1F => "warp",
	0x24 => "add-on",
	0x2E => "evolve",
	0x47 => "land",
);
my %unit = (
	0x00 => "Marine",
	0x01 => "Ghost",
	0x02 => "Vulture",
	0x03 => "Goliath",
	#		undef,
	0x05 => "Siege Tank",
	#		undef,
	0x07 => "SCV",
	0x08 => "Wraith",
	0x09 => "Science Vessel",
	#		undef,
	0x0B => "Dropship",
	0x0C => "Battlecruiser",
	#		undef,
	0x0E => "Nuke",
	#		(undef) x 0x11,
	0x20 => "Firebat",
	#		undef,
	0x22 => "Medic",
	#		undef,
	#		undef,
	0x25 => "Zergling",
	0x26 => "Hydralisk",
	0x27 => "Ultralisk",
	#		undef,
	0x29 => "Drone",
	0x2A => "Overlord",
	0x2B => "Mutalisk",
	0x2C => "Guardian",
	0x2D => "Queen",
	0x2E => "Defiler",
	0x2F => "Scourge",
	#		undef,
	#		undef,
	0x32 => "Infested Terran",
	#		(undef) x 7,
	0x3A => "Valkyrie",
	#		undef,
	0x3C => "Corsair",
	0x3D => "Dark Templar",
	0x3E => "Devourer",
	#		undef,
	0x40 => "Probe",
	0x41 => "Zealot",
	0x42 => "Dragoon",
	0x43 => "High Templar",
	#		undef,
	0x45 => "Shuttle",
	0x46 => "Scout",
	0x47 => "Arbiter",
	0x48 => "Carrier",
	#		(undef) x 0x0A,
	0x53 => "Reaver",
	0x54 => "Observer",
	#		(undef) x 0x12,
	0x67 => "Lurker",
	#		undef,
	#		undef,
	0x6A => "Command Center",
	0x6B => "ComSat",
	0x6C => "Nuclear Silo",
	0x6D => "Supply Depot",
	0x6E => "Refinery", # refinery?
	0x6F => "Barracks",
	0x70 => "Academy", # Academy?
	0x71 => "Factory",
	0x72 => "Starport",
	0x73 => "Control Tower",
	0x74 => "Science Facility",
	0x75 => "Covert Ops",
	0x76 => "Physics Lab",
	#		undef,
	0x78 => "Machine Shop",
	#		undef,
	0x7A => "Engineering Bay",
	0x7B => "Armory",
	0x7C => "Missile Turret",
	0x7D => "Bunker",
	#		(undef) x 4,
	0x82 => "Infested CC",
	0x83 => "Hatchery",
	0x84 => "Lair",
	0x85 => "Hive",
	0x86 => "Nydus Canal",
	0x87 => "Hydralisk Den",
	0x88 => "Defiler Mound",
	0x89 => "Greater Spire",
	0x8A => "Queens Nest",
	0x8B => "Evolution Chamber",
	0x8C => "Ultralisk Cavern",
	0x8D => "Spire",
	0x8E => "Spawning Pool",
	0x8F => "Creep Colony",
	0x90 => "Spore Colony",
	#		undef,
	0x92 => "Sunken Colony",
	#		undef,
	#		undef,
	0x95 => "Extractor",
	#		(undef) x 4,
	0x9A => "Nexus",
	0x9B => "Robotics Facility",
	0x9C => "Pylon",
	0x9D => "Assimilator",
	#		undef,
	0x9F => "Observatory",
	0xA0 => "Gateway",
	#		undef,
	0xA2 => "Photon Cannon",
	0xA3 => "Citadel of Adun",
	0xA4 => "Cybernetics Core",
	0xA5 => "Templar Archives",
	0xA6 => "Forge",
	0xA7 => "Stargate",
	#		undef,
	0xA9 => "Fleet Beacon",
	0xAA => "Arbiter Tribunal",
	0xAB => "Robotics Support Bay",
	0xAC => "Shield Battery",
	#		(undef) x 0x14,
	0xC0 => "Larva",
	0xC1 => "Rine/Bat",
	0xC2 => "Dark Archon",
	0xC3 => "Archon",
	0xC4 => "Scarab",
	0xC5 => "Interceptor",
	0xC6 => "Interceptor/Scarab",
);
my @upgrade = (
	"Terran Infantry Armor",
	"Terran Vehicle Plating",
	"Terran Ship Plating",
	"Zerg Carapace",
	"Zerg Flyer Carapace",
	"Protoss Ground Armor",
	"Protoss Air Armor",
	"Terran Infantry Weapons",
	"Terran Vehicle Weapons",
	"Terran Ship Weapons",
	"Zerg Melee Attacks",
	"Zerg Missile Attacks",
	"Zerg Flyer Attacks",
	"Protoss Ground Weapons",
	"Protoss Air Weapons",
	"Protoss Plasma Shields",
	# 0x10
	"U-238 Shells (Marine Range)",
	"Ion Thrusters (Vulture Speed)",
	undef,
	"Titan Reactor (Science Vessel Energy)",
	"Ocular Implants (Ghost Sight)",
	"Moebius Reactor (Ghost Energy)",
	"Apollo Reactor (Wraith Energy)",
	"Colossus Reactor (Battle Cruiser Energy)",
	"Ventral Sacs (Overlord Transport)",
	"Antennae (Overlord Sight)",
	"Pneumatized Carapace (Overlord Speed)",
	"Metabolic Boost (Zergling Speed)",
	"Adrenal Glands (Zergling Attack)",
	"Muscular Augments (Hydralisk Speed)",
	"Grooved Spines (Hydralisk Range)",
	"Gamete Meiosis (Queen Energy)",
	# 0x20
	"Defiler Energy",
	"Singularity Charge (Dragoon Range)",
	"Leg Enhancement (Zealot Speed)",
	"Scarab Damage",
	"Reaver Capacity",
	"Gravitic Drive (Shuttle Speed)",
	"Sensor Array (Observer Sight)",
	"Gravitic Booster (Observer Speed)",
	"Khaydarin Amulet (Templar Energy)",
	"Apial Sensors (Scout Sight)",
	"Gravitic Thrusters (Scout Speed)",
	"Carrier Capacity",
	"Khaydarin Core (Arbiter Energy)",
	undef,
	undef,
	"Argus Jewel (Corsair Energy)",
	# 0x30
	undef,
	"Argus Talisman (Dark Archon Energy)",
	"Caduceus Reactor (Medic Energy)",
	"Chitinous Plating (Ultralisk Armor)",
	"Anabolic Synthesis (Ultralisk Speed)",
	"Charon Boosters (Goliath Range)",
);
my @research = (
	"Stim Pack",
	"Lockdown",
	"EMP Shockwave",
	"Spider Mines",
	undef,
	"Siege Tank",
	undef,
	"Irradiate",
	"Yamato Gun",
	"Cloaking Field (wraith)",
	"Personal Cloaking (ghost)",
	"Burrow",
	undef,
	"Spawn Broodling",
	undef,
	"Plague",
	# 0x10
	"Consume",
	"Ensnare",
	undef,
	"Psionic Storm",
	"Hallucination",
	"Recall",
	"Stasis Field",
	undef,
	"Restoration",
	"Disruption Web",
	undef,
	"Mind Control",
	undef,
	undef,
	"Optical Flare",
	"Maelstrom",
	# 0x20
	"Lurker Aspect",
);
my %action = (
	0x00 => "Move",
	0x02 => "Unallowed Move?",
	0x06 => "Force move",
	0x08 => "Attack",
	0x09 => "Gather",
	0x0E => "Attack Move",
	0x13 => "Failed Casting (?)",
	0x17 => "#23 (?)",
	0x1B => "Infest CC",
	0x22 => "Repair",
	0x27 => "Clear Rally",
	0x28 => "Set Rally",
	0x4F => "Gather",
	0x50 => "Gather",
	0x70 => "Unload",
	0x71 => "Yamato",
	0x73 => "Lockdown",
	0x77 => "Dark Swarm",
	0x78 => "Parasite",
	0x79 => "Spawn Broodling",
	0x7A => "EMP",
	0x7E => "Launch Nuke",
	0x84 => "Lay Mine",
	0x8B => "ComSat Scan",
	0x8D => "Defense Matrix",
	0x8E => "Psionic Storm",
	0x8F => "Recall",
	0x90 => "Plague",
	0x91 => "Consume",
	0x92 => "Ensnare",
	0x93 => "Stasis",
	0x94 => "Hallucination",
	0x98 => "Patrol",
	0xB1 => "Heal",
	0xB4 => "Restore",
	0xB5 => "Disruption Web",
	0xB6 => "Mind Control",
	0xB8 => "Feedback",
	0xB9 => "Optic Flare",
	0xBA => "Maelstrom",
	0xC0 => "Irradiate",
);

my %cmdread = (
	0x09 => ["select", 1, 2 | CMD_REPEAT],
	0x0A => ["add", 1, 2 | CMD_REPEAT],
	0x0B => ["deselect", 1, 2 | CMD_REPEAT],
	0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
	0x0D => ["vision", 2],
	0x0E => ["ally", 2, 2],
	0x13 => ["hotkey", 1, [qw"assign select"], 1],
	0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
	0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
	0x18 => ["cancel"],
	0x19 => ["cancel hatch"],
	0x1A => ["stop", 1],
#	0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
	0x1E => ["return cargo", 1],
	0x1F => ["train", 2, \%unit],
	0x20 => ["cancel train", 2], # == 254
	0x21 => ["cloak", 1],
	0x22 => ["decloak", 1],
	0x23 => ["hatch", 2, \%unit],
	0x25 => ["unsiege", 1],
	0x26 => ["siege", 1],
	0x27 => ["arm", 0], # scarab/interceptor
	0x28 => ["unload all", 1],
	0x29 => ["unload", 2],
	0x2A => ["merge archon", 0],
	0x2B => ["hold position", 1],
	0x2C => ["burrow", 1],
	0x2D => ["unburrow", 1],
	0x2E => ["cancel nuke", 0],
	0x2F => ["lift", 2, 2],
	0x30 => ["research", 1, \@research],
	0x31 => ["cancel research", 0],
	0x32 => ["upgrade", 1, \@upgrade],
#	0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
	0x35 => ["morph", 2, \%unit],
	0x36 => ["stim", 0],
	0x57 => ["part", 1, {qw"1 quit  6 drop"}],
	0x5A => ["merge dark archon", 0],
);

sub new {
	my ($class) = @_;
	bless [], $class;
}

sub _read {
	my $self = shift;
	my ($fh, $size, $seek) = @_;
	seek *$fh, $seek, 0 if $seek;
	read(*$fh, my $in, $size) eq $size or return undef;
	return $in;
}

sub open {
	my $self = shift;
	my ($file) = @_;

	while (not eof $file) {
		local $_ = $self->_read($file, 5)
			and my ($time, $size) = unpack "VC", $_
			or die "Couldn't read time block head\n";
		local $_ = $self->_read($file, $size)
			and my @block = unpack "C*", $_
			or die "Couldn't read time block data\n";
		while (@block) {
			my $player = shift @block;
			my $cmd = shift @block;
			if (not defined $cmdread{$cmd}) {
				warn sprintf "command #%X not defined: %d bytes ignored\n",
					$cmd, scalar @block;
				push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
				last;
			}

			sub readbyte {
				my ($data, $byte) = @_;
				my $out = shift @$data;
				if (($byte & 3) == 2) {
					@$data ? ($out += shift(@$data) << 8)
						: warn "high byte not present\n";
				}
				return $out;
			}

			my @format = @{ $cmdread{$cmd} };
			my $desc = shift @format;
			my @data;
			for my $bit (@format) {
				if (ref $bit) {
					if (ref $bit eq "ARRAY") {
						$data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
							: "? ($data[-1])";
					} else {
						$data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
							: "? ($data[-1])";
					}
					next;
				}
				$bit & 3 or next;
				if ($bit & CMD_REPEAT) {
					push @data, readbyte(\@block, $bit) for 1 .. shift @data;
				} else {
					push @data, readbyte(\@block, $bit);
				}
			}
			$desc eq "move" and $data[2] == 0 and $desc = "rally";
			push @$self, [$time, $player, $desc, @data];
		}
	}
	return $self;
}

}

sub showtime {
	my $time = shift() * .042;
	my $minutes = int($time / 60);
	return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
}

sub unpackhash {
	my ($template, $expr, @elements) = @_;
	my @data = unpack $template, $expr;
	my %map;
	$map{$_} = shift @data for @elements;
	return (\%map, @data);
}

local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
	and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
		engine frames mag1 time mag2 name width height
		unknown1 creator unknown2 map unknown3
	))
	or die "Couldn't read replay header\n";

$_ eq "\0\0\110" or warn sprintf(
	"Mismatch in first header constant: %s\n",
	join ",", map ord, split //, $_
) for $head->{mag1};
$_ eq "\10"x8 . "\0"x4 or warn sprintf(
	"Mismatch in second header constant: %s\n",
	join ",", map ord, split //, $_
) for $head->{mag2};
delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);

my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
	or die "Couldn't parse player data in replay header\n";

my @player;
push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
$player[$_]->{color} = shift @playdata for 0 .. 7;
$player[$_]->{index} = shift @playdata for 0 .. 7;

printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
use Date::Format;
printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
print "\n";

if ($SHOWWARN) {
	print Dumper $head;
	print Dumper \@player;
	#printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
	print "\n";
}

my $map = Data::StarCraft::Replay->new->open(\*STDIN);

if ($SHOWWARN) {
	for (@$map) {
		my ($time, $player, $desc, @data) = @$_;
		printf("@%s #%d %s: %s\n",
			showtime($time), $player, $desc, join(", ", @data)
		);
	}
}

my %cmdmacro = map {$_ => 1} (
	(map {$_, "cancel $_"}
		qw/train build hatch research upgrade arm/,
	),
	qw/hotkey vision part rally/,
	# rally
);

my %stats; # player => count
for (@$map) {
	$stats{$_->[1]}{actions}++;
	$stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
	$stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
	$stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
	$stats{$_->[1]}{count}{$_->[2]}++;
}

for my $player (sort keys %stats) {
	my $row = $stats{$player};
	$row->{last} ||= $map->[-1][0];
#	printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
	printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
		$player, $row->{actions}, $row->{last},
		showtime($row->{last}),
#		$row->{micro} / $row->{last} * 60 / .042 * 1.05,
#		$row->{macro} / $row->{last} * 60 / .042 * 1.05,
		$row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
	);

	if (0) {
		my @order; # pos => [ [ pct, cmd ] ]
		my $i = 2;
		push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
			for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
		print "build order:\n";
		for (@order) {
			my $lastpos = 0;
			for (@$_) {
				my ($pos, $txt) = @$_;
				print ' ' x ($pos*60 - $lastpos);
				$txt = substr $txt, 0, 8;
				print $txt;
				$lastpos = $pos + length $txt;
			}
			print "\n";
		}
	}

	printf("action distribution: %s\n",
		join(", ", map {
			sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
		} (
			sort {$row->{count}{$b} <=> $row->{count}{$a}}
			keys %{ $row->{count} }
		)[0..7]),
	) if 0;
}