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