File Coverage

blib/lib/Color/Similarity/Lab.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod	3	3	100.0
total	28	28	100.0

package Color::Similarity::Lab;

=head1 NAME

Color::Similarity::Lab - compute color similarity using the L*a*b* color space

=head1 SYNOPSIS

  use Color::Similarity::Lab qw(distance rgb2lab distance_lab);
  # the greater the distance, more different the colors
  my $distance = distance( [ $r1, $g1, $b1 ], [ $r2, $g2, $b2 ] );

=head1 DESCRIPTION

Computes color similarity using the L*a*b* color space and Euclidean
distance metric.

The RGB -> L*a*b* conversion is just a wrapper around
L.

=cut

use strict;
use base qw(Exporter);

our $VERSION = '0.01';
our @EXPORT_OK = qw(rgb2lab distance distance_lab);

use Graphics::ColorObject qw(RGB_to_Lab);

=head1 FUNCTIONS

=head2 distance

  my $distance = distance( [ $r1, $g1, $b1 ], [ $r2, $g2, $b2 ] );

Converts the colors to the L*a*b* space and computes their distance.

=cut

sub distance {
    my( $t1, $t2 ) = @_;

    return distance_lab( RGB_to_Lab( $t1 ), RGB_to_Lab( $t2 ) );
}

=head2 rgb2lab

  [ $l, $a, $b ] = rgb2lab( $r, $g, $b );

Converts between RGB and L*a*b* color spaces (using
L).

=cut

sub rgb2lab {
    my( $r, $g, $b ) = @_;

    return RGB_to_Lab( [ $r, $g, $b ] );
}

=head2 distance_lab

  my $distance = distance_lab( [ $l1, $a1, $b1 ], [ $l2, $a2, $b2 ] );

Computes the Euclidean distance between two colors in the L*a*b* color space.

=cut

sub distance_lab {
    my( $t1, $t2 ) = @_;
    my( $L1, $a1, $b1 ) = @$t1;
    my( $L2, $a2, $b2 ) = @$t2;

    return sqrt(   ( $L2 - $L1 ) ** 2
                 + ( $a2 - $a1 ) ** 2
                 + ( $b2 - $b1 ) ** 2 );
}

=head1 SEE ALSO

L, L, L

=head1 AUTHOR

Mattia Barbon, C<<  >>

=head1 COPYRIGHT

Copyright (C) 2007, Mattia Barbon

This program is free software; you can redistribute it or modify it
under the same terms as Perl itself.

=cut

sub _vtable {
    return { distance_rgb => \&distance,
             convert_rgb  => \&rgb2lab,
             distance     => \&distance_lab,
             };
}

1;