capture

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Data::Dumper;
   7 use Image::Magick;
   8 use constant {DEBUG => 0};
   9
  10 our $VERSION = '1.00';
  11
  12 my @digitchar = (0..9, ':', ' ');
  13 my @digittime = (
  14         [744, 372, 372, 744], # 0
  15         [186, 1116], # 1
  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
  24         [372], ## /
  25         [], # -
  26 );
  27 my @digitgreen = (
  28         [1344, 393, 255, 393, 1344], # 0
  29         [255, 409, 1530], # 1
  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
  38         [199, 887, 709], ## /
  39
  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], ## /
  51
  52         [], # -
  53 );
  54
  55 my %colorgreen = (
  56 #       8 => [8, 8],
  57         69 => [0, 0],
  58         130 => [8, 8],
  59         154 => [33, 33],
  60         255 => [16, 24],
  61 );
  62
  63 sub getrect2 {
  64         my ($digit, $valid, $data, $w, $h, $x1, $x2) = @_;
  65
  66         my ($str, @char);
  67         my $count = -1;
  68         for my $x ($x1 .. $x2) {
  69                 my $colval = 0;
  70                 for my $y (0 .. $h - 1) {
  71                         my @val;
  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;
  77                         $colval += $val[1];
  78                 }
  79
  80                 if ($colval > 0 and ($count < 0 or $count++ < 6)) {
  81                         push @char => $colval;
  82                 } elsif (@char) {
  83 printf " %d: [%s], # %d\n", $x, join(', ', @char), $count if DEBUG >= 1;
  84                         my @matches;
  85                         for my $match (@$digit) {
  86                                 if (scalar @$match == scalar @char) {
  87                                         my $offset = 0;
  88                                         $offset += abs $char[$_] - $match->[$_] for 0 .. $#char;
  89                                         push @matches => $offset;
  90                                 } else {
  91                                         push @matches => -1;
  92                                 }
  93                         }
  94                         undef @char;
  95                         $count = 0;
  96
  97                         my $best;
  98                         $matches[$_] == 0 and $best = $_ for 0 .. $#matches;
  99                         if (not defined $best) {
 100                                 my @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;
 104                                 $best = shift @best;
 105                         }
 106                         $str .= defined $best ? $best eq '' ? '' : $digitchar[$best] : '?';
 107                 }
 108         }
 109         return $str;
 110 }
 111
 112 my $map = Image::Magick->new(128, 128);
 113 my $curtime = 0;
 114
 115 for my $i ($ARGV[0] .. $ARGV[1]) {
 116         my $image = Image::Magick->new;
 117         my $err = $image->Read(sprintf 's%05d.png', $i);
 118         $err and die $err;
 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;
 124
 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);
 127         my $sec;
 128         $time =~ /^(\d\d):(\d\d)$/ and $sec = $1*60 + $2;
 129
 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);
 133         $image->Set(10);
 134         push @$map => $image;
 135         $curtime = $sec;
 136 }
 137
 138 my $err = $map->Write('map.gif');
 139 $err and die $err;
 140 #print $map->Layers(method => 'optimize');
 141
 142 print "\n";
 143 print "\n";
 144