8 use constant {DEBUG => 0};
10 our $VERSION = '1.00';
12 my @digitchar = (0..9, ':', ' ');
14 [744, 372, 372, 744], # 0
16 [558, 558, 558, 558], # 2
17 [372, 372, 558, 558], # 3
18 [372, 372, 1116, 186], # 4
19 [558, 558, 558, -558], # 5
20 [744, 558, 558, 558], # 6
21 [255, 640, 1025, 895, 539], ## 7
22 [1020, 648, 510, 648, 1020], ## 8
23 [558, 558, 558, 744], # 9
28 [1344, 393, 255, 393, 1344], # 0
30 [863, 709, 664, 799, 648], # 2
31 [579, 393, 510, 648, 1089], # 3
32 [640, 709, 709, 1530, 255], # 4
33 [523, 895, 510, 770, 1150], # 5
34 [1344, 786, 648, 648, 1089], # 6
35 [255, 640, 1025, 895, 539], # 7
36 [1020, 648, 510, 648, 1020], # 8
37 [903, 648, 510, 648, 1344], # 9
40 # [1344, 417, 263, 393, 1344, 32], # 0
41 # [255, 417, 1530, 40], # 1
42 # [863, 725, 680, 807, 656, 16], # 2
43 # [579, 401, 518, 656, 1089, 24], # 3
44 # [640, 717, 725, 1530, 287, 8], # 4
45 # [523, 903, 526, 778, 1158, 24], ## 5
46 # [1344, 786, 656, 656, 1097, 24], ## 6
47 # [255, 648, 1033, 911, 547, 8], # 7
48 # [1028, 656, 526, 664, 1028, 24], # 8
49 # [903, 656, 526, 656, 1344, 32], # 9
50 # [199, 887, 725, 16], ## /
64 my ($digit, $valid, $data, $w, $h, $x1, $x2) = @_;
68 for my $x ($x1 .. $x2) {
70 for my $y (0 .. $h - 1) {
72 push @val => $data->[($x + $y*$w) * 3 + $_] >> 8 for 0 .. 2;
73 printf(" [%s]\n", join ', ', @val) if DEBUG >= 2;
74 my $match = $valid->{$val[1]} or next;
75 $val[0] == $match->[0] and $val[2] == $match->[1] or next;
76 print " ok\n" if DEBUG >= 2;
80 if ($colval > 0 and ($count < 0 or $count++ < 6)) {
81 push @char => $colval;
83 printf " %d: [%s], # %d\n", $x, join(', ', @char), $count if DEBUG >= 1;
85 for my $match (@$digit) {
86 if (scalar @$match == scalar @char) {
88 $offset += abs $char[$_] - $match->[$_] for 0 .. $#char;
89 push @matches => $offset;
98 $matches[$_] == 0 and $best = $_ for 0 .. $#matches;
99 if (not defined $best) {
101 $matches[$_] > 0 and push @best, $_
102 for sort {$matches[$a] <=> $matches[$b]} 0 .. $#matches;
103 printf "candidates: (%s)\n", join ', ', map {"$_ ($matches[$_])"} @best;
106 $str .= defined $best ? $best eq '' ? '' : $digitchar[$best] : '?';
112 my $map = Image::Magick->new(128, 128);
115 for my $i ($ARGV[0] .. $ARGV[1]) {
116 my $image = Image::Magick->new;
117 my $err = $image->Read(sprintf 's%05d.png', $i);
119 my @pixels = $image->GetPixels(map=>'RGB', x=>452, width=>187, y=>6, height=>6);
120 my $min = getrect2(\@digitgreen, \%colorgreen, \@pixels, 187, 6, 0, 39);
121 my $gas = getrect2(\@digitgreen, \%colorgreen, \@pixels, 187, 6, 68, 107);
122 my $unit = getrect2(\@digitgreen, \%colorgreen, \@pixels, 187, 6, 136, 181);
123 my ($unitcur, $unitmax) = split /:/, $unit, 2;
125 @pixels = $image->GetPixels(map=>'RGB', x=>587, width=>34, y=>396, height=>6);
126 my $time = getrect2(\@digittime, {186 => [189, 239]}, \@pixels, 34, 6, 0, 33);
128 $time =~ /^(\d\d):(\d\d)$/ and $sec = $1*60 + $2;
130 printf "%d:\t%s\t%s\t%s\t%s\t%s\n", $i, $sec, $min, $gas, $unitcur, $unitmax;
131 $image->Crop(width=>128, height=>128, x=>6, y=>348);
132 # $image->Set(delay => $sec > $curtime ? ($sec - $curtime) / 5 : 10);
134 push @$map => $image;
138 my $err = $map->Write('map.gif');
140 #print $map->Layers(method => 'optimize');