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 my $map = Data::StarCraft::Replay->new->open(\*STDIN);
 421
 422 if ($SHOWWARN) {
 423         for (@$map) {
 424                 my ($time, $player, $desc, @data) = @$_;
 425                 printf("@%s #%d %s: %s\n",
 426                         showtime($time), $player, $desc, join(", ", @data)
 427                 );
 428         }
 429 }
 430
 431 printf "duration: %s\n", showtime($map->[-1][0]);
 432
 433 my %cmdmacro = map {$_ => 1} (
 434         (map {$_, "cancel $_"}
 435                 qw/train build hatch research upgrade arm/,
 436         ),
 437         qw/hotkey vision part rally/,
 438         # rally
 439 );
 440
 441 my %stats; # player => count
 442 for (@$map) {
 443         $stats{$_->[1]}{actions}++;
 444         $stats{$_->[1]}{gameactions}++ if $_->[0] > 80 / .042;
 445         $stats{$_->[1]}{last} = $_->[0] if $_->[2] eq "part";
 446         $stats{$_->[1]}{$cmdmacro{$_->[2]} ? "macro" : "micro"}++;
 447         $stats{$_->[1]}{count}{$_->[2]}++;
 448 }
 449
 450 for my $player (sort keys %stats) {
 451         my $row = $stats{$player};
 452         $row->{last} ||= $map->[-1][0];
 453 #       printf("%d:%6d actions (%3d micro,%4d macro);%4d APM\n",
 454         printf("%d:%6d actions;%4d APM\n",
 455                 $player,
 456                 $row->{actions},
 457 #               $row->{micro} / $row->{last} * 60 / .042 * 1.05,
 458 #               $row->{macro} / $row->{last} * 60 / .042 * 1.05,
 459                 $row->{gameactions} / $row->{last} * 60 / .042 * 1.042,
 460         #       $row->{gameactions} / $map->[-1][0] * 60 / .042,
 461         );
 462
 463         if (0) {
 464                 my @order; # pos => [ [ pct, cmd ] ]
 465                 my $i = 2;
 466                 push @{$order[++$i % 16]}, [ ($_->[0] / $row->{last}), $_->[6] ]
 467                         for grep {$_->[1] == $player and $_->[2] eq "build"} @$map;
 468                 print "build order:\n";
 469                 for (@order) {
 470                         my $lastpos = 0;
 471                         for (@$_) {
 472                                 my ($pos, $txt) = @$_;
 473                                 print ' ' x ($pos*60 - $lastpos);
 474                                 $txt = substr $txt, 0, 8;
 475                                 print $txt;
 476                                 $lastpos = $pos + length $txt;
 477                         }
 478                         print "\n";
 479                 }
 480         }
 481
 482         printf("action distribution: %s\n",
 483                 join(", ", map {
 484                         sprintf "%s (%d%%)", $_, $row->{count}{$_} / $row->{actions} * 100
 485                 } (
 486                         sort {$row->{count}{$b} <=> $row->{count}{$a}}
 487                         keys %{ $row->{count} }
 488                 )[0..7]),
 489         ) if 0;
 490 }
 491