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 6 6 100.0
pod 0 2 0.0
total 47 55 85.4


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