| 1 | package Convert::Color::LCh; |
| 2 | |
| 3 | use 5.014000; |
| 4 | use strict; |
| 5 | use warnings; |
| 6 | use parent qw/Convert::Color/; |
| 7 | |
| 8 | our $VERSION = '0.001'; |
| 9 | |
| 10 | use Convert::Color::LUV; |
| 11 | use Math::Trig ':pi'; |
| 12 | |
| 13 | __PACKAGE__->register_color_space('lch'); |
| 14 | |
| 15 | sub new { |
| 16 | my ($class, $l, $c, $h) = @_; |
| 17 | ($l, $c, $h) = split /,/s, $l unless defined $c; |
| 18 | bless [$l, $c, $h], $class |
| 19 | } |
| 20 | |
| 21 | sub L { shift->[0] } |
| 22 | sub C { shift->[1] } |
| 23 | sub h { shift->[2] } |
| 24 | |
| 25 | sub lch { @{$_[0]} } |
| 26 | |
| 27 | sub convert_to_luv { |
| 28 | my ($self) = @_; |
| 29 | my ($l, $c, $h) = @$self; |
| 30 | my $hrad = $h / 180 * pi; |
| 31 | my $u = $c * cos $hrad; |
| 32 | my $v = $c * sin $hrad; |
| 33 | Convert::Color::LUV->new($l, $u, $v) |
| 34 | } |
| 35 | |
| 36 | sub new_from_luv { |
| 37 | my ($class, $luv) = @_; |
| 38 | my ($l, $u, $v) = @$luv; |
| 39 | my $c = sqrt $u * $u + $v * $v; |
| 40 | return $class->new($l, $c, 0) if $c < 0.00000001; |
| 41 | my $hrad = atan2 $v, $u; |
| 42 | my $h = $hrad * 180 / pi; |
| 43 | $h += 360 if $h < 0; |
| 44 | $class->new($l, $c, $h) |
| 45 | } |
| 46 | |
| 47 | sub rgb { shift->convert_to_luv->rgb } |
| 48 | sub new_rgb { shift->new_from_luv(Convert::Color::LUV->new_rgb(@_)) } |
| 49 | |
| 50 | 1; |
| 51 | __END__ |
| 52 | |
| 53 | =encoding utf-8 |
| 54 | |
| 55 | =head1 NAME |
| 56 | |
| 57 | Convert::Color::LCh - a color value in the CIE LCh color space |
| 58 | |
| 59 | =head1 SYNOPSIS |
| 60 | |
| 61 | use Convert::Color::LCh; |
| 62 | my $red = Convert::Color::LCh->new(53.23712, 179.03810, 12.17705); |
| 63 | my $green = Convert::Color::LCh->new('87.73552,135.78953,127.71501'); |
| 64 | |
| 65 | use Convert::Color; |
| 66 | my $blue = Convert::Color->new('lch:32.30087,130.68975,265.87432'); |
| 67 | |
| 68 | say $red->L; # 53.23712 |
| 69 | say $red->C; # 179.03810 |
| 70 | say $red->h; # 12.17705 |
| 71 | say join ',', $blue->lch; # 32.30087,130.68975,265.87432 |
| 72 | |
| 73 | =head1 DESCRIPTION |
| 74 | |
| 75 | Objects of this class represent colors in the CIE LCh color space. |
| 76 | |
| 77 | Methods: |
| 78 | |
| 79 | =over |
| 80 | |
| 81 | =item Convert::Color::LCh->B<new>(I<$l>, I<$c>, I<$h>) |
| 82 | |
| 83 | Construct a color from its components. |
| 84 | |
| 85 | =item Convert::Color::LCh->B<new>(I<"$l,$c,$h">) |
| 86 | |
| 87 | Construct a color from a string. The string should contain the three |
| 88 | components, separated by commas. |
| 89 | |
| 90 | =item $lch->B<L> |
| 91 | |
| 92 | =item $lch->B<C> |
| 93 | |
| 94 | =item $lch->B<h> |
| 95 | |
| 96 | Accessors for the three components of the color. |
| 97 | |
| 98 | =item $lch->B<lch> |
| 99 | |
| 100 | Returns the three components as a list. |
| 101 | |
| 102 | =back |
| 103 | |
| 104 | =head1 SEE ALSO |
| 105 | |
| 106 | L<Convert::Color> |
| 107 | |
| 108 | =head1 AUTHOR |
| 109 | |
| 110 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> |
| 111 | |
| 112 | =head1 COPYRIGHT AND LICENSE |
| 113 | |
| 114 | Copyright (C) 2015 by Marius Gavrilescu |
| 115 | |
| 116 | This library is free software; you can redistribute it and/or modify |
| 117 | it under the same terms as Perl itself, either Perl version 5.20.2 or, |
| 118 | at your option, any later version of Perl 5 you may have available. |
| 119 | |
| 120 | |
| 121 | =cut |