| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
# OK LCH cylindrical color space variant of OKLAB |
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Graphics::Toolkit::Color::Space::Instance::OKLCH; |
|
5
|
15
|
|
|
15
|
|
262855
|
use v5.12; |
|
|
15
|
|
|
|
|
578
|
|
|
6
|
15
|
|
|
15
|
|
87
|
use warnings; |
|
|
15
|
|
|
|
|
28
|
|
|
|
15
|
|
|
|
|
973
|
|
|
7
|
15
|
|
|
15
|
|
537
|
use Graphics::Toolkit::Color::Space qw/round_decimals/; |
|
|
15
|
|
|
|
|
33
|
|
|
|
15
|
|
|
|
|
5579
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
my $TAU = 6.283185307; |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub from_lab { |
|
12
|
6
|
|
|
6
|
0
|
18
|
my ($lab) = shift; |
|
13
|
6
|
|
|
|
|
20
|
my $a = $lab->[1] - .5; |
|
14
|
6
|
|
|
|
|
18
|
my $b = $lab->[2] - .5; |
|
15
|
|
|
|
|
|
|
|
|
16
|
6
|
100
|
|
|
|
25
|
$a = 0 if round_decimals($a, 5) == 0; |
|
17
|
6
|
100
|
|
|
|
18
|
$b = 0 if round_decimals($b, 5) == 0; |
|
18
|
6
|
|
|
|
|
30
|
my $c = sqrt( ($a**2) + ($b**2)); |
|
19
|
6
|
|
|
|
|
28
|
my $h = atan2($b, $a); |
|
20
|
6
|
100
|
|
|
|
16
|
$h += $TAU if $h < 0; |
|
21
|
6
|
|
|
|
|
30
|
return ([$lab->[0], $c * 2, $h / $TAU]); |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
sub to_lab { |
|
24
|
6
|
|
|
6
|
0
|
15
|
my ($lch) = shift; |
|
25
|
6
|
|
|
|
|
17
|
my $c = $lch->[1] / 2; |
|
26
|
6
|
|
|
|
|
23
|
my $a = $c * cos($lch->[2] * $TAU); |
|
27
|
6
|
|
|
|
|
16
|
my $b = $c * sin($lch->[2] * $TAU); |
|
28
|
6
|
|
|
|
|
27
|
return ([$lch->[0], $a + .5, $b + .5 ]); |
|
29
|
|
|
|
|
|
|
} |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Graphics::Toolkit::Color::Space->new( |
|
32
|
|
|
|
|
|
|
name => 'OKLCH', |
|
33
|
|
|
|
|
|
|
axis => [qw/luminance chroma hue/], |
|
34
|
|
|
|
|
|
|
type => [qw/linear linear angular/], |
|
35
|
|
|
|
|
|
|
range => [1, .5, 360], |
|
36
|
|
|
|
|
|
|
precision => [5,5,2], |
|
37
|
|
|
|
|
|
|
convert => { OKLAB => [\&to_lab, \&from_lab] }, |
|
38
|
|
|
|
|
|
|
); |