line |
stmt |
code |
1
|
|
# Copyright 2009-2013 Bernhard M. Wiedemann |
2
|
|
# Copyright 2012-2020 SUSE LLC |
3
|
|
# SPDX-License-Identifier: GPL-2.0-or-later |
4
|
|
|
5
|
|
|
6
|
|
use Mojo::Base -strict, -signatures; |
7
|
22
|
|
|
22
|
|
|
22
|
|
8
|
|
use bmwqemu 'fctwarn'; |
9
|
22
|
use File::Basename; |
|
22
|
|
|
22
|
|
10
|
22
|
use Math::Complex 'sqrt'; |
|
22
|
|
|
22
|
|
11
|
22
|
require Exporter; |
|
22
|
|
|
22
|
|
12
|
|
require DynaLoader; |
13
|
|
|
14
|
|
our @ISA = qw(Exporter DynaLoader); |
15
|
|
our @EXPORT = qw(); |
16
|
|
|
17
|
|
our $VERSION = '1.0'; |
18
|
|
|
19
|
|
bootstrap tinycv $VERSION; |
20
|
|
|
21
|
|
|
22
|
|
use Mojo::Base -strict, -signatures; |
23
|
|
|
24
|
22
|
my $mse = 0.0; |
|
22
|
|
|
22
|
|
25
|
|
my $err; |
26
|
65
|
|
|
65
|
|
|
65
|
|
27
|
65
|
for my $area (@$areas) { |
28
|
65
|
$err = 1 - $area->{similarity}; |
29
|
|
$mse += $err * $err; |
30
|
65
|
} |
31
|
85
|
return $mse / scalar @$areas; |
32
|
85
|
} |
33
|
|
|
34
|
65
|
# returns hash with match hinformation |
35
|
|
# { |
36
|
|
# ok => INT(1,0), # 1 if all areas matched |
37
|
|
# area = [ |
38
|
|
# { x => INT, y => INT, w => INT, h => INT, |
39
|
|
# similarity => FLOAT, |
40
|
|
# result = STRING('ok', 'fail'), |
41
|
|
# } |
42
|
|
# ] |
43
|
|
# } |
44
|
|
$threshold ||= 0.0; |
45
|
|
$search_ratio ||= 0.0; |
46
|
|
my ($sim, $xmatch, $ymatch); |
47
|
66
|
my (@exclude, @match, @ocr); |
|
66
|
|
|
66
|
|
|
66
|
|
|
66
|
|
|
66
|
|
|
66
|
|
48
|
66
|
|
49
|
66
|
return unless $needle; |
50
|
66
|
|
51
|
66
|
my $needle_image = $needle->get_image; |
52
|
|
unless ($needle_image) { |
53
|
66
|
bmwqemu::fctwarn("skipping $needle->{name}: missing PNG"); |
54
|
|
return undef; |
55
|
66
|
} |
56
|
66
|
$stopwatch->lap("**++ search__: get image") if $stopwatch; |
57
|
1
|
|
58
|
1
|
my $img = $self; |
59
|
|
for my $area (@{$needle->{area}}) { |
60
|
65
|
push @exclude, $area if $area->{type} eq 'exclude'; |
61
|
|
push @match, $area if $area->{type} eq 'match'; |
62
|
65
|
push @ocr, $area if $area->{type} eq 'ocr'; |
63
|
65
|
} |
|
65
|
|
64
|
93
|
|
65
|
93
|
if (@exclude) { |
66
|
93
|
$img = $self->copy; |
67
|
|
for my $exclude_area (@exclude) { |
68
|
|
$img->replacerect(@{$exclude_area}{qw(xpos ypos width height)}); |
69
|
65
|
$stopwatch->lap("**++-- search__: rectangle replacement") if $stopwatch; |
70
|
5
|
} |
71
|
5
|
$stopwatch->lap("**++ search__: areas exclusion") if $stopwatch; |
72
|
8
|
} |
|
8
|
|
73
|
8
|
my $ret = {ok => 1, needle => $needle, area => []}; |
74
|
|
for my $area (@match) { |
75
|
5
|
my $margin = int($area->{margin} + $search_ratio * (1024 - $area->{margin})); |
76
|
|
|
77
|
65
|
($sim, $xmatch, $ymatch) = $img->search_needle($needle_image, $area->{xpos}, $area->{ypos}, $area->{width}, $area->{height}, $margin); |
78
|
65
|
|
79
|
85
|
$stopwatch->lap("**++ tinycv::search_needle $area->{width}x$area->{height} + $margin @ $area->{xpos}x$area->{ypos}") if $stopwatch; |
80
|
|
my $ma = { |
81
|
85
|
similarity => $sim, |
82
|
|
x => $xmatch, |
83
|
85
|
y => $ymatch, |
84
|
|
w => $area->{width}, |
85
|
|
h => $area->{height}, |
86
|
|
result => 'ok', |
87
|
|
}; |
88
|
|
if (my $click_point = $area->{click_point}) { |
89
|
|
$ma->{click_point} = $click_point; |
90
|
85
|
} |
91
|
|
|
92
|
85
|
# A 96% match is ok for console tests. Please, if you |
93
|
0
|
# change this number consider change also the test |
94
|
|
# 01-test_needle and the console tests (for example, using |
95
|
|
# more smaller areas) |
96
|
|
|
97
|
|
my $m = ($area->{match} || 96) / 100; |
98
|
|
if ($sim < $m - $threshold) { |
99
|
|
$ma->{result} = 'fail'; |
100
|
|
$ret->{ok} = 0; |
101
|
85
|
} |
102
|
85
|
push @{$ret->{area}}, $ma; |
103
|
43
|
} |
104
|
43
|
|
105
|
|
$ret->{error} = mean_square_error($ret->{area}); |
106
|
85
|
if ($ret->{ok}) { |
|
85
|
|
107
|
|
for my $ocr_area (@ocr) { |
108
|
|
$ret->{ocr} ||= []; |
109
|
65
|
my $ocr = ocr::tesseract($img, $ocr_area); |
110
|
65
|
push @{$ret->{ocr}}, $ocr; |
111
|
27
|
} |
112
|
0
|
$stopwatch->lap("**++ ocr::tesseract: $needle->{name}") if $stopwatch; |
113
|
0
|
} |
114
|
0
|
return $ret; |
|
0
|
|
115
|
|
} |
116
|
27
|
|
117
|
|
# bigger OK is better (0/1) |
118
|
65
|
# smaller error is better if not OK (0 perfect, 1 totally off) |
119
|
|
# if match is equal quality prefer workaround needle to non-workaround |
120
|
|
# the name doesn't matter, but we prefer alphabetic order |
121
|
|
## no critic ($a/$b outside of sort block) |
122
|
|
my $okay = $b->{ok} <=> $a->{ok}; |
123
|
|
return $okay if $okay; |
124
|
|
my $error = $a->{error} <=> $b->{error}; |
125
|
|
return $error if $error; |
126
|
|
return -1 if ($a->{needle}->has_property('workaround') && !$b->{needle}->has_property('workaround')); |
127
|
6
|
return 1 if ($b->{needle}->has_property('workaround') && !$a->{needle}->has_property('workaround')); |
128
|
6
|
return $a->{needle}->{name} cmp $b->{needle}->{name}; |
129
|
6
|
|
130
|
6
|
## use critic |
131
|
3
|
|
132
|
2
|
} |
133
|
1
|
|
134
|
|
|
135
|
|
# in scalar context return found info or undef |
136
|
|
# in array context returns array with two elements. First element is best match |
137
|
|
# or undefined, second element are candidates that did not match. |
138
|
|
return unless $needle; |
139
|
|
|
140
|
|
$stopwatch->lap("Searching for needles") if $stopwatch; |
141
|
|
|
142
|
|
if (ref($needle) eq "ARRAY") { |
143
|
85
|
my @candidates; |
|
85
|
|
|
85
|
|
|
85
|
|
|
85
|
|
|
85
|
|
|
85
|
|
144
|
85
|
# try to match all needles and return the one with the highest similarity |
145
|
|
for my $n (@$needle) { |
146
|
85
|
my $found = $self->search_($n, $threshold, $search_ratio, $stopwatch); |
147
|
|
push @candidates, $found if $found; |
148
|
85
|
$stopwatch->lap("** search_: $n->{name}") if $stopwatch; |
149
|
51
|
} |
150
|
|
|
151
|
51
|
@candidates = sort cmp_by_error_type_ @candidates; |
152
|
32
|
my $best; |
153
|
32
|
|
154
|
32
|
if (@candidates && $candidates[0]->{ok}) { |
155
|
|
$best = shift @candidates; |
156
|
|
} |
157
|
51
|
if (wantarray) { |
158
|
51
|
return ($best, \@candidates); |
159
|
|
} |
160
|
51
|
else { |
161
|
10
|
return $best; |
162
|
|
} |
163
|
51
|
} |
164
|
49
|
|
165
|
|
else { |
166
|
|
my $found = $self->search_($needle, $threshold, $search_ratio, $stopwatch); |
167
|
2
|
$stopwatch->lap("** search_: single needle: $needle->{name}") if $stopwatch; |
168
|
|
return unless $found; |
169
|
|
if (wantarray) { |
170
|
|
return ($found, undef) if ($found->{ok}); |
171
|
|
return (undef, [$found]); |
172
|
34
|
} |
173
|
34
|
return unless $found->{ok}; |
174
|
34
|
return $found; |
175
|
34
|
} |
176
|
7
|
} |
177
|
6
|
|
178
|
|
$self->write($filename); |
179
|
27
|
|
180
|
12
|
my $thumb = $self->scale($self->xres() * 45 / $self->yres(), 45); |
181
|
|
my $dir = File::Basename::dirname($filename) . "/.thumbs"; |
182
|
|
my $base = File::Basename::basename($filename); |
183
|
|
|
184
|
0
|
mkdir($dir); |
|
0
|
|
|
0
|
|
|
0
|
|
185
|
0
|
$thumb->write("$dir/$base"); |
186
|
|
} |
187
|
0
|
|
188
|
0
|
1; |