--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Data::Dumper;
+
+my $SHOWWARN = 0;
+
+use Getopt::Long;
+GetOptions(
+ "verbose|v!" => \$SHOWWARN,
+);
+
+{
+
+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],
+ 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;
+}
+
+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)
+ );
+ }
+}
+
+printf "duration: %s\n", showtime($map->[-1][0]);
+
+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] > 80 / .042;
+ $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;%4d APM\n",
+ $player,
+ $row->{actions},
+# $row->{micro} / $row->{last} * 60 / .042 * 1.05,
+# $row->{macro} / $row->{last} * 60 / .042 * 1.05,
+ $row->{gameactions} / $row->{last} * 60 / .042 * 1.042,
+ # $row->{gameactions} / $map->[-1][0] * 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;
+}
+