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   329963 use v5.12;
  15         84  
6 15     15   83 use warnings;
  15         25  
  15         807  
7 15     15   8534 use Graphics::Toolkit::Color::Space;
  15         66  
  15         5991  
8              
9 9     9 0 23 sub hex_from_tuple { uc sprintf("#%02x%02x%02x", @{$_[1]} ) } # translate [ r, g, b ] --> #000000
  9         117  
10             sub tuple_from_hex { # translate #000000 or #000 --> [ r, g, b ]
11 71     71 0 180 my ($self, $hex) = @_;
12 71 100 66     892 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 12         41 $hex = substr $hex, 1;
18 9         28 [(length $hex == 3) ? (map { hex($_.$_) } unpack( "a1 a1 a1", $hex))
19 12 100       97 : (map { hex($_ ) } unpack( "a2 a2 a2", $hex))];
  27         81  
20             }
21              
22             Graphics::Toolkit::Color::Space->new (
23             axis => [qw/red green blue/],
24             range => 255,
25             precision => 0,
26             format => { 'hex_string' => [\&hex_from_tuple, \&tuple_from_hex],
27             'array' => [ sub { $_[1] }, sub { $_[1] } ] },
28             );