Bump version and update Changes

[convert-color-husl.git] / lib / Convert / Color / HUSL.pm

package Convert::Color::HUSL;

use 5.008009;
use strict;
use warnings;
use parent qw/Convert::Color/;

use Convert::Color::XYZ;
use Convert::Color::LUV;
use Convert::Color::LCh;
use List::Util qw/min/;
use Math::Trig qw/:pi/;

BEGIN {
	*MAT_R = *Convert::Color::XYZ::MAT_R;
	*MAT_G = *Convert::Color::XYZ::MAT_G;
	*MAT_B = *Convert::Color::XYZ::MAT_B;

	*KAPPA = *Convert::Color::LUV::KAPPA;
	*EPS   = *Convert::Color::LUV::EPS;
}

our $VERSION = '1.000';

__PACKAGE__->register_color_space('husl');

sub new {
	my ($class, $h, $s, $l) = @_;
	($h, $s, $l) = split /,/s, $h unless defined $s;
	bless [$h, $s, $l], $class
}

sub H { shift->[0] }
sub S { shift->[1] }
sub L { shift->[2] }

sub hsl { @{$_[0]} }

sub _get_bounds {
	my ($l) = @_;
	my $sub1 = ($l + 16) ** 3 / 1_560_896;
	my $sub2 = $sub1 > EPS ? $sub1 : $l / KAPPA;
	my @ret;

	for (MAT_R, MAT_G, MAT_B) {
		my ($m1, $m2, $m3) = @$_;
		for (0, 1) {
			my $top1 = (284_517 * $m1 - 94_839 * $m3) * $sub2;
			my $top2 = (838_422 * $m3 + 769_860 * $m2 + 731_718 * $m1) * $l * $sub2 - 769_860 * $_ * $l;
			my $bottom = (632_260 * $m3 - 126_452 * $m2) * $sub2 + 126_452 * $_;
			push @ret, [$top1 / $bottom, $top2 / $bottom]
		}
	}

	@ret
}

sub _length_of_ray_until_intersect {
	my ($theta, $line) = @_;
	my ($m, $n) = @$line;
	my $len = $n / (sin ($theta) - $m * cos $theta);
	return if $len < 0;
	$len
}

sub max_chroma_for_lh {
	my ($self, $l, $h) = @_;
	my $hrad = $h / 180 * pi;
	min map {
		_length_of_ray_until_intersect $hrad, $_
	} _get_bounds $l;
}

sub convert_to_lch {
	my ($self) = @_;
	my ($h, $s, $l) = @$self;
	return Convert::Color::LCh->new(100, 0, $h) if $l > 99.9999999;
	return Convert::Color::LCh->new(0, 0, $h) if $l < 0.00000001;
	my $max = $self->max_chroma_for_lh($l, $h);
	my $c = $max / 100 * $s;
	Convert::Color::LCh->new($l, $c, $h)
}

sub new_from_lch {
	my ($class, $lch) = @_;
	my ($l, $c, $h) = @$lch;
	return $class->new($h, 0, 100) if $l > 99.9999999;
	return $class->new($h, 0, 0) if $l < 0.00000001;
	my $max = $class->max_chroma_for_lh($l, $h);
	my $s = $c / $max * 100;
	$class->new($h, $s, $l)
}

sub rgb { shift->convert_to_lch->rgb }
sub new_rgb { shift->new_from_lch(Convert::Color::LCh->new_rgb(@_)) }

1;
__END__

=encoding utf-8

=head1 NAME

Convert::Color::HUSL - a color value in the HUSL color space

=head1 SYNOPSIS

  use Convert::Color::HUSL;
  my $red = Convert::Color::HUSL->new(12.17705, 100, 53.23712);
  my $green = Convert::Color::HUSL->new('127.71501,100,87.73552');

  use Convert::Color;
  my $blue = Convert::Color->new('husl:265.87432,100,32.30087');

  say $red->H; # 12.17705
  say $red->S; # 100
  say $red->L; # 53.23712
  say join ',', $blue->hsl; # 265.87432,100,32.30087

=head1 DESCRIPTION

Objects of this class represent colors in the HUSL color space, revision 4.

Methods:

=over

=item Convert::Color::HUSL->B<new>(I<$h>, I<$s>, I<$l>)

Construct a color from its components.

=item Convert::Color::HUSL->B<new>(I<"$h,$s,$l">)

Construct a color from a string. The string should contain the three
components, separated by commas.

=item $husl->B<H>

=item $husl->B<S>

=item $husl->B<L>

Accessors for the three components of the color.

=item $husl->B<hsl>

Returns the three components as a list.

=back

=head1 SEE ALSO

L<Convert::Color>, L<http://www.husl-colors.org/>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.20.2 or,
at your option, any later version of Perl 5 you may have available.


=cut