Data-StarCraft/lib/Data/StarCraft/Replay.pm

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