File Coverage

/root/.cpan/build/Imager-1.018-0/blib/lib/Imager/TrimColorList.pm
Criterion Covered Total %
statement 68 95 71.5
branch 28 44 63.6
condition 16 25 64.0
subroutine 12 14 85.7
pod 6 6 100.0
total 130 184 70.6


line stmt bran cond sub pod time code
1             package Imager::TrimColorList;
2 58     58   336 use strict;
  58         106  
  58         1413  
3 58     58   914 use 5.006;
  58         165  
4 58     58   250 use Scalar::Util ();
  58         95  
  58         874  
5 58     58   283 use List::Util ();
  58         88  
  58         764  
6 58     58   238 use POSIX ();
  58         115  
  58         922  
7 58     58   272 use Imager;
  58         94  
  58         57920  
8              
9             our $VERSION = "1.000";
10              
11             sub new {
12 80     80 1 4198 my $class = shift;
13              
14 80         1379 my $self = $class->_new;
15              
16 80         1065 for my $entry (@_) {
17 30 50       47 $self->add($entry)
18             or return;
19             }
20              
21 80         241 $self;
22             }
23              
24             sub _add_anycolor {
25 18     18   30 my ($self, $c1, $c2) = @_;
26              
27 18 100       42 if ($c1->isa("Imager::Color")) {
28 15         94 return $self->add_color($c1, $c2);
29             }
30             else {
31 3         18 return $self->add_fcolor($c1, $c2);
32             }
33             }
34              
35             sub _clamp_255 {
36 168     168   175 my $x = shift;
37 168 100       236 if ($x < 0) {
    100          
38 47         86 return 0;
39             }
40             elsif ($x > 255) {
41 34         59 return 255;
42             }
43             else {
44 87         154 return int($x);
45             }
46             }
47              
48             sub add {
49 40     40 1 78 my ($self, $entry) = @_;
50              
51 40 100 100     202 if (ref $entry && Scalar::Util::blessed($entry)) {
    100 66        
52 2 50 66     14 if ($entry->isa("Imager::Color") || $entry->isa("Imager::Color::Float")) {
53 2         5 return $self->_add_anycolor($entry, $entry);
54             }
55             else {
56 0         0 Imager->_set_error("bad non-array color range entry");
57 0         0 return;
58             }
59             }
60             elsif (ref $entry && Scalar::Util::reftype($entry) eq "ARRAY") {
61 27 100       57 if (@$entry == 1) {
    50          
62 3 50       10 if (my $c = Imager::_color($entry->[0])) {
63 3 50 66     16 if ($c->isa("Imager::Color") || $c->isa("Imager::Color::Float")) {
64 3         5 return $self->_add_anycolor($c, $c);
65             }
66             }
67             else {
68             # error set by _color()
69 0         0 return;
70             }
71             }
72             elsif (@$entry == 2) {
73             # first must be a color (or convertible to a color)
74 24 50       48 if (my $c1 = Imager::_color($entry->[0])) {
75 24 100 66     80 if (Scalar::Util::looks_like_number($entry->[1]) && $entry->[1] >= 0) {
    50          
76             # convert to range
77 22         27 my $f = $entry->[1];
78 22 100       51 if ($c1->isa("Imager::Color")) {
79 84         159 return $self->add_color(Imager::Color->new(map { _clamp_255(POSIX::ceil($_ - ( 255 * $f ))) } $c1->rgba),
80 21         51 Imager::Color->new(map { _clamp_255($_ + ( 255 * $f )) } $c1->rgba));
  84         127  
81             }
82             else {
83 4         9 return $self->add_fcolor(Imager::Color::Float->new(map { $_ - $f } $c1->rgba),
84 1         5 Imager::Color::Float->new(map { $_ + $f } $c1->rgba));
  4         7  
85             }
86             }
87             elsif (my $c2 = Imager::_color($entry->[1])) {
88 2         4 return $self->_add_anycolor($c1, $c2);
89             }
90             else {
91             # error set by _color()
92 0         0 return;
93             }
94             }
95             else {
96 0         0 return;
97             }
98             }
99             else {
100 0         0 Imager->_set_error("array entry for color range must be 1 or 2 elements");
101 0         0 return;
102             }
103             }
104             else {
105             # try as a color entry
106 11 50       32 if (my $c1 = Imager::_color($entry)) {
107 11         20 return $self->_add_anycolor($c1, $c1);
108             }
109             else {
110 0         0 return;
111             }
112             }
113             }
114              
115             sub all {
116 1     1 1 1119 my ($self) = @_;
117              
118 1         4 my $count = $self->count;
119 1         1 my @result;
120 1         3 for my $i (0 .. $count-1) {
121 0         0 push @result, $self->get($i);
122             }
123              
124 1         4 return @result;
125             }
126              
127             sub describe {
128 0     0 1 0 my ($self) = @_;
129              
130 0         0 my $out = <
131             Imager::TrimColorList->new(
132             EOS
133 0 0       0 if ($self->count) {
134 0         0 for my $i (0.. $self->count()-1) {
135 0         0 my $entry = $self->get($i);
136 0 0       0 if ($entry->[0]->isa("Imager::Color")) {
137 0         0 $out .= sprintf("[ Imager::Color->new(%d, %d, %d), Imager::Color->new(%d, %d, %d) ],\n",
138             ($entry->[0]->rgba)[0 .. 2], ($entry->[1]->rgba)[0 .. 2]);
139             }
140             else {
141 0         0 $out .= sprintf("[ Imager::Color::Float->new(%g, %g, %g), Imager::Color::Float->new(%g, %g, %g) ],\n",
142             ($entry->[0]->rgba)[0 .. 2], ($entry->[1]->rgba)[0 .. 2]);
143             }
144             }
145             }
146             else {
147 0         0 chomp $out;
148             }
149 0         0 $out .= ")\n";
150              
151 0         0 return $out;
152             }
153              
154             sub clone {
155 0     0 1 0 my ($self) = @_;
156              
157 0         0 return Imager::TrimColorList->new($self->all);
158             }
159              
160             sub auto {
161 5     5 1 15 my ($self, %hsh) = @_;
162              
163 5   50     12 my $name = delete $hsh{name} || "auto";
164 5   50     12 my $auto = delete $hsh{auto} || "1";
165 5         7 my $image = delete $hsh{image};
166 5         6 my $tolerance = delete $hsh{tolerance};
167              
168 5 50       9 defined $tolerance or $tolerance = 0.01;
169              
170 5 50 33     14 unless ($image && $image->{IMG}) {
171 0         0 Imager->_set_error("$name: no image supplied");
172 0         0 return;
173             }
174              
175 5 50       10 if ($auto eq "1") {
176 0         0 $auto = "centre";
177             }
178 5 50 66     14 if ($auto eq "center" || $auto eq "centre") {
179 5         11 my ($w, $h) = ( $image->getwidth(), $image->getheight() );
180 5         16 return Imager::TrimColorList->new
181             (
182             [ $image->getpixel(x => $w / 2, y => 0 ), $tolerance ],
183             [ $image->getpixel(x => $w / 2, y => $h - 1), $tolerance ],
184             [ $image->getpixel(x => 0, y => $h / 2), $tolerance ],
185             [ $image->getpixel(x => $w - 1, y => $h / 2), $tolerance ],
186             );
187             }
188             else {
189 0           Imager->_set_error("$name: auto must be '1' or 'center'");
190 0           return;
191             }
192             }
193              
194             1;
195              
196             =head1 NAME
197              
198             Imager::TrimColorList - represent a list of color ranges for Imager's trim() method.
199              
200             =head1 SYNOPSIS
201              
202             use Imager::TrimColorList;
203              
204             # empty list
205             my $tcl = Imager::TrimColorList->new;
206              
207             # add an entry in a variety of forms
208             $tcl->add($entry);
209              
210             # add an explicit color object entry
211             $tcl->add_color($c1, $c2);
212              
213             # add an explicit floating color object entry
214             $tcl->add_fcolor($cf1, $cf2);
215              
216             # number of entries
217             my $count = $tcl->count;
218              
219             # fetch an entry
220             my $entry = $tcl->get($index);
221              
222             # fetch all entries
223             my @all = $tcl->all;
224              
225             # make a list and populate it
226             my $tcl = Imager::TrimColorList->new($entry1, $entry2, ...);
227              
228             # dump contents of the list as a string
229             print $tcl->describe;
230              
231             =head1 DESCRIPTION
232              
233             An Imager::TrimColorList represents a list of color ranges to supply
234             to the trim() method.
235              
236             Each range can be either an 8-bit color range, ie. L
237             objects, or a floating point color range, ie. L
238             objects, these can be mixed freely in a single list but each range
239             must be 8-bit or floating point.
240              
241             You can supply an entry in a small variety of forms:
242              
243             =over
244              
245             =item *
246              
247             a simple color object of either type, or something convertible to a
248             color object such as a color name such as C<"red">, a hex color such
249             as C<"#FFF">. Any of the forms that Imager::Color supports should
250             work here I for the array form. This becomes a range of only
251             that color.
252              
253             $tcl->add("#000");
254             $tcl->add(Imager::Color->new(0, 0, 0));
255             $tcl->add(Imager::Color::Float->new(0, 0, 0));
256              
257             =item *
258              
259             an arrayref containing a single color object, or something convertible
260             to a color object. This becomes a range of only that color.
261              
262             $tcl->add([ "#000" ]);
263             $tcl->add([ Imager::Color->new(0, 0, 0) ]);
264             $tcl->add([ Imager::Color::Float->new(0, 0, 0) ]);
265              
266             =item *
267              
268             an arrayref containing two color objects of the same type, ie. both
269             Imager::Color objects or convertible to Imager::Color objects, or two
270             Imager::Color::Float objects. This becomes a range between those two
271             colors inclusive.
272              
273             $tcl->add([ "#000", "#002" ]);
274             $tcl->add([ Imager::Color->new(0, 0, 0), Imager::Color->new(0, 0, 2) ]);
275             $tcl->add([ Imager::Color::Float->new(0, 0, 0), Imager::Color::Float->new(0, 0, 2/255) ]);
276              
277             =item *
278              
279             an arrayref containing a color object of either type and a number
280             representing the variance within the color space on either side of the
281             specified color to include.
282              
283             $tcl->add([ "#000", 0.01 ])
284             $tcl->add([ Imager::Color->new(0, 0, 0), 0.01 ]);
285             $tcl->add([ Imager::Color::Float->new(0, 0, 0), 0.01 ]);
286              
287             A range specified this way with an 8-bit color clips at the top and
288             bottom of the sample ranges, so the example 8-bit range above goes
289             from (0, 0, 0) to (2, 2, 2) inclusive, while the floating point range
290             isn't clipped and results in the floating color range (-0.01, -0.01,
291             -0.01) to (0.01, 0.01, 0.01) inclusive.
292              
293             =back
294              
295             =head1 METHODS
296              
297             =over
298              
299             =item new()
300              
301             =item new($entry1, ...)
302              
303             Class method. Create a new Imager::TrimColorList object and
304             optionally add some color ranges to it.
305              
306             Returns an optionally populated Imager::TrimColorList object, or an
307             empty list (or undef) or failure.
308              
309             =item add($entry)
310              
311             Add a single range entry. Note that this accepts a single value which
312             can be a color or convertible to a color, or a reference to an array
313             as described above.
314              
315             Returns a true value on success and a false value on failure.
316              
317             =item add_color($color1, $color2)
318              
319             Add a single 8-bit color range going from the C<$color1> object to the
320             C<$color2> object inclusive. Both parameters must be Image::Color
321             objects or an exception is thrown.
322              
323             =item add_fcolor($fcolor1, $fcolor2)
324              
325             Add a single floating point color range going from the C<$fcolor1>
326             object to the C<$fcolor2> object inclusive. Both parameters must be
327             Image::Color::Float objects or an exception is thrown.
328              
329             =item count()
330              
331             Fetch the number of color ranges stored in the object.
332              
333             =item get($index)
334              
335             Fetch the color range at the given index. This returns a reference to
336             an array containing either two Imager::Color objects or two
337             Imager::Color::Float objects.
338              
339             Returns undef if C<$index> is out of range and does not set C<<
340             Imager->errstr >>.
341              
342             =item all()
343              
344             Fetch all ranges from the object.
345              
346             =item describe()
347              
348             Return a string describing the color range as code that can create the
349             object.
350              
351             =item clone()
352              
353             Duplicate the object.
354              
355             =item auto()
356              
357             Automatically produce a trim color list based on an input image.
358              
359             This is used to implement 'auto' for image trim() and trim_rect()
360             methods.
361              
362             Parameters:
363              
364             =over
365              
366             =item *
367              
368             C - the image to base the color list on. Required.
369              
370             =item *
371              
372             C - the mechanism used to produce the color list, one of:
373              
374             =over
375              
376             =item *
377              
378             C<1> - a "best" mechanism is selected, this is currently the C
379             method, but it subject to change.
380              
381             =item *
382              
383             C
, C - the pixels at the center of each side of the
384             image are used.
385              
386             =back
387              
388             Default: C<1>.
389              
390             =item *
391              
392             C - used to control the range of pixel colors to be
393             accepted as part of the color list. Default: 0.01.
394              
395             =item *
396              
397             C - used internally to attribute errors back to the original
398             method. Default: C.
399              
400             =back
401              
402             =back
403              
404             If any method returns an error you can fetch a diagnostic from C<<
405             Imager->errstr >>.
406              
407             =head1 THREADS
408              
409             Imager::TrimColorList objects are properly duplicated when new perl
410             threads are created.
411              
412             =head1 AUTHOR
413              
414             Tony Cook
415              
416             =head1 HISTORY
417              
418             Originally the range handling for this was going to be embedded in the
419             trim() method, but this meant that every called that used color ranges
420             would pay some cost as the range list was checked for names (vs color
421             objects) and non-standard forms such as single colors and the color
422             plus variance.
423              
424             The object allows a simple test for the trim() C parameter
425             that doesn't pay that cost, and still allows a caller to use the
426             explicit convention.
427              
428             =cut