Merge commit 'raz/master'
[perl/schtarr.git] / screp
diff --git a/screp b/screp
index 8fb41f5b4e5c03749660151d8857665479c58cde..dc24f05259d103026a968787d00f6ff0c21dcedc 100755 (executable)
--- a/screp
+++ b/screp
@@ -2,10 +2,12 @@
 use strict;
 use warnings;
 use Data::Dumper;
+use Data::StarCraft::Replay;
 
 our $VERSION = '1.01';
 
 my $SHOWWARN = 0;
+my $ACTGIF = undef;
 my $APMSVG = undef;
 my $DBNAME = undef;
 my $DBGAME = undef;
@@ -14,414 +16,13 @@ use Getopt::Long qw(:config bundling auto_version auto_help);
 GetOptions(
        "verbose|v!" => \$SHOWWARN,
        "apm|a=s" => \$APMSVG,
+       "act" => \$ACTGIF,
        "dbname|D=s" => \$DBNAME,
        "dbid|d=s" => \$DBGAME,
 );
 
 use constant { APM_FIRSTFRAME => 80 / .042 };
 
-{
-
-package Data::StarCraft::Replay;
-
-use Data::Dumper;
-
-use constant {
-       CMD_REPEAT => 4,
-};
-
-my %build = (
-       0x19 => "morph",
-       0x1E => "build",
-       0x1F => "warp",
-       0x24 => "add-on",
-       0x2E => "evolve",
-       0x47 => "land",
-);
-my %unit = (
-       0x00 => "Marine",
-       0x01 => "Ghost",
-       0x02 => "Vulture",
-       0x03 => "Goliath",
-       #               undef,
-       0x05 => "Siege Tank",
-       #               undef,
-       0x07 => "SCV",
-       0x08 => "Wraith",
-       0x09 => "Science Vessel",
-       #               undef,
-       0x0B => "Dropship",
-       0x0C => "Battlecruiser",
-       #               undef,
-       0x0E => "Nuke",
-       #               (undef) x 0x11,
-       0x20 => "Firebat",
-       #               undef,
-       0x22 => "Medic",
-       #               undef,
-       #               undef,
-       0x25 => "Zergling",
-       0x26 => "Hydralisk",
-       0x27 => "Ultralisk",
-       #               undef,
-       0x29 => "Drone",
-       0x2A => "Overlord",
-       0x2B => "Mutalisk",
-       0x2C => "Guardian",
-       0x2D => "Queen",
-       0x2E => "Defiler",
-       0x2F => "Scourge",
-       #               undef,
-       #               undef,
-       0x32 => "Infested Terran",
-       #               (undef) x 7,
-       0x3A => "Valkyrie",
-       #               undef,
-       0x3C => "Corsair",
-       0x3D => "Dark Templar",
-       0x3E => "Devourer",
-       #               undef,
-       0x40 => "Probe",
-       0x41 => "Zealot",
-       0x42 => "Dragoon",
-       0x43 => "High Templar",
-       #               undef,
-       0x45 => "Shuttle",
-       0x46 => "Scout",
-       0x47 => "Arbiter",
-       0x48 => "Carrier",
-       #               (undef) x 0x0A,
-       0x53 => "Reaver",
-       0x54 => "Observer",
-       #               (undef) x 0x12,
-       0x67 => "Lurker",
-       #               undef,
-       #               undef,
-       0x6A => "Command Center",
-       0x6B => "ComSat",
-       0x6C => "Nuclear Silo",
-       0x6D => "Supply Depot",
-       0x6E => "Refinery", # refinery?
-       0x6F => "Barracks",
-       0x70 => "Academy", # Academy?
-       0x71 => "Factory",
-       0x72 => "Starport",
-       0x73 => "Control Tower",
-       0x74 => "Science Facility",
-       0x75 => "Covert Ops",
-       0x76 => "Physics Lab",
-       #               undef,
-       0x78 => "Machine Shop",
-       #               undef,
-       0x7A => "Engineering Bay",
-       0x7B => "Armory",
-       0x7C => "Missile Turret",
-       0x7D => "Bunker",
-       #               (undef) x 4,
-       0x82 => "Infested CC",
-       0x83 => "Hatchery",
-       0x84 => "Lair",
-       0x85 => "Hive",
-       0x86 => "Nydus Canal",
-       0x87 => "Hydralisk Den",
-       0x88 => "Defiler Mound",
-       0x89 => "Greater Spire",
-       0x8A => "Queens Nest",
-       0x8B => "Evolution Chamber",
-       0x8C => "Ultralisk Cavern",
-       0x8D => "Spire",
-       0x8E => "Spawning Pool",
-       0x8F => "Creep Colony",
-       0x90 => "Spore Colony",
-       #               undef,
-       0x92 => "Sunken Colony",
-       #               undef,
-       #               undef,
-       0x95 => "Extractor",
-       #               (undef) x 4,
-       0x9A => "Nexus",
-       0x9B => "Robotics Facility",
-       0x9C => "Pylon",
-       0x9D => "Assimilator",
-       #               undef,
-       0x9F => "Observatory",
-       0xA0 => "Gateway",
-       #               undef,
-       0xA2 => "Photon Cannon",
-       0xA3 => "Citadel of Adun",
-       0xA4 => "Cybernetics Core",
-       0xA5 => "Templar Archives",
-       0xA6 => "Forge",
-       0xA7 => "Stargate",
-       #               undef,
-       0xA9 => "Fleet Beacon",
-       0xAA => "Arbiter Tribunal",
-       0xAB => "Robotics Support Bay",
-       0xAC => "Shield Battery",
-       #               (undef) x 0x14,
-       0xC0 => "Larva",
-       0xC1 => "Rine/Bat",
-       0xC2 => "Dark Archon",
-       0xC3 => "Archon",
-       0xC4 => "Scarab",
-       0xC5 => "Interceptor",
-       0xC6 => "Interceptor/Scarab",
-);
-my @upgrade = (
-       "Terran Infantry Armor",
-       "Terran Vehicle Plating",
-       "Terran Ship Plating",
-       "Zerg Carapace",
-       "Zerg Flyer Carapace",
-       "Protoss Ground Armor",
-       "Protoss Air Armor",
-       "Terran Infantry Weapons",
-       "Terran Vehicle Weapons",
-       "Terran Ship Weapons",
-       "Zerg Melee Attacks",
-       "Zerg Missile Attacks",
-       "Zerg Flyer Attacks",
-       "Protoss Ground Weapons",
-       "Protoss Air Weapons",
-       "Protoss Plasma Shields",
-       # 0x10
-       "U-238 Shells (Marine Range)",
-       "Ion Thrusters (Vulture Speed)",
-       undef,
-       "Titan Reactor (Science Vessel Energy)",
-       "Ocular Implants (Ghost Sight)",
-       "Moebius Reactor (Ghost Energy)",
-       "Apollo Reactor (Wraith Energy)",
-       "Colossus Reactor (Battle Cruiser Energy)",
-       "Ventral Sacs (Overlord Transport)",
-       "Antennae (Overlord Sight)",
-       "Pneumatized Carapace (Overlord Speed)",
-       "Metabolic Boost (Zergling Speed)",
-       "Adrenal Glands (Zergling Attack)",
-       "Muscular Augments (Hydralisk Speed)",
-       "Grooved Spines (Hydralisk Range)",
-       "Gamete Meiosis (Queen Energy)",
-       # 0x20
-       "Defiler Energy",
-       "Singularity Charge (Dragoon Range)",
-       "Leg Enhancement (Zealot Speed)",
-       "Scarab Damage",
-       "Reaver Capacity",
-       "Gravitic Drive (Shuttle Speed)",
-       "Sensor Array (Observer Sight)",
-       "Gravitic Booster (Observer Speed)",
-       "Khaydarin Amulet (Templar Energy)",
-       "Apial Sensors (Scout Sight)",
-       "Gravitic Thrusters (Scout Speed)",
-       "Carrier Capacity",
-       "Khaydarin Core (Arbiter Energy)",
-       undef,
-       undef,
-       "Argus Jewel (Corsair Energy)",
-       # 0x30
-       undef,
-       "Argus Talisman (Dark Archon Energy)",
-       "Caduceus Reactor (Medic Energy)",
-       "Chitinous Plating (Ultralisk Armor)",
-       "Anabolic Synthesis (Ultralisk Speed)",
-       "Charon Boosters (Goliath Range)",
-);
-my @research = (
-       "Stim Pack",
-       "Lockdown",
-       "EMP Shockwave",
-       "Spider Mines",
-       undef,
-       "Siege Tank",
-       undef,
-       "Irradiate",
-       "Yamato Gun",
-       "Cloaking Field (wraith)",
-       "Personal Cloaking (ghost)",
-       "Burrow",
-       undef,
-       "Spawn Broodling",
-       undef,
-       "Plague",
-       # 0x10
-       "Consume",
-       "Ensnare",
-       undef,
-       "Psionic Storm",
-       "Hallucination",
-       "Recall",
-       "Stasis Field",
-       undef,
-       "Restoration",
-       "Disruption Web",
-       undef,
-       "Mind Control",
-       undef,
-       undef,
-       "Optical Flare",
-       "Maelstrom",
-       # 0x20
-       "Lurker Aspect",
-);
-my %action = (
-       0x00 => "Move",
-       0x02 => "Unallowed Move?",
-       0x06 => "Force move",
-       0x08 => "Attack",
-       0x09 => "Gather",
-       0x0E => "Attack Move",
-       0x13 => "Failed Casting (?)",
-       0x17 => "#23 (?)",
-       0x1B => "Infest CC",
-       0x22 => "Repair",
-       0x27 => "Clear Rally",
-       0x28 => "Set Rally",
-       0x4F => "Gather",
-       0x50 => "Gather",
-       0x70 => "Unload",
-       0x71 => "Yamato",
-       0x73 => "Lockdown",
-       0x77 => "Dark Swarm",
-       0x78 => "Parasite",
-       0x79 => "Spawn Broodling",
-       0x7A => "EMP",
-       0x7E => "Launch Nuke",
-       0x84 => "Lay Mine",
-       0x8B => "ComSat Scan",
-       0x8D => "Defense Matrix",
-       0x8E => "Psionic Storm",
-       0x8F => "Recall",
-       0x90 => "Plague",
-       0x91 => "Consume",
-       0x92 => "Ensnare",
-       0x93 => "Stasis",
-       0x94 => "Hallucination",
-       0x98 => "Patrol",
-       0xB1 => "Heal",
-       0xB4 => "Restore",
-       0xB5 => "Disruption Web",
-       0xB6 => "Mind Control",
-       0xB8 => "Feedback",
-       0xB9 => "Optic Flare",
-       0xBA => "Maelstrom",
-       0xC0 => "Irradiate",
-);
-
-my %cmdread = (
-       0x09 => ["select", 1, 2 | CMD_REPEAT],
-       0x0A => ["add", 1, 2 | CMD_REPEAT],
-       0x0B => ["deselect", 1, 2 | CMD_REPEAT],
-       0x0C => ["build", 1, \%build, 2, 2, 2, \%unit],
-       0x0D => ["vision", 2],
-       0x0E => ["ally", 2, 2],
-       0x13 => ["hotkey", 1, [qw"assign select"], 1],
-       0x14 => ["move", 2, 2, 2, 2, 1], # 1 = queued?
-       0x15 => ["action", 2, 2, 2, 2, 1, \%action, 1, [qw"normal queued"]],
-       0x18 => ["cancel"],
-       0x19 => ["cancel hatch"],
-       0x1A => ["stop", 1],
-#      0x1B => ["move-thing??"], # tim: after hotkey (unit, reaver??) select; soon after reselected and moved
-       0x1E => ["return cargo", 1],
-       0x1F => ["train", 2, \%unit],
-       0x20 => ["cancel train", 2], # == 254
-       0x21 => ["cloak", 1],
-       0x22 => ["decloak", 1],
-       0x23 => ["hatch", 2, \%unit],
-       0x25 => ["unsiege", 1],
-       0x26 => ["siege", 1],
-       0x27 => ["arm", 0], # scarab/interceptor
-       0x28 => ["unload all", 1],
-       0x29 => ["unload", 2],
-       0x2A => ["merge archon", 0],
-       0x2B => ["hold position", 1],
-       0x2C => ["burrow", 1],
-       0x2D => ["unburrow", 1],
-       0x2E => ["cancel nuke", 0],
-       0x2F => ["lift", 2, 2],
-       0x30 => ["research", 1, \@research],
-       0x31 => ["cancel research", 0],
-       0x32 => ["upgrade", 1, \@upgrade],
-#      0x33 => ["forge-thing??"], # right after forge select: probably unpowered, iirc cancel research
-       0x35 => ["morph", 2, \%unit],
-       0x36 => ["stim", 0],
-       0x57 => ["part", 1, {qw"1 quit  6 drop"}],
-       0x5A => ["merge dark archon", 0],
-);
-
-sub new {
-       my ($class) = @_;
-       bless [], $class;
-}
-
-sub _read {
-       my $self = shift;
-       my ($fh, $size, $seek) = @_;
-       seek *$fh, $seek, 0 if $seek;
-       read(*$fh, my $in, $size) eq $size or return undef;
-       return $in;
-}
-
-sub open {
-       my $self = shift;
-       my ($file) = @_;
-
-       while (not eof $file) {
-               local $_ = $self->_read($file, 5)
-                       and my ($time, $size) = unpack "VC", $_
-                       or die "Couldn't read time block head\n";
-               local $_ = $self->_read($file, $size)
-                       and my @block = unpack "C*", $_
-                       or die "Couldn't read time block data\n";
-               while (@block) {
-                       my $player = shift @block;
-                       my $cmd = shift @block;
-                       if (not defined $cmdread{$cmd}) {
-                               warn sprintf "command #%X not defined: %d bytes ignored\n",
-                                       $cmd, scalar @block;
-                               push @$self, [$time, $player, "??? $cmd"] if $SHOWWARN;
-                               last;
-                       }
-
-                       sub readbyte {
-                               my ($data, $byte) = @_;
-                               my $out = shift @$data;
-                               if (($byte & 3) == 2) {
-                                       @$data ? ($out += shift(@$data) << 8)
-                                               : warn "high byte not present\n";
-                               }
-                               return $out;
-                       }
-
-                       my @format = @{ $cmdread{$cmd} };
-                       my $desc = shift @format;
-                       my @data;
-                       for my $bit (@format) {
-                               if (ref $bit) {
-                                       if (ref $bit eq "ARRAY") {
-                                               $data[-1] = defined $bit->[$data[-1]] ? $bit->[$data[-1]]
-                                                       : "? ($data[-1])";
-                                       } else {
-                                               $data[-1] = defined $bit->{$data[-1]} ? $bit->{$data[-1]}
-                                                       : "? ($data[-1])";
-                                       }
-                                       next;
-                               }
-                               $bit & 3 or next;
-                               if ($bit & CMD_REPEAT) {
-                                       push @data, readbyte(\@block, $bit) for 1 .. shift @data;
-                               } else {
-                                       push @data, readbyte(\@block, $bit);
-                               }
-                       }
-                       $desc eq "move" and $data[2] == 0 and $desc = "rally";
-                       push @$self, [$time, $player, $desc, @data];
-               }
-       }
-       return $self;
-}
-
-}
-
 my @race = (qw(Z T P), (undef) x 3, '-');
 
 sub showtime {
@@ -568,6 +169,53 @@ for my $player (sort keys %stats) {
        ) if 0;
 }
 
+if ($ACTGIF) {
+       open my $imgfile, '>', "test.gif" or die;
+       binmode $imgfile;
+       select $imgfile;
+
+       use GD;
+       my $ani = GD::Image->new($head->{width}, $head->{height});
+       my $bg = $ani->colorAllocate(0, 0, 0);
+       my @plot = (
+               $ani->colorAllocate(255, 0, 0),
+               $ani->colorAllocate(255, 255, 0),
+               $ani->colorAllocate(0, 255, 0),
+               $ani->colorAllocate(0, 255, 255),
+               $ani->colorAllocate(0, 0, 255),
+               $ani->colorAllocate(255, 0, 255),
+       );
+
+       print $ani->gifanimbegin;
+#      print $ani->gifanimadd;
+       {
+               my $frame = GD::Image->new($ani->getBounds);
+               print $frame->gifanimadd;
+               my $length = 30 / .042;
+               my $last = 0;
+               for (@$map) {
+                       my ($time, $player, $cmd, @data) = @$_;
+#$time < $length * 10 or last;
+                       while ($time > $last + $length) {
+                               $last += $length;
+                               print $frame->gifanimadd(0, 0, 0, 32);
+#                              $frame = GD::Image->new($ani->getBounds);
+                       }
+                       if ($cmd eq "build") {
+                               $frame->setPixel($data[1]>>5, $data[2]>>5, $plot[$player]);
+                       }
+                       elsif ($cmd eq "move" or $cmd eq "attack") {
+                               $frame->setPixel($data[0]>>5, $data[1]>>5, $plot[$player]);
+#                                      if $data[2] == 0xFFFF_FFFF;
+                       }
+               }
+#              add_frame_data($frame);
+               print $frame->gifanimadd;
+       }
+       print $ani->gifanimend;
+       select STDOUT;
+}
+
 use Games::StarCraft::DB;
 my $Db = Games::StarCraft::DB->connect({RaiseError => 1})
        or die "No database: $DBI::errstr\n";
@@ -727,6 +375,7 @@ screp [options] < [replay data]
  Options:
    --verbose
    --apm
+   --act
    --dbname
    --dbid