File Coverage

blib/lib/Image/DominantColors.pm
Criterion Covered Total %
statement 24 71 33.8
branch 0 6 0.0
condition n/a
subroutine 8 11 72.7
pod 1 3 33.3
total 33 91 36.2


line stmt bran cond sub pod time code
1             package Image::DominantColors;
2              
3 1     1   26478 use 5.006;
  1         4  
  1         66  
4 1     1   7 use strict;
  1         3  
  1         39  
5 1     1   5 use warnings FATAL => 'all';
  1         14  
  1         48  
6 1     1   1545 use Data::Dumper;
  1         13736  
  1         96  
7 1     1   1564 use Imager;
  1         73723  
  1         10  
8 1     1   1147 use Imager::Fill;
  1         1411  
  1         28  
9 1     1   537 use Image::ColorCollection;
  1         3  
  1         36  
10 1     1   1232 use POSIX;
  1         8676  
  1         7  
11            
12             our $VERSION = '0.02';
13              
14              
15             sub new {
16 0     0 0   my ($class, $params) = @_;
17 0           my $self = undef;
18 0 0         if($params) {
19 0           $self = $params;
20             } else {
21             #carp die. We need a filename...
22             }
23 0           bless $self, $class;
24 0           return $self;
25             }
26              
27             sub getDominantColors {
28 0     0 1   my $class = shift;
29 0           my $img = Imager->new(file => $class->{file});
30 0           my $clusters = 3;
31 0           my $clus = $class->{clusters};
32 0 0         if($clus)
33             {
34 0           $clusters = $clus;
35             }
36 0           my $h = $img->getheight() - 1;
37 0           my $w = $img->getwidth() - 1;
38              
39 0           my @colors = ();
40 0           for (my $j = 0; $j < $w; $j++) {
41 0           for (my $k = 0; $k < $h; $k++) {
42 0           my $oth = $img->getpixel(x => $j, y => $k);
43 0           my ($red, $green, $blue, $alpha) = $oth->rgba();
44 0           push (@colors, {
45             r => $red,
46             g => $green,
47             b => $blue,
48             });
49             }
50             }
51              
52 0           my @centroids = ();
53 0           for (my $i = 1; $i <= $clusters; $i++) {
54 0           my $cc = Image::ColorCollection->new();
55 0           push @centroids, $cc;
56             }
57            
58 0           my $shft = 100;
59 0           my $it = 0;#track iterations
60             # print "TotalCentroid : ".scalar(@centroids);
61 0           while($shft != 0)
62             {
63 0           foreach my $col (@colors) {
64 0           my $min = LONG_MAX;
65 0           my $cent = undef;
66             # print "TotalCentroidAgainb : ".scalar(@centroids);
67 0           foreach my $c (@centroids) {
68             #print Dumper($c);
69 0           my $d = int(euclideanDist($col, $c->getCentroid()));
70 0 0         if($d < $min)
71             {
72 0           $min = $d;
73 0           $cent = $c;
74             }
75             }
76 0           $cent->addColor($col);
77             }
78 0           my $localShft = 0;
79 0           foreach my $cnt (@centroids) {
80 0           $localShft += $cnt->updateCentroid();
81 0           $cnt->clear();
82             }
83 0           $shft = $localShft;
84 0           $it++;
85             # print "Iteration : $it , shift : $shft\n";
86             }
87 0           my @ret = map { $_->getCentroid() } @centroids;
  0            
88 0           return \@ret;
89             }
90             sub euclideanDist {
91 0     0 0   my ($c1, $c2) = @_;
92 0           return sqrt((($c1->{r}-$c2->{r})**2) + (($c1->{g}-$c2->{g})**2) + (($c1->{b}-$c2->{b})**2));
93             }
94              
95             1; # End of Image::DominantColors
96             __END__