# Comparator for the "average threshold" comparison method. package Image::Compare::AVG_THRESHOLD; use warnings; use strict; use constant MEAN => 0; use constant MEDIAN => 1; use base qw/Image::Compare::Comparator/; sub accumulate { my $self = shift; my $diff = $self->color_distance(@_); if ($self->{args}{type} == &MEAN) { $self->{count}++; $self->{sum} += $diff; } elsif ($self->{args}{type} == &MEDIAN) { push(@{$self->{scores}}, $diff); } else { die "Unrecognized average type: '$self->{args}{type}'"; } return undef; } sub get_result { my $self = shift; my $val = 0; if ($self->{args}{type} == &MEAN) { $val = $self->{sum} / $self->{count}; } elsif ($self->{args}{type} == &MEDIAN) { my @vals = sort @{$self->{scores}}; if (@vals % 2) { # Return the middle value $val = $vals[(@vals / 2)]; } else { # Return the mean of the middle two values $val = $vals[ @vals / 2 ]; $val += $vals[(@vals / 2) - 1]; $val /= 2; } } return $val <= $self->{args}{value}; } 1; __END__ =head1 NAME Image::Compare::AVG_THRESHOLD - Compare two images by the overall average color difference of their pixels. =head1 OVERVIEW See the docs for L for details on how to use this module. Further documentation is meant for those modifying or subclassing this comparator. See the documentation in L for general information about making your own comparator subclasses. =head1 METHODS =over 4 =item accumulate(\@pixel1, \@pixel2, $x, $y) This method is called for each pixel in the two images to be compared. The difference between each pair of pictures is collected and stored for later use by get_result(). This method never short-circuits; when this comparator is used, all pixels are compared, every time. =item $cmp->get_result() Returns either the median or the arithmetic mean of the values collected by accumulate(), depending on the average type provided when this object was constructed. =back =head1 AUTHOR Copyright 2008 Avi Finkel > This package is free software and is provided "as is" without express or implied warranty. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) =cut