File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm
Criterion Covered Total %
statement 32 32 100.0
branch 15 26 57.6
condition n/a
subroutine 6 6 100.0
pod 0 2 0.0
total 53 66 80.3


line stmt bran cond sub pod time code
1 8     8   712 use v5.12;
  8         25  
2 8     8   41 use warnings;
  8         15  
  8         343  
3              
4             # HWB color space specific code
5              
6             package Graphics::Toolkit::Color::Space::Instance::HWB;
7 8     8   47 use Graphics::Toolkit::Color::Space::Util ':all';
  8         13  
  8         1010  
8 8     8   486 use Graphics::Toolkit::Color::Space;
  8         14  
  8         3060  
9              
10             my $hwb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue whiteness blackness/],
11             range => [360, 100, 100],
12             type => [qw/angle linear linear/]);
13              
14             $hwb_def->add_converter('RGB', \&to_rgb, \&from_rgb );
15              
16              
17             sub from_rgb {
18 3     3 0 9 my ($r, $g, $b) = @_;
19 3         11 my $vmax = max($r, $g, $b);
20 3         9 my $white = my $vmin = min($r, $g, $b);
21 3         6 my $black = 1 - ($vmax);
22              
23 3         5 my $d = $vmax - $vmin;
24 3         5 my $s = $d / $vmax;
25 3 50       17 my $h = ($d == 0) ? 0 :
    0          
    50          
    100          
26             ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) :
27             ($vmax == $g) ? (($b - $r) / $d + 2)
28             : (($r - $g) / $d + 4);
29 3         25 return ($h/6, $white, $black);
30             }
31              
32              
33             sub to_rgb {
34 4     4 0 9 my ($h, $w, $b) = @_;
35 4 100       18 return (0, 0, 0) if $b == 1;
36 2 50       4 return (1, 1, 1) if $w == 1;
37 2         5 my $v = 1 - $b;
38 2         4 my $s = 1 - ($w / $v);
39 2 50       5 $s = 0 if $s < 0;
40 2 100       8 return ($v, $v, $v) if $s == 0;
41              
42 1         4 my $hi = int( $h * 6 );
43 1         3 my $f = ( $h * 6 ) - $hi;
44 1         2 my $p = $v * (1 - $s );
45 1         2 my $q = $v * (1 - ($s * $f));
46 1         2 my $t = $v * (1 - ($s * (1 - $f)));
47 1 50       12 my @rgb = ($hi == 1) ? ($q, $v, $p)
    50          
    50          
    50          
    50          
48             : ($hi == 2) ? ($p, $v, $t)
49             : ($hi == 3) ? ($p, $q, $v)
50             : ($hi == 4) ? ($t, $p, $v)
51             : ($hi == 5) ? ($v, $p, $q)
52             : ($v, $t, $p);
53             }
54              
55             $hwb_def;