]>
Commit | Line | Data |
---|---|---|
1 | package Convert::Color::LCh; | |
2 | ||
3 | use 5.008009; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Convert::Color/; | |
7 | ||
8 | our $VERSION = '0.002'; | |
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 |