use warnings;
use Data::Dumper;
-use Image::Magick;
+use Time::HiRes qw(sleep alarm);
+use Imager;
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], ## /
-
- [], # -
+our $VERSION = '2.00';
+
+my %digittime = (
+ '.####.'.
+ '#....#'.
+ '#....#'.
+ '.####.' => 0,
+ '...#..'.
+ '######' => 1,
+ '##..#.'.
+ '#.#..#'.
+ '#.#..#'.
+ '#..##.' => 2,
+ '.#..#.'.
+ '#....#'.
+ '#.#..#'.
+ '.#.##.' => 3,
+ '..##..'.
+ '..#.#.'.
+ '######'.
+ '..#...' => 4,
+ '.#.##.'.
+ '#..#.#'.
+ '#..#.#'.
+ '.##..#' => 5,
+ '.####.'.
+ '#..#.#'.
+ '#..#.#'.
+ '.##..#' => 6,
+ '.....#'.
+ '###..#'.
+ '...###'.
+ '.....#' => 7,
+ '.#.##.'.
+ '#.#..#'.
+ '#.#..#'.
+ '.#.##.' => 8,
+ '#..##.'.
+ '#.#..#'.
+ '#.#..#'.
+ '.####.' => 9,
+ '#..#..' => ':',
);
-my %colorgreen = (
-# 8 => [8, 8],
- 69 => [0, 0],
- 130 => [8, 8],
- 154 => [33, 33],
- 255 => [16, 24],
+my %digitgreen = (
+ '.#####.'.
+ '#.....#'.
+ '#.....#'.
+ '#.....#'.
+ '.#####.' => 0,
+ '....#..'.
+ '....#..'.
+ '#######' => 1,
+ '##...#.'.
+ '#.#...#'.
+ '#.#...#'.
+ '#..#...'.
+ '#...##.' => 2,
+ '.#...#.'.
+ '#.....#'.
+ '#..#..#'.
+ '#..#..#'.
+ '.##.##.' => 3,
+ '..##...'.
+ '..#.#..'.
+ '..#..#.'.
+ '#######'.
+ '..#....' => 4,
+ '.#.....'.
+ '#...###'.
+ '#...#.#'.
+ '#...#.#'.
+ '.###..#' => 5,
+ '.#####.'.
+ '#...#.#'.
+ '#...#.#'.
+ '#...#.#'.
+ '.###..#' => 6,
+ '......#'.
+ '##....#'.
+ '..##..#'.
+ '....###'.
+ '......#' => 7,
+ '.##.##.'.
+ '#..#..#'.
+ '#..#..#'.
+ '#..#..#'.
+ '.##.##.' => 8,
+ '#..###.'.
+ '#.#...#'.
+ '#.#...#'.
+ '#.#...#'.
+ '.#####.' => 9,
+ '#......'.
+ '..##...'.
+ '.....##' => ':',
);
-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];
- }
+my $i = 0;
- 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;
+=cut
+sub filter_color {
+ my $input = shift;
+ my ($r, $g, $b) = @_;
+ Imager::transform2({
+ rpnexpr => <<'EOT',
+x y getp1 !pix
+@pix red r eq
+@pix green g eq and
+@pix blue b eq and
+35 0 0 rgb 46 0 0 rgb ifp
+EOT
+ constants => {r => $r, g => $g, b => $b},
+ }, $input)->convert(preset => 'red')->rotate(right => 90);
+}
+=cut
+
+sub filter_color {
+ my $input = shift;
+ my @output; # line => cols_ascii
+ for my $y (reverse 0 .. $input->getheight-1) {
+ my $colors = $input->getsamples(y => $y);
+ for (my $x = 0; length $colors; $x++) {
+ my $pixel = substr $colors, 0, 3, '';
+ my $match = '.';
+ for (@_) {
+ $pixel eq $_ and $match = '#', last;
}
- $str .= defined $best ? $best eq '' ? '' : $digitchar[$best] : '?';
+ $output[$x] .= $match;
}
}
- return $str;
+ return \@output;
+}
+
+sub getchars {
+ my $input = shift;
+ my ($charmap, $width, $y1, $y2) = @_;
+ my @chars = '';
+ for my $y ($y1 .. $y2) {
+# my $row = scalar $input->getsamples(y => $y);
+ my $row = $input->[$y];
+ if ($row eq '.' x $width) {
+ push @chars => ''; # next character
+ } else {
+ $chars[-1] .= $row; # add line
+ }
+ }
+ return join '',
+ map { defined $charmap->{$_} ? $charmap->{$_} : '?' }
+ grep { $_ ne '' } @chars;
+}
+
+sub parsestats {
+ my $input = shift; # (452,6)-(639,13)
+ $input->write(file => sprintf "tests%05d.png", $i) or warn $input->errstr
+ if DEBUG;
+ my $stats = filter_color($input, "\020\377\030", "\317\030\030", "\310\030\030"); # ?/10FF18 | C81818/CF1818
+ my $min = getchars($stats, \%digitgreen, 7, 0, 39);
+ my $gas = getchars($stats, \%digitgreen, 7, 68, 107);
+ my $unit = getchars($stats, \%digitgreen, 7, 136, 181);
+ my @unit = split /:/, $unit, 2;
+ @unit == 2 or @unit = ('?') x 2;
+ return ($min, $gas, @unit);
+}
+
+sub parsetimer {
+ my $input = shift; # (587,396)-(621,402)
+ $input->write(file => sprintf "testt%05d.png", $i) or warn $input->errstr
+ if DEBUG;
+ my $play = filter_color($input, "\276\272\357"); # 190, 186, 239
+ my $time = getchars($play, \%digittime, 6, 0, 33);
+ return (
+ $time =~ /^(?:(\d):)?(\d\d):(\d\d)$/ ?
+ (defined $1 ? $1*3600 : 0) + $2*60 + $3 :
+ undef,
+ $time
+ );
+}
+
+open my $outstats, '>', 'map.txt' or die $!;
+my $outmap = 'map%05d.png';
+
+sub capturemap {
+ my $map = screenshot(right=>134, left=>6, top=>348, bottom=>476);
+ $map->write(file => sprintf $outmap, $i) or warn $map->errstr;
}
-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;
+sub capturestats {
+ my @stats = parsestats(
+ screenshot(left=>452, top=>6, right=>639, bottom=>13)
+ );
+ my ($sec, $time) = parsetimer(
+ screenshot(left=>586, right=>621, top=>396, bottom=>402)
+ );
+ $time ne '?' or next;
+ printf {$outstats} "%d:\t%s\t%s\t%s\t%s\t%s\n",
+ $i, defined $sec ? $sec : "($time)", @stats;
}
-my $err = $map->Write('map.gif');
-$err and die $err;
-#print $map->Layers(method => 'optimize');
+if ($ARGV[0]) {
+ my $filename = $ARGV[0] || 's%05d.png';
+ for ($i = 0;;) {
+ my (@stats, $sec, $time, $map);
-print "\n";
-print "\n";
+ my $img = Imager->new;
+ $img->read(file => sprintf $filename, $i)
+ or warn($img->errstr), next;
+
+ @stats = parsestats(
+ $img->crop(left=>452, width=>187, top=>6, height=>7)
+ );
+ ($sec, $time) = parsetimer(
+ $img->crop(left=>587, width=>34, top=>396, height=>6),
+ );
+ $map = $img->crop(width=>128, height=>128, left=>6, top=>348);
+
+ printf {$outstats} "%d:\t%s\t%s\t%s\t%s\t%s\n",
+ $i, defined $sec ? $sec : "($time)", @stats;
+ $map->write(file => sprintf $outmap, $i) or warn $map->errstr;
+ last;
+ }
+} else {
+ require Imager::Screenshot;
+ import Imager::Screenshot qw(screenshot);
+
+ local $SIG{ALRM} = \&capturemap;
+ alarm 5, 1;
+ while (1) {
+ $i++;
+ capturestats();
+ sleep .2;
+ }
+ alarm 0;
+}
+
+=cut
+
+exec 'mencoder' => (
+ 'mf://map0*.png',
+ '-o' => 'map.avi',
+ '-mf' => 'type=png:fps=2',
+ '-ovc' => 'lavc',
+ '-lavcopts' => 'vcodec=mpeg4:mbd=1:v4mv:vbitrate=64',
+ '-info' => 'artist=Shiar:name="StarCraft game progress"',
+ '-msglevel' => 'all=3',
+);
git.shiar.nl / perl / schtarr.git / commitdiff