File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/HSV.pm
Criterion Covered Total %
statement 27 27 100.0
branch 14 20 70.0
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 46 54 85.1


line stmt bran cond sub pod time code
1              
2             # HSV color space specific code
3              
4             package Graphics::Toolkit::Color::Space::Instance::HSV;
5 16     16   463390 use v5.12;
  16         45  
6 16     16   122 use warnings;
  16         109  
  16         861  
7 16     16   432 use Graphics::Toolkit::Color::Space qw/min max/;
  16         20  
  16         5818  
8              
9             sub from_rgb {
10 5     5 0 11 my ($r, $g, $b) = @{$_[0]};
  5         12  
11 5         36 my $vmin = min($r, $g, $b);
12 5         15 my $v = my $vmax = max($r, $g, $b);
13 5 100       22 return ([0, 0, $v]) if $vmax == $vmin;
14              
15 2         6 my $d = $vmax - $vmin;
16 2         5 my $s = $d / $vmax;
17 2 50       16 my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) :
    50          
    100          
18             ($vmax == $g) ? (($b - $r) / $d + 2)
19             : (($r - $g) / $d + 4);
20 2         11 return ([$h/6, $s, $v]);
21             }
22             sub to_rgb {
23 6     6 0 27 my ($h, $s, $v) = @{$_[0]};
  6         17  
24 6 100       28 return ([$v, $v, $v]) if $s == 0;
25 2         8 my $hi = int( $h * 6 );
26 2         6 my $f = ( $h * 6 ) - $hi;
27 2         4 my $p = $v * (1 - $s );
28 2         7 my $q = $v * (1 - ($s * $f));
29 2         6 my $t = $v * (1 - ($s * (1 - $f)));
30 2 50       18 my @rgb = ($hi == 1) ? ($q, $v, $p)
    100          
    50          
    50          
    50          
31             : ($hi == 2) ? ($p, $v, $t)
32             : ($hi == 3) ? ($p, $q, $v)
33             : ($hi == 4) ? ($t, $p, $v)
34             : ($hi == 5) ? ($v, $p, $q)
35             : ($v, $t, $p);
36 2         9 return \@rgb;
37             }
38              
39             Graphics::Toolkit::Color::Space->new (
40             family => 'HSV',
41             axis => [qw/hue saturation value/],
42             range => [360, 100, 100],
43             precision => 0,
44             type => [qw/angular linear linear/],
45             # suffix => ['', '%', '%'],
46             constraint => {cone => {checker => '$_[0][1] <= $_[0][2]',
47             error => 'saturation can not be greater than value',
48             remedy => '[$_[0][0], $_[0][2], $_[0][2]]', }},
49             convert => {RGB => [\&to_rgb, \&from_rgb]},
50             );
51