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         0x1E => ["return cargo", 1],
 316         0x1F => ["train", 2, \%unit],
 317         0x20 => ["cancel train", 2], # == 254
 318         0x21 => ["cloak", 1],
 319         0x22 => ["decloak", 1],
 320         0x23 => ["hatch", 2, \%unit],
 321         0x25 => ["unsiege", 1],
 322         0x26 => ["siege", 1],
 323         0x27 => ["arm", 0], # scarab/interceptor
 324         0x28 => ["unload all", 1],
 325         0x29 => ["unload", 2],
 326         0x2A => ["merge archon", 0],
 327         0x2B => ["hold position", 1],
 328         0x2C => ["burrow", 1],
 329         0x2D => ["unburrow", 1],
 330         0x2E => ["cancel nuke", 0],
 331         0x2F => ["lift", 2, 2],
 332         0x30 => ["research", 1, \@research],
 333         0x31 => ["cancel research", 0],
 334         0x32 => ["upgrade", 1, \@upgrade],
 335 #       0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
 336         0x35 => ["morph", 2, \%unit],
 337         0x36 => ["stim", 0],
 338         0x57 => ["part", 1, {qw"1 quit  6 drop"}],
 339         0x5A => ["merge dark archon", 0],
 340 );
 341
 342 sub new {
 343         my ($class) = @_;
 344         bless [], $class;
 345 }
 346
 347 sub _read {
 348         my $self = shift;
 349         my ($fh, $size, $seek) = @_;
 350         seek *$fh, $seek, 0 if $seek;
 351         read(*$fh, my $in, $size) eq $size or return undef;
 352         return $in;
 353 }
 354
 355 sub open {
 356         my $self = shift;
 357         my ($file) = @_;
 358
 359         while (not eof $file) {
 360                 local $_ = $self->_read($file, 5)
 361                         and my ($time, $size) = unpack "VC", $_
 362                         or die "Couldn't read time block head\n";
 363                 local $_ = $self->_read($file, $size)
 364                         and my @block = unpack "C*", $_
 365                         or die "Couldn't read time block data\n";
 366                 while (@block) {
 367                         my $player = shift @block;
 368                         my $cmd = shift @block;
 369                         if (not defined $cmdread{$cmd}) {
 370                                 warn sprintf "command #%X not defined: %d bytes ignored\n",
 371                                         $cmd, scalar @block;
 372                                 push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
 373                                 last;
 374                         }
 375
 376                         sub readbyte {
 377                                 my ($data, $byte) = @_;
 378                                 my $out = shift @$data;
 379                                 if (($byte & 3) == 2) {
 380                                         @$data ? ($out += shift(@$data) << 8)
 381                                                 : warn "high byte not present\n";
 382                                 }
 383                                 return $out;
 384                         }
 385
 386                         my @format = @{ $cmdread{$cmd} };
 387                         my $desc = shift @format;
 388                         my @data;
 389                         for my $bit (@format) {
 390                                 if (ref $bit) {
 391                                         if (ref $bit eq "ARRAY") {
 392                                                 $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
 393                                                         : "? ($data[-1])";
 394                                         } else {
 395                                                 $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
 396                                                         : "? ($data[-1])";
 397                                         }
 398                                         next;
 399                                 }
 400                                 $bit & 3 or next;
 401                                 if ($bit & CMD_REPEAT) {
 402                                         push @data, readbyte(\@block, $bit) for 1 .. shift @data;
 403                                 } else {
 404                                         push @data, readbyte(\@block, $bit);
 405                                 }
 406                         }
 407                         $desc eq "move" and $data[2] == 0 and $desc = "rally";
 408                         push @$self, [$time, $player, $desc, @data];
 409                 }
 410         }
 411         return $self;
 412 }
 413
 414 }
 415
 416 sub showtime {
 417         my $time = shift() * .042;
 418         my $minutes = int($time / 60);
 419         return sprintf "%d:%04.1f", $minutes, $time - $minutes * 60;
 420 }
 421
 422 sub unpackhash {
 423         my ($template, $expr, @elements) = @_;
 424         my @data = unpack $template, $expr;
 425         my %map;
 426         $map{$_} = shift @data for @elements;
 427         return (\%map, @data);
 428 }
 429
 430 local $_ = Data::StarCraft::Replay::_read(undef, \*STDIN, 633)
 431         and my ($head, @headdata) = unpackhash("CVa3Va12Z28v2Z16Z24Ca26a38a*", $_, qw(
 432                 engine frames mag1 time mag2 name width height
 433                 unknown1 creator unknown2 map unknown3
 434         ))
 435         or die "Couldn't read replay header\n";
 436
 437 $_ eq "\0\0\110" or warn sprintf(
 438         "Mismatch in first header constant: %s\n",
 439         join ",", map ord, split //, $_
 440 ) for $head->{mag1};
 441 $_ eq "\10"x8 . "\0"x4 or warn sprintf(
 442         "Mismatch in second header constant: %s\n",
 443         join ",", map ord, split //, $_
 444 ) for $head->{mag2};
 445 delete $head->{$_} for qw(mag1 mag2 unknown1 unknown2);
 446
 447 my @playdata = unpack "a36"x12 . "V8C8", $headdata[0]
 448         or die "Couldn't parse player data in replay header\n";
 449
 450 my @player;
 451 push @player, unpackhash("x11Z25", shift @playdata, qw/name/) for 0 .. 11;
 452 $player[$_]->{color} = shift @playdata for 0 .. 7;
 453 $player[$_]->{index} = shift @playdata for 0 .. 7;
 454
 455 printf "%s: %s\n", $_, $head->{$_} for qw(name creator);
 456 use Date::Format;
 457 printf "created: %s\n", time2str('%Y-%m-%d %X', $_) for $head->{time};
 458 printf "map: %s (%dx%d)\n", map $head->{$_}, qw(map width height);
 459 printf "frames: %s (%s)\n", $_, showtime($_) for $head->{frames};
 460 print "\n";
 461
 462 if ($SHOWWARN) {
 463         print Dumper $head;
 464         print Dumper \@player;
 465         #printf ":%s\n", join ",", map sprintf('%X', ord $_), split // for @headdata;
 466         print "\n";
 467 }
 468
 469 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
 470
 471 if ($SHOWWARN) {
 472         for (@$map) {
 473                 my ($time, $player, $desc, @data) = @$_;
 474                 printf("@%s #%d %s: %s\n",
 475                         showtime($time), $player, $desc, join(", ", @data)
 476                 );
 477         }
 478 }
 479
 480 my %cmdmacro = map {$_ => 1} (
 481         (map {$_, "cancel $_"}
 482                 qw/train build hatch research upgrade arm/,
 483         ),
 484         qw/hotkey vision part rally/,
 485         # rally
 486 );
 487
 488 my %stats; # player => count
 489 for (@$map) {
 490         $stats{$_->[1]}{actions}++;
 491         $stats{$_->[1]}{gameactions}++ if $_->[0] >= APM_FIRSTFRAME;
 492         $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
 493         $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
 494         $stats{$_->[1]}{count}{$_->[2]}++;
 495 }
 496
 497 for my $player (sort keys %stats) {
 498         my $row = $stats{$player};
 499         $row->{last} ||= $map->[-1][0];
 500 #       printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
 501         printf("%d:%6d actions in%7d frames (%s) = %d APM\n",
 502                 $player, $row->{actions}, $row->{last},
 503                 showtime($row->{last}),
 504 #               $row->{micro} / $row->{last} * 60 / .042 * 1.05,
 505 #               $row->{macro} / $row->{last} * 60 / .042 * 1.05,
 506                 $row->{gameactions} / ($row->{last} - APM_FIRSTFRAME) * 60 / .042,
 507         );
 508
 509         if (0) {
 510                 my @order; # pos => [ [ pct, cmd ] ]
 511                 my $i = 2;
 512                 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
 513                         for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
 514                 print "build order:\n";
 515                 for (@order) {
 516                         my $lastpos = 0;
 517                         for (@$_) {
 518                                 my ($pos, $txt) = @$_;
 519                                 print ' ' x ($pos*60 - $lastpos);
 520                                 $txt = substr $txt, 0, 8;
 521                                 print $txt;
 522                                 $lastpos = $pos + length $txt;
 523                         }
 524                         print "\n";
 525                 }
 526         }
 527
 528         printf("action distribution: %s\n",
 529                 join(", ", map {
 530                         sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
 531                 } (
 532                         sort {$row->{count}{$b} <=> $row->{count}{$a}}
 533                         keys %{ $row->{count} }
 534                 )[0..7]),
 535         ) if 0;
 536 }
 537