File Coverage

blib/lib/PDF/Builder/Resource/ColorSpace/DeviceN.pm
Criterion Covered Total %
statement 18 78 23.0
branch 0 8 0.0
condition 0 2 0.0
subroutine 6 8 75.0
pod 2 2 100.0
total 26 98 26.5


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::ColorSpace::DeviceN;
2              
3 1     1   957 use base 'PDF::Builder::Resource::ColorSpace';
  1         3  
  1         129  
4              
5 1     1   5 use strict;
  1         2  
  1         16  
6 1     1   4 use warnings;
  1         1  
  1         112  
7              
8             our $VERSION = '3.028'; # VERSION
9             our $LAST_UPDATE = '3.027'; # manually update whenever code is changed
10              
11 1     1   6 use PDF::Builder::Basic::PDF::Utils;
  1         1  
  1         117  
12 1     1   6 use PDF::Builder::Util;
  1         1  
  1         145  
13 1     1   5 use Scalar::Util qw(weaken);
  1         2  
  1         750  
14              
15             =head1 NAME
16              
17             PDF::Builder::Resource::ColorSpace::DeviceN - Colorspace handling for Device CMYK
18              
19             Inherits from L<PDF::Builder::Resource::ColorSpace>
20              
21             =head2 new
22              
23             PDF::Builder::Resource::ColorSpace:DeviceN->new($pdf, $key, $clrs)
24              
25             =over
26              
27             Create a new DeviceN ColorSpace object.
28              
29             =back
30              
31             =cut
32              
33             sub new {
34 0     0 1   my ($class, $pdf, $key, $clrs) = @_;
35              
36 0           my $sampled = 2;
37              
38 0 0         $class = ref($class) if ref($class);
39 0           my $self = $class->SUPER::new($pdf, $key);
40 0 0         $pdf->new_obj($self) unless $self->is_obj($pdf);
41 0           $self->{' apipdf'} = $pdf;
42 0           weaken $self->{' apipdf'};
43              
44 0           my $fct = PDFDict();
45              
46 0           my $csname = 'DeviceCMYK'; # $clrs->[0]->type()
47             # The base colorspace was formerly chosen based on the base colorspace of
48             # the first color component, but since only DeviceCMYK has been implemented
49             # (everything else throws an error), always use DeviceCMYK.
50            
51 0           my @xclr = map { $_->color() } @{$clrs};
  0            
  0            
52 0           my @xnam = map { $_->tintname() } @{$clrs};
  0            
  0            
53 0 0         if ($csname eq 'DeviceCMYK') {
54 0           @xclr = map { [ namecolor_cmyk($_) ] } @xclr;
  0            
55              
56 0           $fct->{'FunctionType'} = PDFNum(0);
57 0           $fct->{'Order'} = PDFNum(3);
58 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} (0,1,0,1,0,1,0,1));
  0            
59 0           $fct->{'BitsPerSample'} = PDFNum(8);
60 0           $fct->{'Domain'} = PDFArray();
61 0           $fct->{'Size'} = PDFArray();
62 0           foreach (@xclr) {
63 0           $fct->{'Size'}->add_elements(PDFNum($sampled));
64 0           $fct->{'Domain'}->add_elements(PDFNum(0), PDFNum(1));
65             }
66 0           my @spec = ();
67 0           foreach my $xc (0 .. (scalar @xclr)-1) {
68 0           foreach my $n (0 .. ($sampled**(scalar @xclr))-1) {
69 0   0       $spec[$n] ||= [0,0,0,0];
70 0           my $factor = ($n/($sampled**$xc)) % $sampled;
71 0           my @thiscolor = map { ($_*$factor)/($sampled-1) } @{$xclr[$xc]};
  0            
  0            
72 0           foreach my $s (0..3) {
73 0           $spec[$n]->[$s] += $thiscolor[$s];
74             }
75 0 0         @{$spec[$n]} = map { $_>1? 1: $_ } @{$spec[$n]};
  0            
  0            
  0            
76             }
77             }
78 0           my @b;
79 0           foreach my $s (@spec) {
80 0           push @b,(map { pack('C', $_*255) } @{$s});
  0            
  0            
81             }
82 0           $fct->{' stream'} = join('', @b);
83             } else {
84 0           die "unsupported colorspace specification ($csname).";
85             }
86 0           $fct->{'Filter'} = PDFArray(PDFName('ASCIIHexDecode'));
87 0           $self->type($csname);
88 0           $pdf->new_obj($fct);
89 0           my $attr = PDFDict();
90 0           foreach my $cs (@$clrs) {
91 0           $attr->{$cs->tintname()} = $cs;
92             }
93             $self->add_elements(PDFName('DeviceN'),
94 0           PDFArray(map { PDFName($_) } @xnam),
  0            
95             PDFName($csname),
96             $fct);
97              
98 0           return $self;
99             }
100              
101             sub param {
102 0     0 1   my $self = shift;
103              
104 0           return @_;
105             }
106              
107             1;