X-Git-Url: http://git.shiar.net/perl/schtarr.git/blobdiff_plain/d674225247c0e76e85899e5e2a5549fe0ad9c245..65b175df2569427fb67295c5e131c94668fecbf6:/screp

diff --git a/screp b/screp
index 8fb41f5..dc24f05 100755
--- 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