From: Shiar Date: Wed, 6 Feb 2008 17:59:15 +0000 (+0100) Subject: rewritten game capture X-Git-Url: http://git.shiar.nl/perl/schtarr.git/commitdiff_plain/f241f9a797145d1c5de59696ec4736c582ea4aed rewritten game capture Uses Imager for its nicer Perl interface and available X11 capture module. Depending on command line arguments, opens image files or captures from DISPLAY (map every second (doesn't update any more often), stats more often). Characters are compared by all pixels (and ignoring 'shadow' colors for much greater effect). --- diff --git a/capture b/capture old mode 100644 new mode 100755 index 91304aa..1ef47e8 --- a/capture +++ b/capture @@ -4,141 +4,254 @@ use strict; 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', +);