From: Shiar Date: Wed, 6 Feb 2008 17:59:15 +0000 (+0100) Subject: rewritten game capture X-Git-Url: http://git.shiar.net/perl/schtarr.git/commitdiff_plain/f241f9a797145d1c5de59696ec4736c582ea4aed?ds=sidebyside 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', +);