File Coverage

blib/lib/Convert/Color/LCh.pm
Criterion Covered Total %
statement 42 42 100.0
branch 6 6 100.0
condition n/a
subroutine 15 15 100.0
pod 6 9 66.6
total 69 72 95.8


line stmt bran cond sub pod time code
1             package Convert::Color::LCh;
2              
3 2     2   28 use 5.008009;
  2         4  
  2         63  
4 2     2   18 use strict;
  2         2  
  2         55  
5 2     2   6 use warnings;
  2         2  
  2         77  
6 2     2   6 use parent qw/Convert::Color/;
  2         2  
  2         12  
7              
8             our $VERSION = '0.002001';
9              
10 2     2   111 use Convert::Color::LUV;
  2         4  
  2         36  
11 2     2   746464 use Math::Trig ':pi';
  2         28592  
  2         849  
12              
13             __PACKAGE__->register_color_space('lch');
14              
15             sub new {
16 3585     3585 1 4584 my ($class, $l, $c, $h) = @_;
17 3585 100       5151 ($l, $c, $h) = split /,/s, $l unless defined $c;
18 3585         14709 bless [$l, $c, $h], $class
19             }
20              
21 1     1 1 15 sub L { shift->[0] }
22 1     1 1 5 sub C { shift->[1] }
23 1     1 1 4 sub h { shift->[2] }
24              
25 1     1 1 1 sub lch { @{$_[0]} }
  1         10  
26              
27             sub convert_to_luv {
28 1024     1024 0 991 my ($self) = @_;
29 1024         1130 my ($l, $c, $h) = @$self;
30 1024         1056 my $hrad = $h / 180 * pi;
31 1024         1312 my $u = $c * cos $hrad;
32 1024         1100 my $v = $c * sin $hrad;
33 1024         2190 Convert::Color::LUV->new($l, $u, $v)
34             }
35              
36             sub new_from_luv {
37 2560     2560 0 2597 my ($class, $luv) = @_;
38 2560         2610 my ($l, $u, $v) = @$luv;
39 2560         3252 my $c = sqrt $u * $u + $v * $v;
40 2560 100       4196 return $class->new($l, $c, 0) if $c < 0.00000001;
41 2520         4671 my $hrad = atan2 $v, $u;
42 2520         2682 my $h = $hrad * 180 / pi;
43 2520 100       3794 $h += 360 if $h < 0;
44 2520         4186 $class->new($l, $c, $h)
45             }
46              
47 1024     1024 1 1873 sub rgb { shift->convert_to_luv->rgb }
48 2560     2560 0 150243 sub new_rgb { shift->new_from_luv(Convert::Color::LUV->new_rgb(@_)) }
49              
50             1;
51             __END__