File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/HSB.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   674 use v5.12;
  8         25  
2 8     8   42 use warnings;
  8         12  
  8         392  
3              
4             # HSB color space specific code
5              
6             package Graphics::Toolkit::Color::Space::Instance::HSB;
7 8     8   49 use Graphics::Toolkit::Color::Space::Util ':all';
  8         13  
  8         1005  
8 8     8   497 use Graphics::Toolkit::Color::Space;
  8         15  
  8         2756  
9              
10             my $hsb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue saturation brightness/],
11             range => [360, 100, 100],
12             type => [qw/angle linear linear/]);
13              
14             $hsb_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         9 my $vmin = min($r, $g, $b);
20 3         7 my $br = my $vmax = max($r, $g, $b);
21 3 100       11 return (0, 0, $br) if $vmax == $vmin;
22              
23 2         4 my $d = $vmax - $vmin;
24 2         4 my $s = $d / $vmax;
25 2 50       10 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, $br);
29             }
30              
31             sub to_rgb {
32 3     3 0 7 my ($h, $s, $b) = @_;
33 3 100       12 return ($b, $b, $b) if $s == 0;
34 2         6 my $hi = int( $h * 6 );
35 2         5 my $f = ( $h * 6 ) - $hi;
36 2         3 my $p = $b * (1 - $s );
37 2         4 my $q = $b * (1 - ($s * $f));
38 2         3 my $t = $b * (1 - ($s * (1 - $f)));
39 2 50       20 my @rgb = ($hi == 1) ? ($q, $b, $p)
    100          
    50          
    50          
    50          
40             : ($hi == 2) ? ($p, $b, $t)
41             : ($hi == 3) ? ($p, $q, $b)
42             : ($hi == 4) ? ($t, $p, $b)
43             : ($hi == 5) ? ($b, $p, $q)
44             : ($b, $t, $p);
45             }
46              
47             $hsb_def;