File Coverage

blib/lib/PDF/Builder/Resource/ColorSpace/Separation.pm
Criterion Covered Total %
statement 18 93 19.3
branch 0 18 0.0
condition 0 6 0.0
subroutine 6 10 60.0
pod 4 4 100.0
total 28 131 21.3


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::ColorSpace::Separation;
2              
3 1     1   1028 use base 'PDF::Builder::Resource::ColorSpace';
  1         3  
  1         94  
4              
5 1     1   5 use strict;
  1         1  
  1         18  
6 1     1   4 use warnings;
  1         1  
  1         54  
7              
8             our $VERSION = '3.028'; # VERSION
9             our $LAST_UPDATE = '3.027'; # manually update whenever code is changed
10              
11 1     1   4 use PDF::Builder::Basic::PDF::Utils;
  1         2  
  1         91  
12 1     1   5 use PDF::Builder::Util;
  1         1  
  1         125  
13 1     1   5 use Scalar::Util qw(weaken);
  1         1  
  1         964  
14              
15             =head1 NAME
16              
17             PDF::Builder::Resource::ColorSpace::Separation - Support for color space separations
18              
19             Inherits from L<PDF::Builder::Resource::ColorSpace>
20              
21             =head1 METHODS
22              
23             =head2 new
24              
25             $cs = PDF::Builder::Resource::ColorSpace::Separation->new($pdf, $key, @colors)
26              
27             =over
28              
29             Returns a new colorspace object.
30              
31             =back
32              
33             =cut
34              
35             sub new {
36 0     0 1   my ($class, $pdf, $key, $name, @clr) = @_;
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;
47 0           $clr[0] = lc($clr[0]);
48 0           $self->color(@clr);
49 0 0         if ($clr[0] =~ /^[a-z\#\!]+/) {
    0          
    0          
    0          
    0          
50             # colorname or #! specifier
51             # with rgb target colorspace
52             # namecolor returns always a RGB
53 0           my ($r,$g,$b) = namecolor($clr[0]);
54 0           $csname = 'DeviceRGB';
55              
56 0           $fct->{'FunctionType'} = PDFNum(0);
57 0           $fct->{'Size'} = PDFArray(PDFNum(2));
58 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} ($r,1, $g,1, $b,1));
  0            
59 0           $fct->{'Domain'} = PDFArray(PDFNum(0), PDFNum(1));
60 0           $fct->{'BitsPerSample'} = PDFNum(8);
61 0           $fct->{' stream'} = "\xff\xff\xff\x00\x00\x00";
62             } elsif ($clr[0] =~ /^[\%]+/) {
63             # % specifier
64             # with cmyk target colorspace
65 0           my ($c,$m,$y,$k) = namecolor_cmyk($clr[0]);
66 0           $csname = 'DeviceCMYK';
67              
68 0           $fct->{'FunctionType'} = PDFNum(0);
69 0           $fct->{'Size'} = PDFArray(PDFNum(2));
70 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} (0,$c, 0,$m, 0,$y, 0,$k));
  0            
71 0           $fct->{'Domain'} = PDFArray(PDFNum(0), PDFNum(1));
72 0           $fct->{'BitsPerSample'} = PDFNum(8);
73 0           $fct->{' stream'}="\x00\x00\x00\x00\xff\xff\xff\xff";
74             } elsif (scalar @clr == 1) {
75             # grey color spec.
76 0           $clr[0] /= 255 while $clr[0] > 1;
77              
78             # adjusted for 8/16/32bit spec.
79 0           my $g = $clr[0];
80 0           $csname = 'DeviceGray';
81              
82 0           $fct->{'FunctionType'} = PDFNum(0);
83 0           $fct->{'Size'} = PDFArray(PDFNum(2));
84 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} (0,$g));
  0            
85 0           $fct->{'Domain'} = PDFArray(PDFNum(0),PDFNum(1));
86 0           $fct->{'BitsPerSample'} = PDFNum(8);
87 0           $fct->{' stream'} = "\xff\x00";
88             } elsif (scalar @clr == 3) {
89             # legacy rgb color-spec (0 <= x <= 1)
90 0           my ($r,$g,$b) = @clr;
91 0           $csname = 'DeviceRGB';
92              
93 0           $fct->{'FunctionType'} = PDFNum(0);
94 0           $fct->{'Size'} = PDFArray(PDFNum(2));
95 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} ($r,1, $g,1, $b,1));
  0            
96 0           $fct->{'Domain'} = PDFArray(PDFNum(0), PDFNum(1));
97 0           $fct->{'BitsPerSample'} = PDFNum(8);
98 0           $fct->{' stream'}="\xff\xff\xff\x00\x00\x00";
99             } elsif (scalar @clr == 4) {
100             # legacy cmyk color-spec (0 <= x <= 1)
101 0           my ($c,$m,$y,$k) = @clr;
102 0           $csname = 'DeviceCMYK';
103              
104 0           $fct->{'FunctionType'} = PDFNum(0);
105 0           $fct->{'Size'} = PDFArray(PDFNum(2));
106 0           $fct->{'Range'} = PDFArray(map {PDFNum($_)} (0,$c, 0,$m, 0,$y, 0,$k));
  0            
107 0           $fct->{'Domain'} = PDFArray(PDFNum(0), PDFNum(1));
108 0           $fct->{'BitsPerSample'} = PDFNum(8);
109 0           $fct->{' stream'}="\x00\x00\x00\x00\xff\xff\xff\xff";
110             } else {
111 0           die 'invalid color specification.';
112             }
113 0           $self->type($csname);
114 0           $pdf->new_obj($fct);
115 0           $self->add_elements(PDFName('Separation'),
116             PDFName($name),
117             PDFName($csname),
118             $fct);
119 0           $self->tintname($name);
120 0           return $self;
121             }
122              
123             =head2 color
124              
125             @color = $res->color()
126              
127             =over
128              
129             Returns the base-color of the Separation-Colorspace.
130              
131             =back
132              
133             =cut
134              
135             sub color {
136 0     0 1   my $self = shift;
137              
138 0 0 0       if (@_ && defined $_[0]) {
139 0           $self->{' color'} = [@_];
140             }
141 0           return @{$self->{' color'}};
  0            
142             }
143              
144             =head2 tintname
145              
146             $tintname = $res->tintname($tintname)
147              
148             =over
149              
150             Returns the tint-name of the Separation-Colorspace.
151              
152             =back
153              
154             =cut
155              
156             sub tintname {
157 0     0 1   my $self = shift;
158              
159 0 0 0       if (@_ && defined $_[0]) {
160 0           $self->{' tintname'} = [@_];
161             }
162 0           return @{$self->{' tintname'}};
  0            
163             }
164              
165             sub param {
166 0     0 1   my $self = shift;
167              
168 0           return $_[0];
169             }
170              
171             1;