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