capture

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Data::Dumper;
   7 use Time::HiRes qw(sleep alarm);
   8 use Imager;
   9 use constant {DEBUG => 0};
  10
  11 our $VERSION = '2.00';
  12
  13 my %digittime = (
  14         '.####.'.
  15         '#....#'.
  16         '#....#'.
  17         '.####.' => 0,
  18         '...#..'.
  19         '######' => 1,
  20         '##..#.'.
  21         '#.#..#'.
  22         '#.#..#'.
  23         '#..##.' => 2,
  24         '.#..#.'.
  25         '#....#'.
  26         '#.#..#'.
  27         '.#.##.' => 3,
  28         '..##..'.
  29         '..#.#.'.
  30         '######'.
  31         '..#...' => 4,
  32         '.#.##.'.
  33         '#..#.#'.
  34         '#..#.#'.
  35         '.##..#' => 5,
  36         '.####.'.
  37         '#..#.#'.
  38         '#..#.#'.
  39         '.##..#' => 6,
  40         '.....#'.
  41         '###..#'.
  42         '...###'.
  43         '.....#' => 7,
  44         '.#.##.'.
  45         '#.#..#'.
  46         '#.#..#'.
  47         '.#.##.' => 8,
  48         '#..##.'.
  49         '#.#..#'.
  50         '#.#..#'.
  51         '.####.' => 9,
  52         '#..#..' => ':',
  53 );
  54
  55 my %digitgreen = (
  56         '.#####.'.
  57         '#.....#'.
  58         '#.....#'.
  59         '#.....#'.
  60         '.#####.' => 0,
  61         '....#..'.
  62         '....#..'.
  63         '#######' => 1,
  64         '##...#.'.
  65         '#.#...#'.
  66         '#.#...#'.
  67         '#..#...'.
  68         '#...##.' => 2,
  69         '.#...#.'.
  70         '#.....#'.
  71         '#..#..#'.
  72         '#..#..#'.
  73         '.##.##.' => 3,
  74         '..##...'.
  75         '..#.#..'.
  76         '..#..#.'.
  77         '#######'.
  78         '..#....' => 4,
  79         '.#.....'.
  80         '#...###'.
  81         '#...#.#'.
  82         '#...#.#'.
  83         '.###..#' => 5,
  84         '.#####.'.
  85         '#...#.#'.
  86         '#...#.#'.
  87         '#...#.#'.
  88         '.###..#' => 6,
  89         '......#'.
  90         '##....#'.
  91         '..##..#'.
  92         '....###'.
  93         '......#' => 7,
  94         '.##.##.'.
  95         '#..#..#'.
  96         '#..#..#'.
  97         '#..#..#'.
  98         '.##.##.' => 8,
  99         '#..###.'.
 100         '#.#...#'.
 101         '#.#...#'.
 102         '#.#...#'.
 103         '.#####.' => 9,
 104         '#......'.
 105         '..##...'.
 106         '.....##' => ':',
 107 );
 108
 109 my $i = 0;
 110
 111 =cut
 112 sub filter_color {
 113         my $input = shift;
 114         my ($r, $g, $b) = @_;
 115         Imager::transform2({
 116                 rpnexpr => <<'EOT',
 117 x y getp1 !pix
 118 @pix red r eq
 119 @pix green g eq and
 120 @pix blue b eq and
 121 35 0 0 rgb 46 0 0 rgb ifp
 122 EOT
 123                 constants => {r => $r, g => $g, b => $b},
 124         }, $input)->convert(preset => 'red')->rotate(right => 90);
 125 }
 126 =cut
 127
 128 sub filter_color {
 129         my $input = shift;
 130         my @output; # line => cols_ascii
 131         for my $y (reverse 0 .. $input->getheight-1) {
 132                 my $colors = $input->getsamples(y => $y);
 133                 for (my $x = 0; length $colors; $x++) {
 134                         my $pixel = substr $colors, 0, 3, '';
 135                         my $match = '.';
 136                         for (@_) {
 137                                 $pixel eq $_ and $match = '#', last;
 138                         }
 139                         $output[$x] .= $match;
 140                 }
 141         }
 142         return \@output;
 143 }
 144
 145 sub getchars {
 146         my $input = shift;
 147         my ($charmap, $width, $y1, $y2) = @_;
 148         my @chars = '';
 149         for my $y ($y1 .. $y2) {
 150 #               my $row = scalar $input->getsamples(y => $y);
 151                 my $row = $input->[$y];
 152                 if ($row eq '.' x $width) {
 153                         push @chars => '';  # next character
 154                 } else {
 155                         $chars[-1] .= $row;  # add line
 156                 }
 157         }
 158         return join '',
 159                 map { defined $charmap->{$_} ? $charmap->{$_} : '?' }
 160                 grep { $_ ne '' } @chars;
 161 }
 162
 163 sub parsestats {
 164         my $input = shift;  # (452,6)-(639,13)
 165         $input->write(file => sprintf "tests%05d.png", $i) or warn $input->errstr
 166                 if DEBUG;
 167         my $stats = filter_color($input, "\020\377\030", "\317\030\030", "\310\030\030"); # ?/10FF18 | C81818/CF1818
 168         my $min = getchars($stats, \%digitgreen, 7, 0, 39);
 169         my $gas = getchars($stats, \%digitgreen, 7, 68, 107);
 170         my $unit = getchars($stats, \%digitgreen, 7, 136, 181);
 171         my @unit = split /:/, $unit, 2;
 172         @unit == 2 or @unit = ('?') x 2;
 173         return ($min, $gas, @unit);
 174 }
 175
 176 sub parsetimer {
 177         my $input = shift;  # (587,396)-(621,402)
 178         $input->write(file => sprintf "testt%05d.png", $i) or warn $input->errstr
 179                 if DEBUG;
 180         my $play = filter_color($input, "\276\272\357"); # 190, 186, 239
 181         my $time = getchars($play, \%digittime, 6, 0, 33);
 182         return (
 183                 $time =~ /^(?:(\d):)?(\d\d):(\d\d)$/ ?
 184                         (defined $1 ? $1*3600 : 0) + $2*60 + $3 :
 185                         undef,
 186                 $time
 187         );
 188 }
 189
 190 open my $outstats, '>', 'map.txt' or die $!;
 191 my $outmap = 'map%05d.png';
 192
 193 sub capturemap {
 194         my $map = screenshot(right=>134, left=>6, top=>348, bottom=>476);
 195         $map->write(file => sprintf $outmap, $i) or warn $map->errstr;
 196 }
 197
 198 sub capturestats {
 199         my @stats = parsestats(
 200                 screenshot(left=>452, top=>6, right=>639, bottom=>13)
 201         );
 202         my ($sec, $time) = parsetimer(
 203                 screenshot(left=>587, right=>621, top=>396, bottom=>402)
 204         );
 205         $time ne '?' or next;
 206         printf {$outstats} "%d:\t%s\t%s\t%s\t%s\t%s\n",
 207                 $i, defined $sec ? $sec : "($time)", @stats;
 208 }
 209
 210 if ($ARGV[0]) {
 211         my $filename = $ARGV[0] || 's%05d.png';
 212         for ($i = 0;;) {
 213                 my (@stats, $sec, $time, $map);
 214
 215                 my $img = Imager->new;
 216                 $img->read(file => sprintf $filename, $i)
 217                         or warn($img->errstr), next;
 218
 219                 @stats = parsestats(
 220                         $img->crop(left=>452, width=>187, top=>6, height=>7)
 221                 );
 222                 ($sec, $time) = parsetimer(
 223                         $img->crop(left=>587, width=>34, top=>396, height=>6),
 224                 );
 225                 $map = $img->crop(width=>128, height=>128, left=>6, top=>348);
 226
 227                 printf {$outstats} "%d:\t%s\t%s\t%s\t%s\t%s\n",
 228                         $i, defined $sec ? $sec : "($time)", @stats;
 229                 $map->write(file => sprintf $outmap, $i) or warn $map->errstr;
 230                 last;
 231         }
 232 } else {
 233         require Imager::Screenshot;
 234         import Imager::Screenshot qw(screenshot);
 235
 236         local $SIG{ALRM} = \&capturemap;
 237         alarm 5, 1;
 238         while (1) {
 239                 $i++;
 240                 capturestats();
 241                 sleep .2;
 242         }
 243         alarm 0;
 244 }
 245
 246 =cut
 247
 248 exec 'mencoder' => (
 249         'mf://map0*.png',
 250         '-o' => 'map.avi',
 251         '-mf' => 'type=png:fps=2',
 252         '-ovc' => 'lavc',
 253         '-lavcopts' => 'vcodec=mpeg4:mbd=1:v4mv:vbitrate=64',
 254         '-info' => 'artist=Shiar:name="StarCraft game progress"',
 255         '-msglevel' => 'all=3',
 256 );
 257