]>
Commit | Line | Data |
---|---|---|
1 | package Convert::Color::HSLuv; | |
2 | ||
3 | use 5.008009; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Convert::Color/; | |
7 | ||
8 | use Convert::Color::XYZ; | |
9 | use Convert::Color::LUV; | |
10 | use Convert::Color::LCh; | |
11 | use List::Util qw/min/; | |
12 | use Math::Trig qw/:pi/; | |
13 | ||
14 | BEGIN { | |
15 | *MAT_R = *Convert::Color::XYZ::MAT_R; | |
16 | *MAT_G = *Convert::Color::XYZ::MAT_G; | |
17 | *MAT_B = *Convert::Color::XYZ::MAT_B; | |
18 | ||
19 | *KAPPA = *Convert::Color::LUV::KAPPA; | |
20 | *EPS = *Convert::Color::LUV::EPS; | |
21 | } | |
22 | ||
23 | our $VERSION = '1.000001'; | |
24 | ||
25 | __PACKAGE__->register_color_space('hsluv'); | |
26 | ||
27 | sub new { | |
28 | my ($class, $h, $s, $l) = @_; | |
29 | ($h, $s, $l) = split /,/s, $h unless defined $s; | |
30 | bless [$h, $s, $l], $class | |
31 | } | |
32 | ||
33 | sub H { shift->[0] } | |
34 | sub S { shift->[1] } | |
35 | sub L { shift->[2] } | |
36 | ||
37 | sub hsl { @{$_[0]} } | |
38 | ||
39 | sub _get_bounds { | |
40 | my ($l) = @_; | |
41 | my $sub1 = ($l + 16) ** 3 / 1_560_896; | |
42 | my $sub2 = $sub1 > EPS ? $sub1 : $l / KAPPA; | |
43 | my @ret; | |
44 | ||
45 | for (MAT_R, MAT_G, MAT_B) { | |
46 | my ($m1, $m2, $m3) = @$_; | |
47 | for (0, 1) { | |
48 | my $top1 = (284_517 * $m1 - 94_839 * $m3) * $sub2; | |
49 | my $top2 = (838_422 * $m3 + 769_860 * $m2 + 731_718 * $m1) * $l * $sub2 - 769_860 * $_ * $l; | |
50 | my $bottom = (632_260 * $m3 - 126_452 * $m2) * $sub2 + 126_452 * $_; | |
51 | push @ret, [$top1 / $bottom, $top2 / $bottom] | |
52 | } | |
53 | } | |
54 | ||
55 | @ret | |
56 | } | |
57 | ||
58 | sub _length_of_ray_until_intersect { | |
59 | my ($theta, $line) = @_; | |
60 | my ($m, $n) = @$line; | |
61 | my $len = $n / (sin ($theta) - $m * cos $theta); | |
62 | return if $len < 0; | |
63 | $len | |
64 | } | |
65 | ||
66 | sub max_chroma_for_lh { | |
67 | my ($self, $l, $h) = @_; | |
68 | my $hrad = $h / 180 * pi; | |
69 | min map { | |
70 | _length_of_ray_until_intersect $hrad, $_ | |
71 | } _get_bounds $l; | |
72 | } | |
73 | ||
74 | sub convert_to_lch { | |
75 | my ($self) = @_; | |
76 | my ($h, $s, $l) = @$self; | |
77 | return Convert::Color::LCh->new(100, 0, $h) if $l > 99.9999999; | |
78 | return Convert::Color::LCh->new(0, 0, $h) if $l < 0.00000001; | |
79 | my $max = $self->max_chroma_for_lh($l, $h); | |
80 | my $c = $max / 100 * $s; | |
81 | Convert::Color::LCh->new($l, $c, $h) | |
82 | } | |
83 | ||
84 | sub new_from_lch { | |
85 | my ($class, $lch) = @_; | |
86 | my ($l, $c, $h) = @$lch; | |
87 | return $class->new($h, 0, 100) if $l > 99.9999999; | |
88 | return $class->new($h, 0, 0) if $l < 0.00000001; | |
89 | my $max = $class->max_chroma_for_lh($l, $h); | |
90 | my $s = $c / $max * 100; | |
91 | $class->new($h, $s, $l) | |
92 | } | |
93 | ||
94 | sub rgb { shift->convert_to_lch->rgb } | |
95 | sub new_rgb { shift->new_from_lch(Convert::Color::LCh->new_rgb(@_)) } | |
96 | ||
97 | 1; | |
98 | __END__ | |
99 | ||
100 | =encoding utf-8 | |
101 | ||
102 | =head1 NAME | |
103 | ||
104 | Convert::Color::HSLuv - a color value in the HSLuv color space | |
105 | ||
106 | =head1 SYNOPSIS | |
107 | ||
108 | use Convert::Color::HSLuv; | |
109 | my $red = Convert::Color::HSLuv->new(12.17705, 100, 53.23712); | |
110 | my $green = Convert::Color::HSLuv->new('127.71501,100,87.73552'); | |
111 | ||
112 | use Convert::Color; | |
113 | my $blue = Convert::Color->new('hsluv:265.87432,100,32.30087'); | |
114 | ||
115 | say $red->H; # 12.17705 | |
116 | say $red->S; # 100 | |
117 | say $red->L; # 53.23712 | |
118 | say join ',', $blue->hsl; # 265.87432,100,32.30087 | |
119 | ||
120 | =head1 DESCRIPTION | |
121 | ||
122 | Objects of this class represent colors in the HSLuv color space, revision 4. | |
123 | ||
124 | Methods: | |
125 | ||
126 | =over | |
127 | ||
128 | =item Convert::Color::HSLuv->B<new>(I<$h>, I<$s>, I<$l>) | |
129 | ||
130 | Construct a color from its components. | |
131 | ||
132 | =item Convert::Color::HSLuv->B<new>(I<"$h,$s,$l">) | |
133 | ||
134 | Construct a color from a string. The string should contain the three | |
135 | components, separated by commas. | |
136 | ||
137 | =item $hsluv->B<H> | |
138 | ||
139 | =item $hsluv->B<S> | |
140 | ||
141 | =item $hsluv->B<L> | |
142 | ||
143 | Accessors for the three components of the color. | |
144 | ||
145 | =item $hsluv->B<hsl> | |
146 | ||
147 | Returns the three components as a list. | |
148 | ||
149 | =back | |
150 | ||
151 | =head1 SEE ALSO | |
152 | ||
153 | L<Convert::Color>, L<http://www.hsluv.org/> | |
154 | ||
155 | =head1 AUTHOR | |
156 | ||
157 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
158 | ||
159 | =head1 COPYRIGHT AND LICENSE | |
160 | ||
161 | Copyright (C) 2015-2017 by Marius Gavrilescu | |
162 | ||
163 | This library is free software; you can redistribute it and/or modify | |
164 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
165 | at your option, any later version of Perl 5 you may have available. | |
166 | ||
167 | ||
168 | =cut |