line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lego::From::PNG; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
704
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
40
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
BEGIN { |
7
|
1
|
|
|
1
|
|
23
|
$Lego::From::PNG::VERSION = '0.04'; |
8
|
|
|
|
|
|
|
} |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
293
|
use Image::PNG::Libpng qw(:all); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Image::PNG::Const qw(:all); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use Lego::From::PNG::Const qw(:all); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use Lego::From::PNG::Brick; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Data::Debug; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Memoize; |
20
|
|
|
|
|
|
|
memoize('_find_lego_color', INSTALL => '_find_lego_color_fast'); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub new { |
23
|
|
|
|
|
|
|
my $class = shift; |
24
|
|
|
|
|
|
|
my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my $hash = {}; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
$hash->{'filename'} = $args{'filename'}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$hash->{'unit_size'} = $args{'unit_size'} || 1; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Brick depth and height defaults |
33
|
|
|
|
|
|
|
$hash->{'brick_depth'} = 1; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
$hash->{'brick_height'} = 1; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# White list default |
38
|
|
|
|
|
|
|
$hash->{'whitelist'} = ($args{'whitelist'} && ref($args{'whitelist'}) eq 'ARRAY' && scalar(@{$args{'whitelist'}}) > 0) ? $args{'whitelist'} : undef; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Black list default |
41
|
|
|
|
|
|
|
$hash->{'blacklist'} = ($args{'blacklist'} && ref($args{'blacklist'}) eq 'ARRAY' && scalar(@{$args{'blacklist'}}) > 0) ? $args{'blacklist'} : undef; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Dimension measurement formats |
44
|
|
|
|
|
|
|
$hash->{'metric'} = $args{'metric'} || 0; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$hash->{'imperial'} = $args{'imperial'} || 0; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
$hash->{'metric'} = 1 if ! $hash->{'metric'} && ! $hash->{'imperial'}; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $self = bless ($hash, ref ($class) || $class); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
return $self; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub lego_dimensions { |
56
|
|
|
|
|
|
|
my $self = shift; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
return $self->{'lego_dimensions'} ||= do { |
59
|
|
|
|
|
|
|
my $hash = {}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
for my $type (qw/imperial metric/) { |
62
|
|
|
|
|
|
|
my $lego_unit_length = |
63
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
64
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_LENGTH |
65
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $lego_unit_depth = |
68
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
69
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_DEPTH |
70
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $lego_unit_height = |
73
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
74
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_HEIGHT |
75
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
my $lego_unit_stud_diameter = |
78
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
79
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_STUD_DIAMETER |
80
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
my $lego_unit_stud_height = |
83
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
84
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_STUD_HEIGHT |
85
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my $lego_unit_stud_spacing = |
88
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
89
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_STUD_SPACING |
90
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my $lego_unit_edge_to_stud = |
93
|
|
|
|
|
|
|
Lego::From::PNG::Const->LEGO_UNIT |
94
|
|
|
|
|
|
|
* Lego::From::PNG::Const->LEGO_UNIT_EDGE_TO_STUD |
95
|
|
|
|
|
|
|
* ($type eq 'imperial' ? Lego::From::PNG::Const->MILLIMETER_TO_INCH : 1); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
$hash->{$type} = { |
98
|
|
|
|
|
|
|
lego_unit_length => $lego_unit_length, |
99
|
|
|
|
|
|
|
lego_unit_depth => $lego_unit_depth, |
100
|
|
|
|
|
|
|
lego_unit_height => $lego_unit_height, |
101
|
|
|
|
|
|
|
lego_unit_stud_diameter => $lego_unit_stud_diameter, |
102
|
|
|
|
|
|
|
lego_unit_stud_height => $lego_unit_stud_height, |
103
|
|
|
|
|
|
|
lego_unit_stud_spacing => $lego_unit_stud_spacing, |
104
|
|
|
|
|
|
|
lego_unit_edge_to_stud => $lego_unit_edge_to_stud, |
105
|
|
|
|
|
|
|
}; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
$hash; |
109
|
|
|
|
|
|
|
}; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub lego_colors { |
113
|
|
|
|
|
|
|
my $self = shift; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
return $self->{'lego_colors'} ||= do { |
116
|
|
|
|
|
|
|
my $hash = {}; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
for my $color ( LEGO_COLORS ) { |
119
|
|
|
|
|
|
|
my ($on_key, $cn_key, $hex_key, $r_key, $g_key, $b_key) = ( |
120
|
|
|
|
|
|
|
$color . '_OFFICIAL_NAME', |
121
|
|
|
|
|
|
|
$color . '_COMMON_NAME', |
122
|
|
|
|
|
|
|
$color . '_HEX_COLOR', |
123
|
|
|
|
|
|
|
$color . '_RGB_COLOR_RED', |
124
|
|
|
|
|
|
|
$color . '_RGB_COLOR_GREEN', |
125
|
|
|
|
|
|
|
$color . '_RGB_COLOR_BLUE', |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
no strict 'refs'; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
$hash->{ $color } = { |
131
|
|
|
|
|
|
|
'cid' => $color, |
132
|
|
|
|
|
|
|
'official_name' => Lego::From::PNG::Const->$on_key, |
133
|
|
|
|
|
|
|
'common_name' => Lego::From::PNG::Const->$cn_key, |
134
|
|
|
|
|
|
|
'hex_color' => Lego::From::PNG::Const->$hex_key, |
135
|
|
|
|
|
|
|
'rgb_color' => [ |
136
|
|
|
|
|
|
|
Lego::From::PNG::Const->$r_key, |
137
|
|
|
|
|
|
|
Lego::From::PNG::Const->$g_key, |
138
|
|
|
|
|
|
|
Lego::From::PNG::Const->$b_key, |
139
|
|
|
|
|
|
|
], |
140
|
|
|
|
|
|
|
}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
$hash; |
144
|
|
|
|
|
|
|
}; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub lego_bricks { |
148
|
|
|
|
|
|
|
my $self = shift; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
return $self->{'lego_bricks'} ||= do { |
151
|
|
|
|
|
|
|
my $hash = {}; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
for my $color ( LEGO_COLORS ) { |
154
|
|
|
|
|
|
|
for my $length ( LEGO_BRICK_LENGTHS ) { |
155
|
|
|
|
|
|
|
my $brick = Lego::From::PNG::Brick->new( color => $color, length => $length ); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
$hash->{ $brick->identifier } = $brick; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
$hash; |
162
|
|
|
|
|
|
|
}; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub png { |
166
|
|
|
|
|
|
|
my $self = shift; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
return $self->{'png'} ||= do { |
169
|
|
|
|
|
|
|
my $png = read_png_file($self->{'filename'}, transforms => PNG_TRANSFORM_STRIP_ALPHA); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
$png; |
172
|
|
|
|
|
|
|
}; |
173
|
|
|
|
|
|
|
}; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub png_info { |
176
|
|
|
|
|
|
|
my $self = shift; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
return $self->{'png_info'} ||= $self->png->get_IHDR; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub block_row_length { |
182
|
|
|
|
|
|
|
my $self = shift; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
return $self->{'block_row_length'} ||= $self->png_info->{'width'} / $self->{'unit_size'}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub block_row_height { |
188
|
|
|
|
|
|
|
my $self = shift; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
return $self->{'block_row_height'} ||= $self->png_info->{'height'} / $self->{'unit_size'}; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub process { |
194
|
|
|
|
|
|
|
my $self = shift; |
195
|
|
|
|
|
|
|
my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
my $tally = { |
198
|
|
|
|
|
|
|
bricks => {}, |
199
|
|
|
|
|
|
|
plan => [], |
200
|
|
|
|
|
|
|
}; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
if($self->{'filename'}) { |
203
|
|
|
|
|
|
|
my @blocks = $self->_png_blocks_of_color; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
my @units = $self->_approximate_lego_colors( blocks => \@blocks ); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
my @bricks = $self->_generate_brick_list(units => \@units); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$tally->{'plan'} = [ map { $_->flatten } @bricks ]; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
my %list; |
212
|
|
|
|
|
|
|
for my $brick(@bricks) { |
213
|
|
|
|
|
|
|
if(! exists $list{ $brick->identifier }) { |
214
|
|
|
|
|
|
|
$list{ $brick->identifier } = $brick->flatten; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
delete $list{ $brick->identifier }{'meta'}; # No need for meta in brick list |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
$list{ $brick->identifier }{'quantity'} = 1; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
else { |
221
|
|
|
|
|
|
|
$list{ $brick->identifier }{'quantity'}++; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
$tally->{'bricks'} = \%list; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
$tally->{'info'} = $self->_plan_info(); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
if($args{'view'}) { |
231
|
|
|
|
|
|
|
my $view = $args{'view'}; |
232
|
|
|
|
|
|
|
my $module = "Lego::From::PNG::View::$view"; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
$tally = eval { |
235
|
|
|
|
|
|
|
(my $file = $module) =~ s|::|/|g; |
236
|
|
|
|
|
|
|
require $file . '.pm'; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$module->new($self)->print($tally); |
239
|
|
|
|
|
|
|
}; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
die "Failed to format as a view ($view). $@" if $@; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
return $tally; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub whitelist { shift->{'whitelist'} } |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub has_whitelist { |
250
|
|
|
|
|
|
|
my $self = shift; |
251
|
|
|
|
|
|
|
my $allowed = shift; # arrayref listing filters we can use |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
my $found = 0; |
254
|
|
|
|
|
|
|
for my $filter(values $self->_list_filters($allowed)) { |
255
|
|
|
|
|
|
|
$found += scalar( grep { /$filter/ } @{ $self->whitelist || [] } ); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
return $found; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub is_whitelisted { |
262
|
|
|
|
|
|
|
my $self = shift; |
263
|
|
|
|
|
|
|
my $val = shift; |
264
|
|
|
|
|
|
|
my $allowed = shift; # arrayref listing filters we can use |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
return 1 if ! $self->has_whitelist($allowed); # return true if there is no whitelist |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
for my $entry( @{ $self->whitelist || [] } ) { |
269
|
|
|
|
|
|
|
for my $filter( values %{ $self->_list_filters($allowed) } ) { |
270
|
|
|
|
|
|
|
next unless $entry =~ /$filter/; # if there is at least a letter at the beginning then this entry has a color we can check |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
my $capture = $entry; |
273
|
|
|
|
|
|
|
$capture =~ s/$filter/$1/; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
return 1 if $val eq $capture; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
return 0; # value is not in whitelist |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub blacklist { shift->{'blacklist'} } |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub has_blacklist { |
285
|
|
|
|
|
|
|
my $self = shift; |
286
|
|
|
|
|
|
|
my $allowed = shift; # optional filter restriction |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
my $found = 0; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
for my $filter(values $self->_list_filters($allowed)) { |
291
|
|
|
|
|
|
|
$found += scalar( grep { /$filter/ } @{ $self->blacklist || [] } ); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
return $found; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub is_blacklisted { |
298
|
|
|
|
|
|
|
my $self = shift; |
299
|
|
|
|
|
|
|
my $val = shift; |
300
|
|
|
|
|
|
|
my $allowed = shift; # optional filter restriction |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
return 0 if ! $self->has_blacklist($allowed); # return false if there is no blacklist |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
for my $entry( @{ $self->blacklist || [] } ) { |
305
|
|
|
|
|
|
|
for my $filter( values %{ $self->_list_filters($allowed) } ) { |
306
|
|
|
|
|
|
|
next unless $entry =~ /$filter/; # if there is at least a letter at the beginning then this entry has a color we can check |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my $capture = $1 || $entry; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
return 1 if $val eq $capture; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
return 0; # value is not in blacklist |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub _png_blocks_of_color { |
318
|
|
|
|
|
|
|
my $self = shift; |
319
|
|
|
|
|
|
|
my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
my @blocks; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
return @blocks unless $self->{'filename'}; # No file, no blocks |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
my $pixel_bytecount = 3; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
my $y = -1; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
for my $pixel_row( @{$self->png->get_rows} ) { |
330
|
|
|
|
|
|
|
$y++; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
next unless ($y % $self->{'unit_size'}) == 0; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
my $row = $y / $self->{'unit_size'}; # get actual row of blocks we are current on |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
my @values = unpack 'C*', $pixel_row; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
my $row_width = ( scalar(@values) / $pixel_bytecount ) / $self->{'unit_size'}; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
for(my $col = 0; $col < $row_width; $col++) { |
341
|
|
|
|
|
|
|
my ($r, $g, $b) = ( |
342
|
|
|
|
|
|
|
$values[ ($self->{'unit_size'} * $pixel_bytecount * $col) ], |
343
|
|
|
|
|
|
|
$values[ ($self->{'unit_size'} * $pixel_bytecount * $col) + 1 ], |
344
|
|
|
|
|
|
|
$values[ ($self->{'unit_size'} * $pixel_bytecount * $col) + 2 ] |
345
|
|
|
|
|
|
|
); |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
$blocks[ ($row * $row_width) + $col ] = { |
348
|
|
|
|
|
|
|
r => $r, |
349
|
|
|
|
|
|
|
g => $g, |
350
|
|
|
|
|
|
|
b => $b, |
351
|
|
|
|
|
|
|
}; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
return @blocks; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub _color_score { |
359
|
|
|
|
|
|
|
my $self = shift; |
360
|
|
|
|
|
|
|
my ($c1, $c2) = @_; |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
return abs( $c1->[0] - $c2->[0] ) + abs( $c1->[1] - $c2->[1] ) + abs( $c1->[2] - $c2->[2] ); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub _find_lego_color { |
366
|
|
|
|
|
|
|
my $self = shift; |
367
|
|
|
|
|
|
|
my $rgb = [ @_ ]; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
my @optimal_color = |
370
|
|
|
|
|
|
|
map { $_->{'cid'} } |
371
|
|
|
|
|
|
|
sort { $a->{'score'} <=> $b->{'score'} } |
372
|
|
|
|
|
|
|
map { |
373
|
|
|
|
|
|
|
+{ |
374
|
|
|
|
|
|
|
cid => $_->{'cid'}, |
375
|
|
|
|
|
|
|
score => $self->_color_score($rgb, $_->{'rgb_color'}), |
376
|
|
|
|
|
|
|
}; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
values %{ $self->lego_colors }; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
my ($optimal_color) = grep { |
381
|
|
|
|
|
|
|
$self->is_whitelisted( $_, 'color' ) |
382
|
|
|
|
|
|
|
&& ! $self->is_blacklisted( $_, 'color' ) |
383
|
|
|
|
|
|
|
} @optimal_color; # first color in list that passes whitelist and blacklist should be the optimal color for tested block |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
return $optimal_color; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
sub _approximate_lego_colors { |
389
|
|
|
|
|
|
|
my $self = shift; |
390
|
|
|
|
|
|
|
my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
die 'blocks not valid' unless $args{'blocks'} && ref( $args{'blocks'} ) eq 'ARRAY'; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
my @colors; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
for my $block(@{ $args{'blocks'} }) { |
397
|
|
|
|
|
|
|
push @colors, $self->_find_lego_color_fast( $block->{'r'}, $block->{'g'}, $block->{'b'} ); |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
return @colors; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
sub _generate_brick_list { |
404
|
|
|
|
|
|
|
my $self = shift; |
405
|
|
|
|
|
|
|
my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
die 'units not valid' unless $args{'units'} && ref( $args{'units'} ) eq 'ARRAY'; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
my $unit_count = scalar(@{ $args{'units'} }); |
410
|
|
|
|
|
|
|
my @units = @{ $args{'units'} }; |
411
|
|
|
|
|
|
|
my $row_width = $self->block_row_length; |
412
|
|
|
|
|
|
|
my $brick_height = 1; # bricks are only one unit high |
413
|
|
|
|
|
|
|
my @brick_list; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
for(my $y = 0; $y < ($unit_count / $row_width); $y++) { |
416
|
|
|
|
|
|
|
my @row = splice @units, 0, $row_width; |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
my $push_color = sub { |
419
|
|
|
|
|
|
|
my ($color, $length) = @_; |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
if($color) { |
422
|
|
|
|
|
|
|
push @brick_list, Lego::From::PNG::Brick->new( |
423
|
|
|
|
|
|
|
color => $color, |
424
|
|
|
|
|
|
|
depth => $self->{'brick_depth'}, |
425
|
|
|
|
|
|
|
length => $length, |
426
|
|
|
|
|
|
|
height => $self->{'brick_height'}, |
427
|
|
|
|
|
|
|
meta => { |
428
|
|
|
|
|
|
|
y => $y, |
429
|
|
|
|
|
|
|
}, |
430
|
|
|
|
|
|
|
); |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
}; |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $process_color_sample = sub { |
435
|
|
|
|
|
|
|
my ($color, $length) = @_; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
return if $length <= 0; |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# Now make sure we find bricks we are allowed to use |
440
|
|
|
|
|
|
|
FIND_BRICKS: { |
441
|
|
|
|
|
|
|
for( 1 .. $length) { # Only need to loop at least the number of times equal to the length of color found |
442
|
|
|
|
|
|
|
my $valid_length = $length; |
443
|
|
|
|
|
|
|
FIND_VALID_LENGTH: { |
444
|
|
|
|
|
|
|
for(;$valid_length > 0;$valid_length--) { |
445
|
|
|
|
|
|
|
my $dim = join('x',$self->{'brick_depth'},$valid_length,$self->{'brick_height'}); |
446
|
|
|
|
|
|
|
my $brk = join('_', $color, $dim); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
next FIND_VALID_LENGTH if $self->is_blacklisted( $dim, 'dimension' ) || $self->is_blacklisted( $brk, 'brick' ); |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
last FIND_VALID_LENGTH if $self->is_whitelisted( $dim, 'dimension' ) && $self->is_whitelisted( $brk, 'brick' ); |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
$push_color->($color, $valid_length); |
455
|
|
|
|
|
|
|
$length -= $valid_length; |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
last FIND_BRICKS if $length <= 0; # No need to push more bricks, we found them all |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
die "No valid bricks found for remaining units of color" if $length > 0; # Catch if we have gremlins in our whitelist/blacklist |
462
|
|
|
|
|
|
|
}; |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# Run through rows and process colors |
465
|
|
|
|
|
|
|
my $next_brick_color = ''; |
466
|
|
|
|
|
|
|
my $next_brick_length = 0; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
for my $color(@row) { |
469
|
|
|
|
|
|
|
if( $color ne $next_brick_color ) { |
470
|
|
|
|
|
|
|
$process_color_sample->($next_brick_color, $next_brick_length); |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
$next_brick_color = $color; |
473
|
|
|
|
|
|
|
$next_brick_length = 0; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
$next_brick_length++; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
$process_color_sample->($next_brick_color, $next_brick_length); # Process last color found |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
return @brick_list; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
sub _list_filters { |
486
|
|
|
|
|
|
|
my $self = shift; |
487
|
|
|
|
|
|
|
my $allowed = $_[0] && ref($_[0]) eq 'ARRAY' ? $_[0] |
488
|
|
|
|
|
|
|
: ($_[0]) ? [ shift ] |
489
|
|
|
|
|
|
|
: []; # optional filter restriction |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
my $filters = { |
492
|
|
|
|
|
|
|
color => qr{^([A-Z_]+)(?:_\d+x\d+x\d+)?$}i, |
493
|
|
|
|
|
|
|
dimension => qr{^(\d+x\d+x\d+)$}i, |
494
|
|
|
|
|
|
|
brick => qr{^([A-Z_]+_\d+x\d+x\d+)$}i, |
495
|
|
|
|
|
|
|
}; |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
$filters = +{ map { $_ => $filters->{$_} } @$allowed } if scalar @$allowed; |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
return $filters; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub _plan_info { |
503
|
|
|
|
|
|
|
my $self = shift; |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
my %info; |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
for my $type (qw/metric imperial/) { |
508
|
|
|
|
|
|
|
if ($self->{$type}) { |
509
|
|
|
|
|
|
|
$info{$type} = { |
510
|
|
|
|
|
|
|
depth => $self->{'brick_depth'} * $self->lego_dimensions->{$type}->{'lego_unit_depth'}, |
511
|
|
|
|
|
|
|
length => $self->block_row_length * $self->lego_dimensions->{$type}->{'lego_unit_length'}, |
512
|
|
|
|
|
|
|
height => ($self->block_row_height * $self->lego_dimensions->{$type}->{'lego_unit_height'}) + $self->lego_dimensions->{$type}->{'lego_unit_stud_height'}, |
513
|
|
|
|
|
|
|
}; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
return \%info; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=pod |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head1 NAME |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
Lego::From::PNG - Convert PNGs into plans to build a two dimensional lego replica. |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head1 SYNOPSIS |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
use Lego::From::PNG; |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
my $object = Lego::From::PNG; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
$object->brick_tally(); |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=head1 DESCRIPTION |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Convert a PNG into a block list and plans to build a two dimensional replica of the PNG. The plans are built with brick |
537
|
|
|
|
|
|
|
knobs pointed vertically so the picture will look like a flat surface to the viewer. Meaning the only dimension |
538
|
|
|
|
|
|
|
of the brick being determined is the length. Depth and height are all the same for all bricks. |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
$hash->{'filename'} = $args{'filename'}; |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
$hash->{'unit_size'} = $args{'unit_size'} || 1; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# Brick depth and height defaults |
545
|
|
|
|
|
|
|
$hash->{'brick_depth'} = 1; |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
$hash->{'brick_height'} = 1; |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# White list default |
550
|
|
|
|
|
|
|
$hash->{'whitelist'} = ($args{'whitelist'} && ref($args{'whitelist'}) eq 'ARRAY' && scalar(@{$args{'whitelist'}}) > 0) ? $args{'whitelist'} : undef; |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# Black list default |
553
|
|
|
|
|
|
|
$hash->{'blacklist'} = ($args{'blacklist'} && ref($args{'blacklist'}) eq 'ARRAY' && scalar(@{$args{'blacklist'}}) > 0) ? $args{'blacklist'} : undef; |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=head1 USAGE |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=head2 new |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
Usage : ->new() |
560
|
|
|
|
|
|
|
Purpose : Returns Lego::From::PNG object |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
Returns : Lego::From::PNG object |
563
|
|
|
|
|
|
|
Argument : |
564
|
|
|
|
|
|
|
filename - Optional. The file name of the PNG to process. Optional but if not provided, can't process the png. |
565
|
|
|
|
|
|
|
e.g. filename => '/location/of/the.png' |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
unit_size - Optional. The size of pixels squared to determine a single unit of a brick. Defaults to 1. |
568
|
|
|
|
|
|
|
e.g. unit_size => 2 # pixelated colors are 2x2 in size |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
brick_depth - Optional. The depth of all generated bricks. Defaults to 1. |
571
|
|
|
|
|
|
|
e.g. brick_depth => 2 # final depth of all bricks are 2. So 2 x length x height |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
brick_height - Optional. The height of all generated bricks. Defaults to 1. |
574
|
|
|
|
|
|
|
e.g. brick_height => 2 # final height of all bricks are 2. So depth x length x 2 |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
whitelist - Optional. Array ref of colors, dimensions or color and dimensions that are allowed in the final plan output. |
577
|
|
|
|
|
|
|
e.g. whitelist => [ 'BLACK', 'WHITE', '1x1x1', '1x2x1', '1x4x1', 'BLACK_1x6x1' ] |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
blacklist - Optional. Array ref of colors, dimensions or color and dimensions that are not allowed in the final plan output. |
580
|
|
|
|
|
|
|
e.g. blacklist => [ 'RED', '1x10x1', '1x12x1', '1x16x1', 'BLUE_1x8x1' ] |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
Throws : |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
Comment : |
585
|
|
|
|
|
|
|
See Also : |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=head2 lego_dimensions |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Usage : ->lego_dimensions() |
590
|
|
|
|
|
|
|
Purpose : returns a hashref with lego dimension information in millimeters (metric) or inches (imperial) |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
Returns : hashref with lego dimension information, millimeters is default |
593
|
|
|
|
|
|
|
Argument : $type - if set to imperial then dimension information is returned in inches |
594
|
|
|
|
|
|
|
Throws : |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Comment : |
597
|
|
|
|
|
|
|
See Also : |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=head2 lego_colors |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
Usage : ->lego_colors() |
602
|
|
|
|
|
|
|
Purpose : returns lego color constants consolidated as a hash. |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
Returns : hashref with color constants keyed by the official color name in key form. |
605
|
|
|
|
|
|
|
Argument : |
606
|
|
|
|
|
|
|
Throws : |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
Comment : |
609
|
|
|
|
|
|
|
See Also : |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=head2 lego_bricks |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Usage : ->lego_bricks() |
614
|
|
|
|
|
|
|
Purpose : Returns a list of all possible lego bricks |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
Returns : Hash ref with L objects keyed by their identifier |
617
|
|
|
|
|
|
|
Argument : |
618
|
|
|
|
|
|
|
Throws : |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
Comment : |
621
|
|
|
|
|
|
|
See Also : |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=head2 png |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
Usage : ->png() |
626
|
|
|
|
|
|
|
Purpose : Returns Image::PNG::Libpng object. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
Returns : Returns Image::PNG::Libpng object. See L for more details. |
629
|
|
|
|
|
|
|
Argument : |
630
|
|
|
|
|
|
|
Throws : |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
Comment : |
633
|
|
|
|
|
|
|
See Also : |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=head2 png_info |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
Usage : ->png_info() |
638
|
|
|
|
|
|
|
Purpose : Returns png IHDR info from the Image::PNG::Libpng object |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
Returns : A hash of values containing information abou the png such as width and height. See get_IHDR in L for more details. |
641
|
|
|
|
|
|
|
Argument : filename => the PNG to load and part |
642
|
|
|
|
|
|
|
unit_size => the pixel width and height of one unit, blocks are generally identified as Nx1 blocks where N is the number of units of the same color |
643
|
|
|
|
|
|
|
Throws : |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
Comment : |
646
|
|
|
|
|
|
|
See Also : |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
=head2 block_row_length |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
Usage : ->block_row_length() |
651
|
|
|
|
|
|
|
Purpose : Return the width of one row of blocks. Since a block list is a single dimension array this is useful to figure out whict row a block is on. |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
Returns : The length of a row of blocks (image width / unit size) |
654
|
|
|
|
|
|
|
Argument : |
655
|
|
|
|
|
|
|
Throws : |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
Comment : |
658
|
|
|
|
|
|
|
See Also : |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=head2 block_row_height |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Usage : ->block_row_height() |
663
|
|
|
|
|
|
|
Purpose : Return the height in blocks. |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Returns : The height of a row of blocks (image height / unit size) |
666
|
|
|
|
|
|
|
Argument : |
667
|
|
|
|
|
|
|
Throws : |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Comment : |
670
|
|
|
|
|
|
|
See Also : |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=head2 process |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
Usage : ->process() |
675
|
|
|
|
|
|
|
Purpose : Convert a provided PNG into a list of lego blocks that will allow building of a two dimensional lego replica. |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
Returns : Hashref containing information about particular lego bricks found to be needed based on the provided PNG. |
678
|
|
|
|
|
|
|
Also included is the build order for those bricks. |
679
|
|
|
|
|
|
|
Argument : view => 'a view' - optionally format the return data. options include: JSON and HTML |
680
|
|
|
|
|
|
|
Throws : |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Comment : |
683
|
|
|
|
|
|
|
See Also : |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=head2 whitelist |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
Usage : ->whitelist() |
688
|
|
|
|
|
|
|
Purpose : return any whitelist settings stored in this object |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
Returns : an arrayref of whitelisted colors and/or blocks, or undef |
691
|
|
|
|
|
|
|
Argument : |
692
|
|
|
|
|
|
|
Throws : |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
Comment : |
695
|
|
|
|
|
|
|
See Also : |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=head2 has_whitelist |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
Usage : ->has_whitelist(), ->has_whitelist($filter) |
700
|
|
|
|
|
|
|
Purpose : return a true value if there is a whitelist with at least one entry in it based on the allowed filters, otherwise a false value is returned |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Returns : 1 or 0 |
703
|
|
|
|
|
|
|
Argument : $filter - optional scalar containing the filter to restrict test to |
704
|
|
|
|
|
|
|
Throws : |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Comment : |
707
|
|
|
|
|
|
|
See Also : |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=head2 is_whitelisted |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Usage : ->is_whitelisted($value), ->is_whitelisted($value, $filter) |
712
|
|
|
|
|
|
|
Purpose : return a true if the value is whitelisted, otherwise false is returned |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Returns : 1 or 0 |
715
|
|
|
|
|
|
|
Argument : $value - the value to test, $filter - optional scalar containing the filter to restrict test to |
716
|
|
|
|
|
|
|
Throws : |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
Comment : |
719
|
|
|
|
|
|
|
See Also : |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=head2 blacklist |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Usage : ->blacklist |
724
|
|
|
|
|
|
|
Purpose : return any blacklist settings stored in this object |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
Returns : an arrayref of blacklisted colors and/or blocks, or undef |
727
|
|
|
|
|
|
|
Argument : |
728
|
|
|
|
|
|
|
Throws : |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Comment : |
731
|
|
|
|
|
|
|
See Also : |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=head2 has_blacklist |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
Usage : ->has_blacklist(), ->has_whitelist($filter) |
736
|
|
|
|
|
|
|
Purpose : return a true value if there is a blacklist with at least one entry in it based on the allowed filters, otherwise a false value is returned |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Returns : 1 or 0 |
739
|
|
|
|
|
|
|
Argument : $filter - optional scalar containing the filter to restrict test to |
740
|
|
|
|
|
|
|
Throws : |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
Comment : |
743
|
|
|
|
|
|
|
See Also : |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head2 is_blacklisted |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
Usage : ->is_blacklisted($value), ->is_whitelisted($value, $filter) |
748
|
|
|
|
|
|
|
Purpose : return a true if the value is blacklisted, otherwise false is returned |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Returns : 1 or 0 |
751
|
|
|
|
|
|
|
Argument : $value - the value to test, $filter - optional scalar containing the filter to restrict test to |
752
|
|
|
|
|
|
|
Throws : |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
Comment : |
755
|
|
|
|
|
|
|
See Also : |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=head2 _png_blocks_of_color |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Usage : ->_png_blocks_of_color() |
760
|
|
|
|
|
|
|
Purpose : Convert a provided PNG into a list of rgb values based on [row][color]. Size of blocks are determined by 'unit_size' |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Returns : A list of hashes contain r, g and b values. e.g. ( { r => #, g => #, b => # }, { ... }, ... ) |
763
|
|
|
|
|
|
|
Argument : |
764
|
|
|
|
|
|
|
Throws : |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
Comment : |
767
|
|
|
|
|
|
|
See Also : |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=head2 _color_score |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Usage : ->_color_score() |
772
|
|
|
|
|
|
|
Purpose : returns a score indicating the likeness of one color to another. The lower the number the closer the colors are to each other. |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
Returns : returns a positive integer score |
775
|
|
|
|
|
|
|
Argument : $c1 - array ref with rgb color values in that order |
776
|
|
|
|
|
|
|
$c2 - array ref with rgb color values in that order |
777
|
|
|
|
|
|
|
Throws : |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
Comment : |
780
|
|
|
|
|
|
|
See Also : |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=head2 _find_lego_color |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
Usage : ->_find_lego_color |
785
|
|
|
|
|
|
|
Purpose : given an rgb params, finds the optimal lego color |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Returns : A lego color common name key that can then reference lego color information using L |
788
|
|
|
|
|
|
|
Argument : $r - the red value of a color |
789
|
|
|
|
|
|
|
$g - the green value of a color |
790
|
|
|
|
|
|
|
$b - the blue value of a color |
791
|
|
|
|
|
|
|
Throws : |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
Comment : this subroutine is memoized as the name _find_lego_color_fast |
794
|
|
|
|
|
|
|
See Also : |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=head2 _approximate_lego_colors |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
Usage : ->_approximate_lego_colors() |
799
|
|
|
|
|
|
|
Purpose : Generate a list of lego colors based on a list of blocks ( array of hashes containing rgb values ) |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Returns : A list of lego color common name keys that can then reference lego color information using L |
802
|
|
|
|
|
|
|
Argument : |
803
|
|
|
|
|
|
|
Throws : |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Comment : |
806
|
|
|
|
|
|
|
See Also : |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head2 _generate_brick_list |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Usage : ->_approximate_lego_colors() |
811
|
|
|
|
|
|
|
Purpose : Generate a list of lego colors based on a list of blocks ( array of hashes containing rgb values ) |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
Returns : A list of lego color common name keys that can then reference lego color information using L |
814
|
|
|
|
|
|
|
Argument : |
815
|
|
|
|
|
|
|
Throws : |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
Comment : |
818
|
|
|
|
|
|
|
See Also : |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=head2 _list_filters |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
Usage : ->_list_filters() |
823
|
|
|
|
|
|
|
Purpose : return whitelist/blacklist filters |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Returns : an hashref of filters |
826
|
|
|
|
|
|
|
Argument : an optional filter restriction to limit set of filters returned to just one |
827
|
|
|
|
|
|
|
Throws : |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Comment : |
830
|
|
|
|
|
|
|
See Also : |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
=head1 BUGS |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=head1 SUPPORT |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
=head1 AUTHOR |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
Travis Chase |
839
|
|
|
|
|
|
|
CPAN ID: GAUDEON |
840
|
|
|
|
|
|
|
gaudeon@cpan.org |
841
|
|
|
|
|
|
|
https://github.com/gaudeon/Lego-From-Png |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=head1 COPYRIGHT |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
This program is free software licensed under the... |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
The MIT License |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
The full text of the license can be found in the |
850
|
|
|
|
|
|
|
LICENSE file included with this module. |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=head1 SEE ALSO |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
perl(1). |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=cut |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
1; |