view release on metacpan or  search on metacpan

lib/Color/Similarity/HCL.pm  view on Meta::CPAN

    return [ 0, 0, 0 ] if $max == 0; # special-case black
    my $alpha = ( $min / $max ) / Y0;
    my $Q = exp( $alpha * gamma );

    my( $rg, $gb, $br ) = ( $r - $g, $g - $b, $b - $r );
    my $L = ( $Q * $max + ( 1 - $Q ) * $min ) / 2;
    my $C = $Q * ( abs( $rg ) + abs( $gb ) + abs( $br ) ) / 3;
    my $H = rad2deg( _atan( $gb, $rg ) );

    # The paper uses 180, not 90, but using 180 gives
    # red the same HCL value as green...
#   Alternative A
#    $H = 90 + $H         if $rg <  0 && $gb >= 0;
#    $H = $H - 90         if $rg <  0 && $gb <  0;
#   Alternative B
#    $H = 2 * $H / 3      if $rg >= 0 && $gb >= 0;
#    $H = 4 * $H / 3      if $rg >= 0 && $gb <  0;
#    $H = 90 + 4 * $H / 3 if $rg <  0 && $gb >= 0;
#    $H = 3 * $H / 4 - 90 if $rg <  0 && $gb <  0;
#   From http://w3.uqo.ca/missaoui/Publications/TRColorSpace.zip
    $H = 2 * $H / 3      if $rg >= 0 && $gb >= 0;
    $H = 4 * $H / 3      if $rg >= 0 && $gb <  0;
    $H = 180 + 4 * $H / 3 if $rg <  0 && $gb >= 0;
    $H = 2 * $H / 3 - 180 if $rg <  0 && $gb <  0;

    return [ $H, $C, $L ];
}

=head2 distance_hcl

  my $distance = distance_hcl( [ $h1, $c1, $l1 ], [ $h2, $c2, $l2 ] );

Computes the distance between two colors in the HCL color space.

=cut

sub distance_hcl {
    my( $t1, $t2 ) = @_;
    my( $h1, $c1, $l1 ) = @$t1;
    my( $h2, $c2, $l2 ) = @$t2;

    my $Ah = abs( $h1 - $h2 ) + Ah_inc;
    my( $Dl, $Dh ) = ( abs( $l1 - $l2 ), abs( $h1 - $h2 ) );
    # here it used to use <x> ** 2 to compute squares, but this causes
    # some rounding problems
    my $AlDl = Al * $Dl;
    return sqrt(   $AlDl * $AlDl
                 + $Ah * (   $c1 * $c1
                           + $c2 * $c2
                           - 2 * $c1 * $c2 * cos( deg2rad( $Dh ) )
                           )
                 );
}

=head1 SEE ALSO

L<http://w3.uqo.ca/missaoui/Publications/TRColorSpace.zip>

Corrected the RGB -> HCL transformation (see C<rgb2hcl>) as per the
research report by the same authors (thanks to David Hoerl for finding
the document with the corrected formula).

L<Color::Similarity>, L<Color::Similarity::RGB>, L<Color::Similarity::Lab>

=head1 AUTHOR

Mattia Barbon, C<< <mbarbon@cpan.org> >>

=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  => \&rgb2hcl,
             distance     => \&distance_hcl,
             };
}

1;