6 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
8 use Time::HiRes qw(sleep alarm);
11 our $VERSION = '2.01';
14 "verbose|v!" => \our $DEBUG,
15 "map|m!" => \our $GETMAP,
16 ) or HelpMessage(-exitval => 2);
119 my ($r, $g, $b) = @_;
126 35 0 0 rgb 46 0 0 rgb ifp
128 constants => {r => $r, g => $g, b => $b},
129 }, $input)->convert(preset => 'red')->rotate(right => 90);
135 my @output; # line => cols_ascii
136 for my $y (reverse 0 .. $input->getheight-1) {
137 my $colors = $input->getsamples(y => $y);
138 for (my $x = 0; length $colors; $x++) {
139 my $pixel = substr $colors, 0, 3, '';
142 $pixel eq $_ and $match = '#', last;
144 $output[$x] .= $match;
152 my ($charmap, $width, $y1, $y2) = @_;
154 for my $y ($y1 .. $y2) {
155 # my $row = scalar $input->getsamples(y => $y);
156 my $row = $input->[$y];
157 if ($row eq '.' x $width) {
158 push @chars => ''; # next character
160 $chars[-1] .= $row; # add line
164 map { defined $charmap->{$_} ? $charmap->{$_} : '?' }
165 grep { $_ ne '' } @chars;
169 my $input = shift; # (452,6)-(639,13)
170 $input->write(file => sprintf "tests%05d.png", $i) or warn $input->errstr
172 my $stats = filter_color($input,
173 "\020\377\030", "\317\030\030", # CF1818/C81818
174 "\310\030\030", # ?/10FF18
176 my $min = getchars($stats, \%digitgreen, 7, 0, 39);
177 my $gas = getchars($stats, \%digitgreen, 7, 68, 107);
178 my $unit = getchars($stats, \%digitgreen, 7, 136, 181);
179 my @unit = split /:/, $unit, 2;
180 @unit == 2 or @unit = ('?') x 2;
181 return ($min, $gas, @unit);
185 my $input = shift; # (587,396)-(621,402)
186 $input->write(file => sprintf "testt%05d.png", $i) or warn $input->errstr
188 my $play = filter_color($input,
189 "\276\272\357", # BEBAEF
191 my $time = getchars($play, \%digittime, 6, 0, 33);
193 $time =~ /^(?:(\d):)?(\d\d):(\d\d)$/ ?
194 (defined $1 ? $1*3600 : 0) + $2*60 + $3 :
200 open my $outstats, '>', 'map.txt' or die $!;
201 my $outmap = 'map%05d.png';
204 my $map = screenshot(right=>134, left=>6, top=>348, bottom=>476);
205 $map->write(file => sprintf $outmap, $i) or warn $map->errstr;
209 my @stats = parsestats(
210 screenshot(left=>452, top=>6, right=>639, bottom=>13)
212 my ($sec, $time) = parsetimer(
213 screenshot(left=>587, right=>621, top=>396, bottom=>402)
215 $time ne '?' or next;
216 printf {$outstats} "%d:\t%s\t%s\t%s\t%s\t%s\n",
217 $i, defined $sec ? $sec : "($time)", @stats;
221 my $filename = $ARGV[0] || 's%05d.png';
223 my (@stats, $sec, $time, $map);
225 my $img = Imager->new;
226 $img->read(file => sprintf $filename, $i)
227 or warn($img->errstr), next;
230 $img->crop(left=>452, width=>187, top=>6, height=>7)
232 ($sec, $time) = parsetimer(
233 $img->crop(left=>587, width=>34, top=>396, height=>6),
235 $map = $img->crop(width=>128, height=>128, left=>6, top=>348);
237 printf {$outstats} "%d:\t%s\t%s\t%s\t%s\t%s\n",
238 $i, defined $sec ? $sec : "($time)", @stats;
239 $map->write(file => sprintf $outmap, $i) or warn $map->errstr;
243 require Imager::Screenshot;
244 import Imager::Screenshot qw(screenshot);
246 ($SIG{ALRM} = \&capturemap), alarm 5, 1 if $GETMAP;
260 '-mf' => 'type=png:fps=2',
262 '-lavcopts' => 'vcodec=mpeg4:mbd=1:v4mv:vbitrate=64',
263 '-info' => 'artist=Shiar:name="StarCraft game progress"',
264 '-msglevel' => 'all=3',
269 capture - Read and parse StarCraft game screenshots
273 B<capture> [OPTIONS] [INPUT]
275 capture --map dump%04d.png
284 Stores captured statistics areas as test[ts]?????.png images.
288 Capture the minimap area every second (StarCraft won't update more often,
289 regardless of game speed).
290 Images are stored as map?????.png in the current directory.
296 Mischa POSLAWSKY <perl@shiar.org>