File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm
Criterion Covered Total %
statement 34 34 100.0
branch 21 30 70.0
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 60 71 84.5


line stmt bran cond sub pod time code
1              
2             # HWB color space specific code
3              
4             package Graphics::Toolkit::Color::Space::Instance::HWB;
5 15     15   165914 use v5.12;
  15         44  
6 15     15   72 use warnings;
  15         29  
  15         742  
7 15     15   563 use Graphics::Toolkit::Color::Space qw/min max/;
  15         71  
  15         6774  
8              
9             # add constraint W + B <= 100
10              
11             sub from_rgb {
12 7     7 0 13 my ($r, $g, $b) = @{$_[0]};
  7         21  
13 7         27 my $vmax = max($r, $g, $b);
14 7         23 my $white = my $vmin = min($r, $g, $b);
15 7 100       64 return ([0,1,0]) if $white == 1;
16 4         8 my $black = 1 - ($vmax);
17 4 50       11 return ([0,0,1]) if $black == 1;
18              
19 4         8 my $d = $vmax - $vmin;
20 4         7 my $s = $d / $vmax;
21 4 100       25 my $h = ($d == 0) ? 0 :
    0          
    50          
    100          
22             ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) :
23             ($vmax == $g) ? (($b - $r) / $d + 2)
24             : (($r - $g) / $d + 4);
25 4         19 return ([$h/6, $white, $black]);
26             }
27             sub to_rgb {
28 9     9 0 19 my ($h, $w, $b) = @{$_[0]};
  9         25  
29 9 100       40 return ([0, 0, 0]) if $b == 1;
30 5 50       31 return ([1, 1, 1]) if $w == 1;
31 5         12 my $v = 1 - $b;
32 5         14 my $s = 1 - ($w / $v);
33 5 50       13 $s = 0 if $s < 0;
34 5 100       17 return ([$v, $v, $v]) if $s == 0;
35              
36 3         11 my $hi = int( $h * 6 );
37 3         9 my $f = ( $h * 6 ) - $hi;
38 3         8 my $p = $v * (1 - $s );
39 3         9 my $q = $v * (1 - ($s * $f));
40 3         7 my $t = $v * (1 - ($s * (1 - $f)));
41 3 100       50 my @rgb = ($hi == 1) ? ($q, $v, $p)
    100          
    50          
    50          
    50          
42             : ($hi == 2) ? ($p, $v, $t)
43             : ($hi == 3) ? ($p, $q, $v)
44             : ($hi == 4) ? ($t, $p, $v)
45             : ($hi == 5) ? ($v, $p, $q)
46             : ($v, $t, $p);
47 3         14 return \@rgb;
48             }
49              
50             Graphics::Toolkit::Color::Space->new(
51             axis => [qw/hue whiteness blackness/],
52             range => [360, 100, 100],
53             precision => 0,
54             type => [qw/angular linear linear/],
55             suffix => ['', '%', '%'],
56             constraint => {cone => {checker => '$_[0][1] + $_[0][2] <= 1',
57             error => 'The sum of whiteness and blackness can not exceed 100%.',
58             remedy => 'my $s = $_[0][1] + $_[0][2];[$_[0][0], $_[0][1]/$s, $_[0][2]/$s]', }},
59              
60             convert => {RGB => [\&to_rgb, \&from_rgb]},
61             );