X-Git-Url: http://git.shiar.nl/perl/schtarr.git/blobdiff_plain/65b175df2569427fb67295c5e131c94668fecbf6..4ad6c9f100edebbf01f95cdf30412cacfab7e21d:/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";
+