starcraft replay parser
[perl/schtarr.git] / screp
diff --git a/screp b/screp
new file mode 100755 (executable)
index 0000000..1922415
--- /dev/null
+++ b/screp
@@ -0,0 +1,491 @@
+#!/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;
+}
+