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