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