From 4ad6c9f100edebbf01f95cdf30412cacfab7e21d Mon Sep 17 00:00:00 2001
From: Shiar <shiar@shiar.org>
Date: Fri, 1 Feb 2008 04:35:18 +0100
Subject: [PATCH] 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.
---
 capture | 144 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 144 insertions(+)
 create mode 100644 capture

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";
+
-- 
2.30.0