#!/usr/bin/env perl

use strict;
use warnings;

use Getopt::Long 2.33 qw(HelpMessage :config bundling);
use Data::Dumper;
use Time::HiRes qw(sleep alarm);
use Imager;

our $VERSION = '2.01';

GetOptions(
	"verbose|v!" => \our $DEBUG,
	"map|m!" => \our $GETMAP,
) or HelpMessage(-exitval => 2);

my %digittime = (
	'.####.'.
	'#....#'.
	'#....#'.
	'.####.' => 0,
	'...#..'.
	'######' => 1,
	'##..#.'.
	'#.#..#'.
	'#.#..#'.
	'#..##.' => 2,
	'.#..#.'.
	'#....#'.
	'#.#..#'.
	'.#.##.' => 3,
	'..##..'.
	'..#.#.'.
	'######'.
	'..#...' => 4,
	'.#.##.'.
	'#..#.#'.
	'#..#.#'.
	'.##..#' => 5,
	'.####.'.
	'#..#.#'.
	'#..#.#'.
	'.##..#' => 6,
	'.....#'.
	'###..#'.
	'...###'.
	'.....#' => 7,
	'.#.##.'.
	'#.#..#'.
	'#.#..#'.
	'.#.##.' => 8,
	'#..##.'.
	'#.#..#'.
	'#.#..#'.
	'.####.' => 9,
	'#..#..' => ':',
);

my %digitgreen = (
	'.#####.'.
	'#.....#'.
	'#.....#'.
	'#.....#'.
	'.#####.' => 0,
	'....#..'.
	'....#..'.
	'#######' => 1,
	'##...#.'.
	'#.#...#'.
	'#.#...#'.
	'#..#...'.
	'#...##.' => 2,
	'.#...#.'.
	'#.....#'.
	'#..#..#'.
	'#..#..#'.
	'.##.##.' => 3,
	'..##...'.
	'..#.#..'.
	'..#..#.'.
	'#######'.
	'..#....' => 4,
	'.#.....'.
	'#...###'.
	'#...#.#'.
	'#...#.#'.
	'.###..#' => 5,
	'.#####.'.
	'#...#.#'.
	'#...#.#'.
	'#...#.#'.
	'.###..#' => 6,
	'......#'.
	'##....#'.
	'..##..#'.
	'....###'.
	'......#' => 7,
	'.##.##.'.
	'#..#..#'.
	'#..#..#'.
	'#..#..#'.
	'.##.##.' => 8,
	'#..###.'.
	'#.#...#'.
	'#.#...#'.
	'#.#...#'.
	'.#####.' => 9,
	'#......'.
	'..##...'.
	'.....##' => ':',
);

my $i = 0;

=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;
			}
			$output[$x] .= $match;
		}
	}
	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", # CF1818/C81818
		"\310\030\030", # ?/10FF18
	);
	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", # BEBAEF
	);
	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;
}

sub capturestats {
	my @stats = parsestats(
		screenshot(left=>452, top=>6, right=>639, bottom=>13)
	);
	my ($sec, $time) = parsetimer(
		screenshot(left=>587, 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;
}

if ($ARGV[0]) {
	my $filename = $ARGV[0] || 's%05d.png';
	for ($i = 0;;) {
		my (@stats, $sec, $time, $map);

		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);

	($SIG{ALRM} = \&capturemap), alarm 5, 1 if $GETMAP;
	while (1) {
		$i++;
		capturestats();
		sleep .2 if $GETMAP;
	}
	alarm 0 if $GETMAP;
}

=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',
);

=head1 NAME

capture - Read and parse StarCraft game screenshots

=head1 SYNOPSIS

B<capture> [OPTIONS] [INPUT]

capture --map dump%04d.png

=head1 OPTIONS

=over 8

=item --verbose | -v

Debug mode.
Stores captured statistics areas as test[ts]?????.png images.

=item --map | -m

Capture the minimap area every second (StarCraft won't update more often,
regardless of game speed).
Images are stored as map?????.png in the current directory.

=back

=head1 AUTHOR

Mischa POSLAWSKY <perl@shiar.org>

=head1 LICENSE

You may distribute under the terms of either the GNU General Public License
or the Artistic License, as specified in the Perl README file.