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 with two special formats: hex_string and array
3              
4             package Graphics::Toolkit::Color::Space::Instance::RGB;
5 16     16   256218 use v5.12;
  16         47  
6 16     16   61 use warnings;
  16         18  
  16         762  
7 16     16   6047 use Graphics::Toolkit::Color::Space;
  16         1533  
  16         5620  
8              
9 9     9 0 14 sub hex_from_tuple { uc sprintf("#%02x%02x%02x", @{$_[1]} ) } # translate [ r, g, b ] --> #000000
  9         98  
10             sub tuple_from_hex { # translate #000000 or #000 --> [ r, g, b ]
11 124     124 0 175 my ($self, $hex) = @_;
12 124 100 66     871 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;
16             # ($_[0] =~ /^#[[:xdigit:]]{3}$/ or $_[0] =~ /^#[[:xdigit:]]{6}$/)
17 14         29 $hex = substr $hex, 1;
18 9         33 [(length $hex == 3) ? (map { hex($_.$_) } unpack( "a1 a1 a1", $hex))
19 14 100       98 : (map { hex($_ ) } unpack( "a2 a2 a2", $hex))];
  33         93  
20             }
21              
22             Graphics::Toolkit::Color::Space->new (
23             alias_name => 'SRGB', # standard RGB, name is RGB
24             family => 'RGB',
25             axis => [qw/red green blue/],
26             range => 255,
27             precision => 0,
28             format => { 'hex_string' => [\&hex_from_tuple, \&tuple_from_hex],}
29             );