File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm
Criterion Covered Total %
statement 16 16 100.0
branch 4 4 100.0
condition 14 15 93.3
subroutine 5 5 100.0
pod 0 2 0.0
total 39 42 92.8


line stmt bran cond sub pod time code
1              
2             # sRGB color space IEC 61966-2-1 has two special formats
3              
4             package Graphics::Toolkit::Color::Space::Instance::RGB;
5 15     15   491812 use v5.12;
  15         68  
6 15     15   87 use warnings;
  15         35  
  15         905  
7 15     15   8539 use Graphics::Toolkit::Color::Space;
  15         92  
  15         10237  
8              
9 9     9 0 18 sub hex_from_tuple { uc sprintf("#%02x%02x%02x", @{$_[1]} ) } # translate [ r, g, b ] --> #000000
  9         121  
10             sub tuple_from_hex { # translate #000000 or #000 --> [ r, g, b ]
11 70     70 0 135 my ($self, $hex) = @_;
12 70 100 66     1299 return "hex color definition '$hex' has to start with # followed by 3 or 6 hex characters (0-9,a-f)"
      100        
      100        
      100        
      100        
13             unless defined $hex and not ref $hex
14             and (length($hex) == 4 or length($hex) == 7)
15             and substr($hex, 0, 1) eq '#' and $hex =~ /^#[\da-f]+$/i; # ($_[0] =~ /^#[[:xdigit:]]{3}$/ or $_[0] =~ /^#[[:xdigit:]]{6}$/)
16 12         48 $hex = substr $hex, 1;
17 9         32 [(length $hex == 3) ? (map { hex($_.$_) } unpack( "a1 a1 a1", $hex))
18 12 100       116 : (map { hex($_ ) } unpack( "a2 a2 a2", $hex))];
  27         85  
19             }
20              
21             Graphics::Toolkit::Color::Space->new (
22             axis => [qw/red green blue/],
23             range => 255,
24             precision => 0,
25             format => { 'hex_string' => [\&hex_from_tuple, \&tuple_from_hex],
26             'array' => [ sub { $_[1] }, sub { $_[1] } ] },
27             );