File Coverage

blib/lib/PDF/Builder/Resource/ColorSpace/DeviceN.pm
Criterion Covered Total %
statement 18 80 22.5
branch 0 8 0.0
condition 0 2 0.0
subroutine 6 8 75.0
pod 2 2 100.0
total 26 100 26.0


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::ColorSpace::DeviceN;
2              
3 1     1   1209 use base 'PDF::Builder::Resource::ColorSpace';
  1         3  
  1         151  
4              
5 1     1   7 use strict;
  1         3  
  1         23  
6 1     1   6 use warnings;
  1         2  
  1         57  
7             #no warnings qw[ deprecated recursion uninitialized ];
8              
9             our $VERSION = '3.023'; # VERSION
10             our $LAST_UPDATE = '3.021'; # manually update whenever code is changed
11              
12 1     1   6 use PDF::Builder::Basic::PDF::Utils;
  1         3  
  1         122  
13 1     1   7 use PDF::Builder::Util;
  1         3  
  1         184  
14 1     1   8 use Scalar::Util qw(weaken);
  1         3  
  1         791  
15              
16             =head1 NAME
17              
18             PDF::Builder::Resource::ColorSpace::DeviceN - colorspace handling for Device
19             CMYK. Inherits from L
20              
21             =cut
22              
23             sub new {
24 0     0 1   my ($class, $pdf, $key, @opts) = @_;
25              
26             # this is a bit odd, but the only use of ->new() has two values, $clrs
27             # and $sampled, in the argument list
28 0           my ($clrs, $sampled) = @opts;
29              
30 0           $sampled = 2;
31              
32 0 0         $class = ref $class if ref $class;
33 0           my $self = $class->SUPER::new($pdf, $key);
34 0 0         $pdf->new_obj($self) unless $self->is_obj($pdf);
35 0           $self->{' apipdf'} = $pdf;
36 0           weaken $self->{' apipdf'};
37              
38 0           my $fct = PDFDict();
39              
40 0           my $csname = $clrs->[0]->type();
41 0           my @xclr = map { $_->color() } @{$clrs};
  0            
  0            
42 0           my @xnam = map { $_->tintname() } @{$clrs};
  0            
  0            
43             # $self->{' comments'} = "DeviceN ColorSpace\n";
44 0 0         if ($csname eq 'DeviceCMYK') {
45 0           @xclr = map { [ namecolor_cmyk($_) ] } @xclr;
  0            
46              
47 0           $fct->{'FunctionType'} = PDFNum(0);
48 0           $fct->{'Order'} = PDFNum(3);
49 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} (0,1,0,1,0,1,0,1));
  0            
50 0           $fct->{'BitsPerSample'} = PDFNum(8);
51 0           $fct->{'Domain'} = PDFArray();
52 0           $fct->{'Size'} = PDFArray();
53 0           foreach (@xclr) {
54 0           $fct->{'Size'}->add_elements(PDFNum($sampled));
55 0           $fct->{'Domain'}->add_elements(PDFNum(0), PDFNum(1));
56             }
57 0           my @spec = ();
58 0           foreach my $xc (0 .. (scalar @xclr)-1) {
59 0           foreach my $n (0 .. ($sampled**(scalar @xclr))-1) {
60 0   0       $spec[$n] ||= [0,0,0,0];
61 0           my $factor = ($n/($sampled**$xc)) % $sampled;
62             # $self->{' comments'}.="C($n): xc=$xc i=$factor ";
63 0           my @thiscolor = map { ($_*$factor)/($sampled-1) } @{$xclr[$xc]};
  0            
  0            
64             # $self->{' comments'}.="(@{$xclr[$xc]}) --> (@thiscolor) ";
65 0           foreach my $s (0..3) {
66 0           $spec[$n]->[$s] += $thiscolor[$s];
67             }
68 0 0         @{$spec[$n]} = map { $_>1? 1: $_ } @{$spec[$n]};
  0            
  0            
  0            
69             # $self->{' comments'}.="--> (@{$spec[$n]})\n";
70             # $self->{' comments'}.="\n";
71             }
72             }
73 0           my @b = ();
74 0           foreach my $s (@spec) {
75 0           push(@b,(map { pack('C', ($_*255)) } @{$s}));
  0            
  0            
76             }
77 0           $fct->{' stream'} = join('', @b);
78             } else {
79 0           die "unsupported colorspace specification (=$csname).";
80             }
81 0           $fct->{'Filter'} = PDFArray(PDFName('ASCIIHexDecode'));
82 0           $self->type($csname);
83 0           $pdf->new_obj($fct);
84 0           my $attr = PDFDict();
85 0           foreach my $cs (@{$clrs}) {
  0            
86 0           $attr->{$cs->tintname()} = $cs;
87             }
88 0           $self->add_elements(PDFName('DeviceN'), PDFArray(map { PDFName($_) } @xnam), PDFName($csname), $fct);
  0            
89              
90 0           return $self;
91             }
92              
93             sub param {
94 0     0 1   my $self = shift;
95              
96 0           return (@_);
97             }
98              
99             1;