File Coverage

blib/lib/PDF/API2/Resource/ColorSpace/Indexed.pm
Criterion Covered Total %
statement 27 50 54.0
branch 2 6 33.3
condition 0 3 0.0
subroutine 7 10 70.0
pod 1 4 25.0
total 37 73 50.6


line stmt bran cond sub pod time code
1             package PDF::API2::Resource::ColorSpace::Indexed;
2              
3 2     2   1255 use base 'PDF::API2::Resource::ColorSpace';
  2         4  
  2         609  
4              
5 2     2   14 use strict;
  2         5  
  2         43  
6 2     2   10 use warnings;
  2         4  
  2         84  
7              
8             our $VERSION = '2.043'; # VERSION
9              
10 2     2   11 use PDF::API2::Basic::PDF::Utils;
  2         4  
  2         153  
11 2     2   10 use PDF::API2::Util;
  2         6  
  2         312  
12 2     2   16 use Scalar::Util qw(weaken);
  2         3  
  2         998  
13              
14             sub new {
15 1     1 1 4 my ($class, $pdf, $key, %opts) = @_;
16              
17 1 50       3 $class = ref($class) if ref($class);
18 1         6 my $self = $class->SUPER::new($pdf, $key, %opts);
19 1 50       3 $pdf->new_obj($self) unless $self->is_obj($pdf);
20 1         3 $self->{' apipdf'} = $pdf;
21 1         4 weaken $self->{' apipdf'};
22              
23 1         3 $self->add_elements(PDFName('Indexed'));
24 1         7 $self->type('Indexed');
25              
26 1         3 return $self;
27             }
28              
29             sub enumColors {
30 0     0 0   my $self = shift();
31 0           my %col;
32 0           my $stream = $self->{' csd'}->{' stream'};
33 0           foreach my $n (0..255) {
34 0           my $k = '#' . uc(unpack('H*', substr($stream, $n * 3, 3)));
35 0   0       $col{$k} //= $n;
36             }
37 0           return %col;
38             }
39              
40             sub nameColor {
41 0     0 0   my ($self, $n) = @_;
42 0           my %col;
43 0           my $stream = $self->{' csd'}->{' stream'};
44 0           my $k = '#' . uc(unpack('H*', substr($stream, $n * 3, 3)));
45 0           return $k;
46             }
47              
48             # r, g, b need to be 0-255
49             sub resolveNearestRGB {
50 0     0 0   my ($self, $r, $g, $b) = @_;
51 0           my $c = 0;
52 0           my $w = 768 ** 2;
53 0           my $stream = $self->{' csd'}->{' stream'};
54 0           foreach my $n (0..255) {
55 0           my @e = unpack('C*', substr($stream, $n * 3, 3));
56 0           my $d = ($e[0] - $r) ** 2 + ($e[1] - $g) ** 2 + ($e[2] - $b) ** 2;
57 0 0         if ($d < $w) {
58 0           $c = $n;
59 0           $w = $d;
60             }
61             }
62 0           return $c;
63             }
64              
65             1;