screp

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Data::Dumper;
   5
   6 my $SHOWWARN = 0;
   7
   8 use Getopt::Long;
   9 GetOptions(
  10         "verbose|v!" => \$SHOWWARN,
  11 );
  12
  13 use constant { APM_FIRSTFRAME => 80 / .042 };
  14
  15 {
  16
  17 package Data::StarCraft::Replay;
  18
  19 use Data::Dumper;
  20
  21 use constant {
  22         CMD_REPEAT => 4,
  23 };
  24
  25 my %build = (
  26         0x19 => "morph",
  27         0x1E => "build",
  28         0x1F => "warp",
  29         0x24 => "add-on",
  30         0x2E => "evolve",
  31         0x47 => "land",
  32 );
  33 my %unit = (
  34         0x00 => "Marine",
  35         0x01 => "Ghost",
  36         0x02 => "Vulture",
  37         0x03 => "Goliath",
  38         #               undef,
  39         0x05 => "Siege Tank",
  40         #               undef,
  41         0x07 => "SCV",
  42         0x08 => "Wraith",
  43         0x09 => "Science Vessel",
  44         #               undef,
  45         0x0B => "Dropship",
  46         0x0C => "Battlecruiser",
  47         #               undef,
  48         0x0E => "Nuke",
  49         #               (undef) x 0x11,
  50         0x20 => "Firebat",
  51         #               undef,
  52         0x22 => "Medic",
  53         #               undef,
  54         #               undef,
  55         0x25 => "Zergling",
  56         0x26 => "Hydralisk",
  57         0x27 => "Ultralisk",
  58         #               undef,
  59         0x29 => "Drone",
  60         0x2A => "Overlord",
  61         0x2B => "Mutalisk",
  62         0x2C => "Guardian",
  63         0x2D => "Queen",
  64         0x2E => "Defiler",
  65         0x2F => "Scourge",
  66         #               undef,
  67         #               undef,
  68         0x32 => "Infested Terran",
  69         #               (undef) x 7,
  70         0x3A => "Valkyrie",
  71         #               undef,
  72         0x3C => "Corsair",
  73         0x3D => "Dark Templar",
  74         0x3E => "Devourer",
  75         #               undef,
  76         0x40 => "Probe",
  77         0x41 => "Zealot",
  78         0x42 => "Dragoon",
  79         0x43 => "High Templar",
  80         #               undef,
  81         0x45 => "Shuttle",
  82         0x46 => "Scout",
  83         0x47 => "Arbiter",
  84         0x48 => "Carrier",
  85         #               (undef) x 0x0A,
  86         0x53 => "Reaver",
  87         0x54 => "Observer",
  88         #               (undef) x 0x12,
  89         0x67 => "Lurker",
  90         #               undef,
  91         #               undef,
  92         0x6A => "Command Center",
  93         0x6B => "ComSat",
  94         0x6C => "Nuclear Silo",
  95         0x6D => "Supply Depot",
  96         0x6E => "Refinery", # refinery?
  97         0x6F => "Barracks",
  98         0x70 => "Academy", # Academy?
  99         0x71 => "Factory",
 100         0x72 => "Starport",
 101         0x73 => "Control Tower",
 102         0x74 => "Science Facility",
 103         0x75 => "Covert Ops",
 104         0x76 => "Physics Lab",
 105         #               undef,
 106         0x78 => "Machine Shop",
 107         #               undef,
 108         0x7A => "Engineering Bay",
 109         0x7B => "Armory",
 110         0x7C => "Missile Turret",
 111         0x7D => "Bunker",
 112         #               (undef) x 4,
 113         0x82 => "Infested CC",
 114         0x83 => "Hatchery",
 115         0x84 => "Lair",
 116         0x85 => "Hive",
 117         0x86 => "Nydus Canal",
 118         0x87 => "Hydralisk Den",
 119         0x88 => "Defiler Mound",
 120         0x89 => "Greater Spire",
 121         0x8A => "Queens Nest",
 122         0x8B => "Evolution Chamber",
 123         0x8C => "Ultralisk Cavern",
 124         0x8D => "Spire",
 125         0x8E => "Spawning Pool",
 126         0x8F => "Creep Colony",
 127         0x90 => "Spore Colony",
 128         #               undef,
 129         0x92 => "Sunken Colony",
 130         #               undef,
 131         #               undef,
 132         0x95 => "Extractor",
 133         #               (undef) x 4,
 134         0x9A => "Nexus",
 135         0x9B => "Robotics Facility",
 136         0x9C => "Pylon",
 137         0x9D => "Assimilator",
 138         #               undef,
 139         0x9F => "Observatory",
 140         0xA0 => "Gateway",
 141         #               undef,
 142         0xA2 => "Photon Cannon",
 143         0xA3 => "Citadel of Adun",
 144         0xA4 => "Cybernetics Core",
 145         0xA5 => "Templar Archives",
 146         0xA6 => "Forge",
 147         0xA7 => "Stargate",
 148         #               undef,
 149         0xA9 => "Fleet Beacon",
 150         0xAA => "Arbiter Tribunal",
 151         0xAB => "Robotics Support Bay",
 152         0xAC => "Shield Battery",
 153         #               (undef) x 0x14,
 154         0xC0 => "Larva",
 155         0xC1 => "Rine/Bat",
 156         0xC2 => "Dark Archon",
 157         0xC3 => "Archon",
 158         0xC4 => "Scarab",
 159         0xC5 => "Interceptor",
 160         0xC6 => "Interceptor/Scarab",
 161 );
 162 my @upgrade = (
 163         "Terran Infantry Armor",
 164         "Terran Vehicle Plating",
 165         "Terran Ship Plating",
 166         "Zerg Carapace",
 167         "Zerg Flyer Carapace",
 168         "Protoss Ground Armor",
 169         "Protoss Air Armor",
 170         "Terran Infantry Weapons",
 171         "Terran Vehicle Weapons",
 172         "Terran Ship Weapons",
 173         "Zerg Melee Attacks",
 174         "Zerg Missile Attacks",
 175         "Zerg Flyer Attacks",
 176         "Protoss Ground Weapons",
 177         "Protoss Air Weapons",
 178         "Protoss Plasma Shields",
 179         # 0x10
 180         "U-238 Shells (Marine Range)",
 181         "Ion Thrusters (Vulture Speed)",
 182         undef,
 183         "Titan Reactor (Science Vessel Energy)",
 184         "Ocular Implants (Ghost Sight)",
 185         "Moebius Reactor (Ghost Energy)",
 186         "Apollo Reactor (Wraith Energy)",
 187         "Colossus Reactor (Battle Cruiser Energy)",
 188         "Ventral Sacs (Overlord Transport)",
 189         "Antennae (Overlord Sight)",
 190         "Pneumatized Carapace (Overlord Speed)",
 191         "Metabolic Boost (Zergling Speed)",
 192         "Adrenal Glands (Zergling Attack)",
 193         "Muscular Augments (Hydralisk Speed)",
 194         "Grooved Spines (Hydralisk Range)",
 195         "Gamete Meiosis (Queen Energy)",
 196         # 0x20
 197         "Defiler Energy",
 198         "Singularity Charge (Dragoon Range)",
 199         "Leg Enhancement (Zealot Speed)",
 200         "Scarab Damage",
 201         "Reaver Capacity",
 202         "Gravitic Drive (Shuttle Speed)",
 203         "Sensor Array (Observer Sight)",
 204         "Gravitic Booster (Observer Speed)",
 205         "Khaydarin Amulet (Templar Energy)",
 206         "Apial Sensors (Scout Sight)",
 207         "Gravitic Thrusters (Scout Speed)",
 208         "Carrier Capacity",
 209         "Khaydarin Core (Arbiter Energy)",
 210         undef,
 211         undef,
 212         "Argus Jewel (Corsair Energy)",
 213         # 0x30
 214         undef,
 215         "Argus Talisman (Dark Archon Energy)",
 216         "Caduceus Reactor (Medic Energy)",
 217         "Chitinous Plating (Ultralisk Armor)",
 218         "Anabolic Synthesis (Ultralisk Speed)",
 219         "Charon Boosters (Goliath Range)",
 220 );
 221 my @research = (
 222         "Stim Pack",
 223         "Lockdown",
 224         "EMP Shockwave",
 225         "Spider Mines",
 226         undef,
 227         "Siege Tank",
 228         undef,
 229         "Irradiate",
 230         "Yamato Gun",
 231         "Cloaking Field (wraith)",
 232         "Personal Cloaking (ghost)",
 233         "Burrow",
 234         undef,
 235         "Spawn Broodling",
 236         undef,
 237         "Plague",
 238         # 0x10
 239         "Consume",
 240         "Ensnare",
 241         undef,
 242         "Psionic Storm",
 243         "Hallucination",
 244         "Recall",
 245         "Stasis Field",
 246         undef,
 247         "Restoration",
 248         "Disruption Web",
 249         undef,
 250         "Mind Control",
 251         undef,
 252         undef,
 253         "Optical Flare",
 254         "Maelstrom",
 255         # 0x20
 256         "Lurker Aspect",
 257 );
 258 my %action = (
 259         0x00 => "Move",
 260         0x02 => "Unallowed Move?",
 261         0x06 => "Force move",
 262         0x08 => "Attack",
 263         0x09 => "Gather",
 264         0x0E => "Attack Move",
 265         0x13 => "Failed Casting (?)",
 266         0x17 => "#23 (?)",
 267         0x1B => "Infest CC",
 268         0x22 => "Repair",
 269         0x27 => "Clear Rally",
 270         0x28 => "Set Rally",
 271         0x4F => "Gather",
 272         0x50 => "Gather",
 273         0x70 => "Unload",
 274         0x71 => "Yamato",
 275         0x73 => "Lockdown",
 276         0x77 => "Dark Swarm",
 277         0x78 => "Parasite",
 278         0x79 => "Spawn Broodling",
 279         0x7A => "EMP",
 280         0x7E => "Launch Nuke",
 281         0x84 => "Lay Mine",
 282         0x8B => "ComSat Scan",
 283         0x8D => "Defense Matrix",
 284         0x8E => "Psionic Storm",
 285         0x8F => "Recall",
 286         0x90 => "Plague",
 287         0x91 => "Consume",
 288         0x92 => "Ensnare",
 289         0x93 => "Stasis",
 290         0x94 => "Hallucination",
 291         0x98 => "Patrol",
 292         0xB1 => "Heal",
 293         0xB4 => "Restore",
 294         0xB5 => "Disruption Web",
 295         0xB6 => "Mind Control",
 296         0xB8 => "Feedback",
 297         0xB9 => "Optic Flare",
 298         0xBA => "Maelstrom",
 299         0xC0 => "Irradiate",
 300 );
 301
 302 my %cmdread = (
 303         0x09 => ["select", 1, 2 | CMD_REPEAT],
 304         0x0A => ["add", 1, 2 | CMD_REPEAT],
 305         0x0B => ["deselect", 1, 2 | CMD_REPEAT],
 306         0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
 307         0x0D => ["vision", 2],
 308         0x0E => ["ally", 2, 2],
 309         0x13 => ["hotkey", 1, [qw"assign select"], 1],
 310         0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
 311         0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
 312         0x18 => ["cancel"],
 313         0x19 => ["cancel hatch"],
 314         0x1A => ["stop", 1],
 315 #       0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
 316         0x1E => ["return cargo", 1],
 317         0x1F => ["train", 2, \%unit],
 318         0x20 => ["cancel train", 2], # == 254
 319         0x21 => ["cloak", 1],
 320         0x22 => ["decloak", 1],
 321         0x23 => ["hatch", 2, \%unit],
 322         0x25 => ["unsiege", 1],
 323         0x26 => ["siege", 1],
 324         0x27 => ["arm", 0], # scarab/interceptor
 325         0x28 => ["unload all", 1],
 326         0x29 => ["unload", 2],
 327         0x2A => ["merge archon", 0],
 328         0x2B => ["hold position", 1],
 329         0x2C => ["burrow", 1],
 330         0x2D => ["unburrow", 1],
 331         0x2E => ["cancel nuke", 0],
 332         0x2F => ["lift", 2, 2],
 333         0x30 => ["research", 1, \@research],
 334         0x31 => ["cancel research", 0],
 335         0x32 => ["upgrade", 1, \@upgrade],
 336 #       0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
 337         0x35 => ["morph", 2, \%unit],
 338         0x36 => ["stim", 0],
 339         0x57 => ["part", 1, {qw"1 quit  6 drop"}],
 340         0x5A => ["merge dark archon", 0],
 341 );
 342
 343 sub new {
 344         my ($class) = @_;
 345         bless [], $class;
 346 }
 347
 348 sub _read {
 349         my $self = shift;
 350         my ($fh, $size, $seek) = @_;
 351         seek *$fh, $seek, 0 if $seek;
 352         read(*$fh, my $in, $size) eq $size or return undef;
 353         return $in;
 354 }
 355
 356 sub open {
 357         my $self = shift;
 358         my ($file) = @_;
 359
 360         while (not eof $file) {
 361                 local $_ = $self->_read($file, 5)
 362                         and my ($time, $size) = unpack "VC", $_
 363                         or die "Couldn't read time block head\n";
 364                 local $_ = $self->_read($file, $size)
 365                         and my @block = unpack "C*", $_
 366                         or die "Couldn't read time block data\n";
 367                 while (@block) {
 368                         my $player = shift @block;
 369                         my $cmd = shift @block;
 370                         if (not defined $cmdread{$cmd}) {
 371                                 warn sprintf "command #%X not defined: %d bytes ignored\n",
 372                                         $cmd, scalar @block;
 373                                 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
 374                                 last;
 375                         }
 376
 377                         sub readbyte {
 378                                 my ($data, $byte) = @_;
 379                                 my $out = shift @$data;
 380                                 if (($byte & 3) == 2) {
 381                                         @$data ? ($out += shift(@$data) << 8)
 382                                                 : warn "high byte not present\n";
 383                                 }
 384                                 return $out;
 385                         }
 386
 387                         my @format = @{ $cmdread{$cmd} };
 388                         my $desc = shift @format;
 389                         my @data;
 390                         for my $bit (@format) {
 391                                 if (ref $bit) {
 392                                         if (ref $bit eq "ARRAY") {
 393                                                 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
 394                                                         : "? ($data[-1])";
 395                                         } else {
 396                                                 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
 397                                                         : "? ($data[-1])";
 398                                         }
 399                                         next;
 400                                 }
 401                                 $bit & 3 or next;
 402                                 if ($bit & CMD_REPEAT) {
 403                                         push @data, readbyte(\@block, $bit) for 1 .. shift @data;
 404                                 } else {
 405                                         push @data, readbyte(\@block, $bit);
 406                                 }
 407                         }
 408                         $desc eq "move" and $data[2] == 0 and $desc = "rally";
 409                         push @$self, [$time, $player, $desc, @data];
 410                 }
 411         }
 412         return $self;
 413 }
 414
 415 }
 416
 417 sub showtime {
 418         my $time = shift() * .042;
 419         my $minutes = int($time / 60);
 420         return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
 421 }
 422
 423 sub unpackhash {
 424         my ($template, $expr, @elements) = @_;
 425         my @data = unpack $template, $expr;
 426         my %map;
 427         $map{$_} = shift @data for @elements;
 428         return (\%map, @data);
 429 }
 430
 431 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
 432         and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24CZ26a38a*", $_, qw(
 433                 engine frames mag1 time mag2 name width height
 434                 unknown1 creator unknown2 map unknown3
 435         ))
 436         or die "Couldn't read replay header\n";
 437
 438 $_ eq "\0\0\110" or warn sprintf(
 439         "Mismatch in first header constant: %s\n",
 440         join ",", map ord, split //, $_
 441 ) for $head->{mag1};
 442 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
 443         "Mismatch in second header constant: %s\n",
 444         join ",", map ord, split //, $_
 445 ) for $head->{mag2};
 446 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
 447
 448 my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
 449         or die "Couldn't parse player data in replay header\n";
 450
 451 my @player;
 452 push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
 453 $player[$_]->{color} = shift @playdata for 0 .. 7;
 454 $player[$_]->{index} = shift @playdata for 0 .. 7;
 455
 456 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
 457 use Date::Format;
 458 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
 459 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
 460 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
 461 print "\n";
 462
 463 if ($SHOWWARN) {
 464         print Dumper $head;
 465         print Dumper \@player;
 466         #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
 467         print "\n";
 468 }
 469
 470 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
 471
 472 if ($SHOWWARN) {
 473         for (@$map) {
 474                 my ($time, $player, $desc, @data) = @$_;
 475                 printf("@%s #%d %s: %s\n",
 476                         showtime($time), $player, $desc, join(", ", @data)
 477                 );
 478         }
 479 }
 480
 481 my %cmdmacro = map {$_ => 1} (
 482         (map {$_, "cancel $_"}
 483                 qw/train build hatch research upgrade arm/,
 484         ),
 485         qw/hotkey vision part rally/,
 486         # rally
 487 );
 488
 489 my %stats; # player => count
 490 for (@$map) {
 491         $stats{$_->[1]}{actions}++;
 492         $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
 493         $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
 494         $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
 495         $stats{$_->[1]}{count}{$_->[2]}++;
 496 }
 497
 498 for my $player (sort keys %stats) {
 499         my $row = $stats{$player};
 500         $row->{last} ||= $map->[-1][0];
 501 #       printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
 502         printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
 503                 $player, $row->{actions}, $row->{last},
 504                 showtime($row->{last}),
 505 #               $row->{micro} / $row->{last} * 60 / .042 * 1.05,
 506 #               $row->{macro} / $row->{last} * 60 / .042 * 1.05,
 507                 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
 508         );
 509
 510         if (0) {
 511                 my @order; # pos => [ [ pct, cmd ] ]
 512                 my $i = 2;
 513                 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
 514                         for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
 515                 print "build order:\n";
 516                 for (@order) {
 517                         my $lastpos = 0;
 518                         for (@$_) {
 519                                 my ($pos, $txt) = @$_;
 520                                 print ' ' x ($pos*60 - $lastpos);
 521                                 $txt = substr $txt, 0, 8;
 522                                 print $txt;
 523                                 $lastpos = $pos + length $txt;
 524                         }
 525                         print "\n";
 526                 }
 527         }
 528
 529         printf("action distribution: %s\n",
 530                 join(", ", map {
 531                         sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
 532                 } (
 533                         sort {$row->{count}{$b} <=> $row->{count}{$a}}
 534                         keys %{ $row->{count} }
 535                 )[0..7]),
 536         ) if 0;
 537 }
 538