From: Shiar <shiar@shiar.org>
Date: Fri, 1 Feb 2008 03:35:18 +0000 (+0100)
Subject: game capture prototype
X-Git-Url: http://git.shiar.net/perl/schtarr.git/commitdiff_plain/4ad6c9f100edebbf01f95cdf30412cacfab7e21d?hp=65b175df2569427fb67295c5e131c94668fecbf6

game capture prototype

Parses game screenshots (either by display capture or reading image files).
Writes animated gif of minimap area, and tries to parse the game status
texts (player stats and replay time). Character parsing is done as a match
of total color value per pixel column (cannot distinguish between certain
digits), but at least it's a working setup.
---

diff --git a/capture b/capture
new file mode 100644
index 0000000..91304aa
--- /dev/null
+++ b/capture
@@ -0,0 +1,144 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use Image::Magick;
+use constant {DEBUG => 0};
+
+our $VERSION = '1.00';
+
+my @digitchar = (0..9, ':', ' ');
+my @digittime = (
+	[744, 372, 372, 744], # 0
+	[186, 1116], # 1
+	[558, 558, 558, 558], # 2
+	[372, 372, 558, 558], # 3
+	[372, 372, 1116, 186], # 4
+	[558, 558, 558, -558], # 5
+	[744, 558, 558, 558], # 6
+	[255, 640, 1025, 895, 539], ## 7
+	[1020, 648, 510, 648, 1020], ## 8
+	[558, 558, 558, 744], # 9
+	[372], ## /
+	[], # -
+);
+my @digitgreen = (
+	[1344, 393, 255, 393, 1344], # 0
+	[255, 409, 1530], # 1
+	[863, 709, 664, 799, 648], # 2
+	[579, 393, 510, 648, 1089], # 3
+	[640, 709, 709, 1530, 255], # 4
+	[523, 895, 510, 770, 1150], # 5
+	[1344, 786, 648, 648, 1089], # 6
+	[255, 640, 1025, 895, 539], # 7
+	[1020, 648, 510, 648, 1020], # 8
+	[903, 648, 510, 648, 1344], # 9
+	[199, 887, 709], ## /
+
+#	[1344, 417, 263, 393, 1344, 32], # 0
+#	[255, 417, 1530, 40], # 1
+#	[863, 725, 680, 807, 656, 16], # 2
+#	[579, 401, 518, 656, 1089, 24], # 3
+#	[640, 717, 725, 1530, 287, 8], # 4
+#	[523, 903, 526, 778, 1158, 24], ## 5
+#	[1344, 786, 656, 656, 1097, 24], ## 6
+#	[255, 648, 1033, 911, 547, 8], # 7
+#	[1028, 656, 526, 664, 1028, 24], # 8
+#	[903, 656, 526, 656, 1344, 32], # 9
+#	[199, 887, 725, 16], ## /
+
+	[], # -
+);
+
+my %colorgreen = (
+#	8 => [8, 8],
+	69 => [0, 0],
+	130 => [8, 8],
+	154 => [33, 33],
+	255 => [16, 24],
+);
+
+sub getrect2 {
+	my ($digit, $valid, $data, $w, $h, $x1, $x2) = @_;
+
+	my ($str, @char);
+	my $count = -1;
+	for my $x ($x1 .. $x2) {
+		my $colval = 0;
+		for my $y (0 .. $h - 1) {
+			my @val;
+			push @val => $data->[($x + $y*$w) * 3 + $_] >> 8 for 0 .. 2;
+printf("  [%s]\n", join ', ', @val) if DEBUG >= 2;
+			my $match = $valid->{$val[1]} or next;
+			$val[0] == $match->[0] and $val[2] == $match->[1] or next;
+print "  ok\n" if DEBUG >= 2;
+			$colval += $val[1];
+		}
+
+		if ($colval > 0 and ($count < 0 or $count++ < 6)) {
+			push @char => $colval;
+		} elsif (@char) {
+printf " %d: [%s], # %d\n", $x, join(', ', @char), $count if DEBUG >= 1;
+			my @matches;
+			for my $match (@$digit) {
+				if (scalar @$match == scalar @char) {
+					my $offset = 0;
+					$offset += abs $char[$_] - $match->[$_] for 0 .. $#char;
+					push @matches => $offset;
+				} else {
+					push @matches => -1;
+				}
+			}
+			undef @char;
+			$count = 0;
+
+			my $best;
+			$matches[$_] == 0 and $best = $_ for 0 .. $#matches;
+			if (not defined $best) {
+				my @best;
+				$matches[$_] > 0 and push @best, $_
+					for sort {$matches[$a] <=> $matches[$b]} 0 .. $#matches;
+printf "candidates: (%s)\n", join ', ', map {"$_ ($matches[$_])"} @best;
+				$best = shift @best;
+			}
+			$str .= defined $best ? $best eq '' ? '' : $digitchar[$best] : '?';
+		}
+	}
+	return $str;
+}
+
+my $map = Image::Magick->new(128, 128);
+my $curtime = 0;
+
+for my $i ($ARGV[0] .. $ARGV[1]) {
+	my $image = Image::Magick->new;
+	my $err = $image->Read(sprintf 's%05d.png', $i);
+	$err and die $err;
+	my @pixels = $image->GetPixels(map=>'RGB', x=>452, width=>187, y=>6, height=>6);
+	my $min = getrect2(\@digitgreen, \%colorgreen, \@pixels, 187, 6, 0, 39);
+	my $gas = getrect2(\@digitgreen, \%colorgreen, \@pixels, 187, 6, 68, 107);
+	my $unit = getrect2(\@digitgreen, \%colorgreen, \@pixels, 187, 6, 136, 181);
+	my ($unitcur, $unitmax) = split /:/, $unit, 2;
+
+	@pixels = $image->GetPixels(map=>'RGB', x=>587, width=>34, y=>396, height=>6);
+	my $time = getrect2(\@digittime, {186 => [189, 239]}, \@pixels, 34, 6, 0, 33);
+	my $sec;
+	$time =~ /^(\d\d):(\d\d)$/ and $sec = $1*60 + $2;
+
+	printf "%d:\t%s\t%s\t%s\t%s\t%s\n", $i, $sec, $min, $gas, $unitcur, $unitmax;
+	$image->Crop(width=>128, height=>128, x=>6, y=>348);
+#	$image->Set(delay => $sec > $curtime ? ($sec - $curtime) / 5 : 10);
+	$image->Set(10);
+	push @$map => $image;
+	$curtime = $sec;
+}
+
+my $err = $map->Write('map.gif');
+$err and die $err;
+#print $map->Layers(method => 'optimize');
+
+print "\n";
+print "\n";
+