no
warnings
qw[ recursion uninitialized ]
;
our
$VERSION
=
'2.047'
;
BEGIN {
use
POSIX
qw( HUGE_VAL floor )
;
@ISA
@EXPORT
@EXPORT_OK
%colors
$key_var
%u2n
%n2u
$pua
%PaperSizes
)
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw(
pdfkey
float floats floats5 intg intgs
mMin mMax
HSVtoRGB RGBtoHSV HSLtoRGB RGBtoHSL RGBtoLUM
namecolor namecolor_cmyk namecolor_lab optInvColor defineColor
dofilter unfilter
nameByUni uniByName initNameTable defineName
page_size
getPaperSizes
)
;
@EXPORT_OK
=
qw(
pdfkey
digest digestx digest16 digest32
float floats floats5 intg intgs
mMin mMax
cRGB cRGB8 RGBasCMYK
HSVtoRGB RGBtoHSV HSLtoRGB RGBtoHSL RGBtoLUM
namecolor namecolor_cmyk namecolor_lab optInvColor defineColor
dofilter unfilter
nameByUni uniByName initNameTable defineName
page_size
)
;
%colors
= PDF::API2::Resource::Colors->get_colors();
%PaperSizes
= PDF::API2::Resource::PaperSizes->get_paper_sizes();
no
warnings
qw[ recursion uninitialized ]
;
$key_var
=
'CBA'
;
$pua
= 0xE000;
%u2n
= %{
$PDF::API2::Resource::Glyphs::u2n
};
%n2u
= %{
$PDF::API2::Resource::Glyphs::n2u
};
}
sub
pdfkey {
return
$PDF::API2::Util::key_var
++;
}
sub
digestx {
my
$len
=
shift
();
my
$mask
=
$len
- 1;
my
$ddata
=
join
(
''
,
@_
);
my
$mdkey
=
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789gT'
;
my
$xdata
=
'0'
x
$len
;
my
$off
= 0;
foreach
my
$set
(0 .. (
length
(
$ddata
) << 1)) {
$off
+=
vec
(
$ddata
,
$set
, 4);
$off
+=
vec
(
$xdata
, (
$set
&
$mask
), 8);
vec
(
$xdata
, (
$set
& (
$mask
<< 1 | 1)), 4) =
vec
(
$mdkey
, (
$off
& 0x7f), 4);
}
return
$xdata
;
}
sub
digest {
return
digestx(32,
@_
);
}
sub
digest16 {
return
digestx(16,
@_
);
}
sub
digest32 {
return
digestx(32,
@_
);
}
sub
xlog10 {
my
$n
=
shift
();
if
(
$n
) {
return
log
(
abs
(
$n
)) /
log
(10);
}
else
{
return
0;
}
}
sub
float {
my
$f
=
shift
();
my
$mxd
=
shift
() || 4;
$f
= 0
if
abs
(
$f
) < 0.0000000000000001;
my
$ad
= floor(xlog10(
$f
) -
$mxd
);
if
(
abs
(
$f
-
int
(
$f
)) < (10 ** (-
$mxd
))) {
return
sprintf
(
'%i'
,
$f
);
}
elsif
(
$ad
> 0) {
my
$value
=
sprintf
(
'%f'
,
$f
);
$value
=~ s/(\.\d*?)0+$/$1/;
$value
=~ s/\.$//;
return
$value
;
}
else
{
my
$value
=
sprintf
(
'%.*f'
,
abs
(
$ad
),
$f
);
$value
=~ s/(\.\d*?)0+$/$1/;
$value
=~ s/\.$//;
return
$value
;
}
}
sub
floats {
return
map
{ float(
$_
) }
@_
; }
sub
floats5 {
return
map
{ float(
$_
, 5) }
@_
; }
sub
intg {
my
$f
=
shift
();
return
sprintf
(
'%i'
,
$f
);
}
sub
intgs {
return
map
{ intg(
$_
) }
@_
; }
sub
mMin {
my
$n
= HUGE_VAL();
map
{
$n
= (
$n
>
$_
) ?
$_
:
$n
}
@_
;
return
$n
;
}
sub
mMax {
my
$n
= -HUGE_VAL();
map
{
$n
= (
$n
<
$_
) ?
$_
:
$n
}
@_
;
return
$n
;
}
sub
cRGB {
my
@cmy
= (
map
{ 1 -
$_
}
@_
);
my
$k
= mMin(
@cmy
);
return
(
map
{
$_
-
$k
}
@cmy
),
$k
;
}
sub
cRGB8 {
return
cRGB(
map
{
$_
/ 255 }
@_
);
}
sub
RGBtoLUM {
my
(
$r
,
$g
,
$b
) =
@_
;
return
$r
* 0.299 +
$g
* 0.587 +
$b
* 0.114;
}
sub
RGBasCMYK {
my
@rgb
=
@_
;
my
@cmy
=
map
{ 1 -
$_
}
@rgb
;
my
$k
= mMin(
@cmy
) * 0.44;
return
(
map
{
$_
-
$k
}
@cmy
),
$k
;
}
sub
HSVtoRGB {
my
(
$h
,
$s
,
$v
) =
@_
;
my
(
$r
,
$g
,
$b
,
$i
,
$f
,
$p
,
$q
,
$t
);
if
(
$s
== 0) {
return
(
$v
,
$v
,
$v
);
}
$h
%= 360;
$h
/= 60;
$i
= POSIX::floor(
$h
);
$f
=
$h
-
$i
;
$p
=
$v
* (1 -
$s
);
$q
=
$v
* (1 -
$s
*
$f
);
$t
=
$v
* (1 -
$s
* (1 -
$f
));
if
(
$i
< 1) {
$r
=
$v
;
$g
=
$t
;
$b
=
$p
;
}
elsif
(
$i
< 2) {
$r
=
$q
;
$g
=
$v
;
$b
=
$p
;
}
elsif
(
$i
< 3) {
$r
=
$p
;
$g
=
$v
;
$b
=
$t
;
}
elsif
(
$i
< 4) {
$r
=
$p
;
$g
=
$q
;
$b
=
$v
;
}
elsif
(
$i
< 5) {
$r
=
$t
;
$g
=
$p
;
$b
=
$v
;
}
else
{
$r
=
$v
;
$g
=
$p
;
$b
=
$q
;
}
return
(
$r
,
$g
,
$b
);
}
sub
RGBquant {
my
(
$q1
,
$q2
,
$h
) =
@_
;
while
(
$h
< 0){
$h
+= 360;
}
$h
%= 360;
if
(
$h
< 60) {
return
$q1
+ ((
$q2
-
$q1
) *
$h
/ 60);
}
elsif
(
$h
< 180) {
return
$q2
;
}
elsif
(
$h
< 240) {
return
$q1
+ ((
$q2
-
$q1
) * (240 -
$h
) / 60);
}
else
{
return
$q1
;
}
}
sub
RGBtoHSV {
my
(
$r
,
$g
,
$b
) =
@_
;
my
(
$h
,
$s
,
$v
,
$min
,
$max
,
$delta
);
$min
= mMin(
$r
,
$g
,
$b
);
$max
= mMax(
$r
,
$g
,
$b
);
$v
=
$max
;
$delta
=
$max
-
$min
;
if
(
$delta
> 0.000000001) {
$s
=
$delta
/
$max
;
}
else
{
$s
= 0;
$h
= 0;
return
(
$h
,
$s
,
$v
);
}
if
(
$r
==
$max
) {
$h
= (
$g
-
$b
) /
$delta
;
}
elsif
(
$g
==
$max
) {
$h
= 2 + (
$b
-
$r
) /
$delta
;
}
else
{
$h
= 4 + (
$r
-
$g
) /
$delta
;
}
$h
*= 60;
if
(
$h
< 0) {
$h
+= 360;
}
return
(
$h
,
$s
,
$v
);
}
sub
RGBtoHSL {
my
(
$r
,
$g
,
$b
) =
@_
;
my
(
$h
,
$s
,
$v
,
$l
,
$min
,
$max
,
$delta
);
$min
= mMin(
$r
,
$g
,
$b
);
$max
= mMax(
$r
,
$g
,
$b
);
(
$h
,
$s
,
$v
) = RGBtoHSV(
$r
,
$g
,
$b
);
$l
= (
$max
+
$min
) / 2.0;
$delta
=
$max
-
$min
;
if
(
$delta
< 0.00000000001) {
return
(0, 0,
$l
);
}
else
{
if
(
$l
<= 0.5) {
$s
=
$delta
/ (
$max
+
$min
);
}
else
{
$s
=
$delta
/ (2 -
$max
-
$min
);
}
}
return
(
$h
,
$s
,
$l
);
}
sub
HSLtoRGB {
my
(
$h
,
$s
,
$l
,
$r
,
$g
,
$b
,
$p1
,
$p2
) =
@_
;
if
(
$l
<= 0.5) {
$p2
=
$l
* (1 +
$s
);
}
else
{
$p2
=
$l
+
$s
- (
$l
*
$s
);
}
$p1
= 2 *
$l
-
$p2
;
if
(
$s
< 0.0000000000001) {
$r
=
$g
=
$b
=
$l
;
}
else
{
$r
= RGBquant(
$p1
,
$p2
,
$h
+ 120);
$g
= RGBquant(
$p1
,
$p2
,
$h
);
$b
= RGBquant(
$p1
,
$p2
,
$h
- 120);
}
return
(
$r
,
$g
,
$b
);
}
sub
optInvColor {
my
(
$r
,
$g
,
$b
) =
@_
;
my
$ab
= (0.2 *
$r
) + (0.7 *
$g
) + (0.1 *
$b
);
if
(
$ab
> 0.45) {
return
(0, 0, 0);
}
else
{
return
(1, 1, 1);
}
}
sub
defineColor {
my
(
$name
,
$mx
,
$r
,
$g
,
$b
) =
@_
;
$colors
{
$name
} ||= [
map
{
$_
/
$mx
} (
$r
,
$g
,
$b
) ];
return
$colors
{
$name
};
}
sub
rgbHexValues {
my
$name
=
lc
(
shift
());
my
(
$r
,
$g
,
$b
);
if
(
length
(
$name
) < 5) {
$r
=
hex
(
substr
(
$name
, 1, 1)) / 0xf;
$g
=
hex
(
substr
(
$name
, 2, 1)) / 0xf;
$b
=
hex
(
substr
(
$name
, 3, 1)) / 0xf;
}
elsif
(
length
(
$name
) < 8) {
$r
=
hex
(
substr
(
$name
, 1, 2)) / 0xff;
$g
=
hex
(
substr
(
$name
, 3, 2)) / 0xff;
$b
=
hex
(
substr
(
$name
, 5, 2)) / 0xff;
}
elsif
(
length
(
$name
) < 11) {
$r
=
hex
(
substr
(
$name
, 1, 3)) / 0xfff;
$g
=
hex
(
substr
(
$name
, 4, 3)) / 0xfff;
$b
=
hex
(
substr
(
$name
, 7, 3)) / 0xfff;
}
else
{
$r
=
hex
(
substr
(
$name
, 1, 4)) / 0xffff;
$g
=
hex
(
substr
(
$name
, 5, 4)) / 0xffff;
$b
=
hex
(
substr
(
$name
, 9, 4)) / 0xffff;
}
return
(
$r
,
$g
,
$b
);
}
sub
cmykHexValues {
my
$name
=
lc
(
shift
());
my
(
$c
,
$m
,
$y
,
$k
);
if
(
length
(
$name
) < 6) {
$c
=
hex
(
substr
(
$name
, 1, 1)) / 0xf;
$m
=
hex
(
substr
(
$name
, 2, 1)) / 0xf;
$y
=
hex
(
substr
(
$name
, 3, 1)) / 0xf;
$k
=
hex
(
substr
(
$name
, 4, 1)) / 0xf;
}
elsif
(
length
(
$name
) < 10) {
$c
=
hex
(
substr
(
$name
, 1, 2)) / 0xff;
$m
=
hex
(
substr
(
$name
, 3, 2)) / 0xff;
$y
=
hex
(
substr
(
$name
, 5, 2)) / 0xff;
$k
=
hex
(
substr
(
$name
, 7, 2)) / 0xff;
}
elsif
(
length
(
$name
) < 14) {
$c
=
hex
(
substr
(
$name
, 1, 3)) / 0xfff;
$m
=
hex
(
substr
(
$name
, 4, 3)) / 0xfff;
$y
=
hex
(
substr
(
$name
, 7, 3)) / 0xfff;
$k
=
hex
(
substr
(
$name
, 10, 3)) / 0xfff;
}
else
{
$c
=
hex
(
substr
(
$name
, 1, 4)) / 0xffff;
$m
=
hex
(
substr
(
$name
, 5, 4)) / 0xffff;
$y
=
hex
(
substr
(
$name
, 9, 4)) / 0xffff;
$k
=
hex
(
substr
(
$name
, 13, 4)) / 0xffff;
}
return
(
$c
,
$m
,
$y
,
$k
);
}
sub
hsvHexValues {
my
$name
=
lc
(
shift
());
my
(
$h
,
$s
,
$v
);
if
(
length
(
$name
) < 5) {
$h
= 360 *
hex
(
substr
(
$name
, 1, 1)) / 0x10;
$s
=
hex
(
substr
(
$name
, 2, 1)) / 0xf;
$v
=
hex
(
substr
(
$name
, 3, 1)) / 0xf;
}
elsif
(
length
(
$name
) < 8) {
$h
= 360 *
hex
(
substr
(
$name
, 1, 2)) / 0x100;
$s
=
hex
(
substr
(
$name
, 3, 2)) / 0xff;
$v
=
hex
(
substr
(
$name
, 5, 2)) / 0xff;
}
elsif
(
length
(
$name
) < 11) {
$h
= 360 *
hex
(
substr
(
$name
, 1, 3)) / 0x1000;
$s
=
hex
(
substr
(
$name
, 4, 3)) / 0xfff;
$v
=
hex
(
substr
(
$name
, 7, 3)) / 0xfff;
}
else
{
$h
= 360 *
hex
(
substr
(
$name
, 1, 4)) / 0x10000;
$s
=
hex
(
substr
(
$name
, 5, 4)) / 0xffff;
$v
=
hex
(
substr
(
$name
, 9, 4)) / 0xffff;
}
return
(
$h
,
$s
,
$v
);
}
sub
labHexValues {
my
$name
=
lc
(
shift
());
my
(
$l
,
$a
,
$b
);
if
(
length
(
$name
) < 5) {
$l
= 100 *
hex
(
substr
(
$name
, 1, 1)) / 0xf;
$a
= (200 *
hex
(
substr
(
$name
, 2, 1)) / 0xf) - 100;
$b
= (200 *
hex
(
substr
(
$name
, 3, 1)) / 0xf) - 100;
}
elsif
(
length
(
$name
) < 8) {
$l
= 100 *
hex
(
substr
(
$name
, 1, 2)) / 0xff;
$a
= (200 *
hex
(
substr
(
$name
, 3, 2)) / 0xff) - 100;
$b
= (200 *
hex
(
substr
(
$name
, 5, 2)) / 0xff) - 100;
}
elsif
(
length
(
$name
) < 11) {
$l
= 100 *
hex
(
substr
(
$name
, 1, 3)) / 0xfff;
$a
= (200 *
hex
(
substr
(
$name
, 4, 3)) / 0xfff) - 100;
$b
= (200 *
hex
(
substr
(
$name
, 7, 3)) / 0xfff) - 100;
}
else
{
$l
= 100 *
hex
(
substr
(
$name
, 1, 4)) / 0xffff;
$a
= (200 *
hex
(
substr
(
$name
, 5, 4)) / 0xffff) - 100;
$b
= (200 *
hex
(
substr
(
$name
, 9, 4)) / 0xffff) - 100;
}
return
(
$l
,
$a
,
$b
);
}
sub
namecolor {
my
$name
=
shift
();
unless
(
ref
(
$name
)) {
$name
=
lc
(
$name
);
$name
=~ s/[^\
}
if
(
$name
=~ /^[a-z]/) {
return
namecolor(
$colors
{
$name
});
}
elsif
(
$name
=~ /^
return
floats5(rgbHexValues(
$name
));
}
elsif
(
$name
=~ /^%/) {
return
floats5(cmykHexValues(
$name
));
}
elsif
(
$name
=~ /^!/) {
return
floats5(HSVtoRGB(hsvHexValues(
$name
)));
}
elsif
(
$name
=~ /^&/) {
return
floats5(HSLtoRGB(hsvHexValues(
$name
)));
}
else
{
return
floats5(@{
$name
|| [0.5, 0.5, 0.5]});
}
}
sub
namecolor_cmyk {
my
$name
=
shift
();
unless
(
ref
(
$name
)) {
$name
=
lc
(
$name
);
$name
=~ s/[^\
}
if
(
$name
=~ /^[a-z]/) {
return
namecolor_cmyk(
$colors
{
$name
});
}
elsif
(
$name
=~ /^
return
floats5(RGBasCMYK(rgbHexValues(
$name
)));
}
elsif
(
$name
=~ /^%/) {
return
floats5(cmykHexValues(
$name
));
}
elsif
(
$name
=~ /^!/) {
return
floats5(RGBasCMYK(HSVtoRGB(hsvHexValues(
$name
))));
}
elsif
(
$name
=~ /^&/) {
return
floats5(RGBasCMYK(HSLtoRGB(hsvHexValues(
$name
))));
}
else
{
return
floats5(RGBasCMYK(@{
$name
|| [0.5, 0.5, 0.5]}));
}
}
sub
namecolor_lab {
my
$name
=
shift
();
unless
(
ref
(
$name
)) {
$name
=
lc
(
$name
);
$name
=~ s/[^\
}
if
(
$name
=~ /^[a-z]/) {
return
namecolor_lab(
$colors
{
$name
});
}
elsif
(
$name
=~ /^\$/) {
return
floats5(labHexValues(
$name
));
}
elsif
(
$name
=~ /^
my
(
$h
,
$s
,
$v
) = RGBtoHSV(rgbHexValues(
$name
));
my
$a
=
cos
(deg2rad(
$h
)) *
$s
* 100;
my
$b
=
sin
(deg2rad(
$h
)) *
$s
* 100;
my
$l
= 100 *
$v
;
return
floats5(
$l
,
$a
,
$b
);
}
elsif
(
$name
=~ /^!/) {
my
(
$h
,
$s
,
$v
) = hsvHexValues(
$name
);
my
$a
=
cos
(deg2rad(
$h
)) *
$s
* 100;
my
$b
=
sin
(deg2rad(
$h
)) *
$s
* 100;
my
$l
= 100 *
$v
;
return
floats5(
$l
,
$a
,
$b
);
}
elsif
(
$name
=~ /^&/) {
my
(
$h
,
$s
,
$v
) = hsvHexValues(
$name
);
my
$a
=
cos
(deg2rad(
$h
)) *
$s
* 100;
my
$b
=
sin
(deg2rad(
$h
)) *
$s
* 100;
(
$h
,
$s
,
$v
) = RGBtoHSV(HSLtoRGB(
$h
,
$s
,
$v
));
my
$l
= 100 *
$v
;
return
floats5(
$l
,
$a
,
$b
);
}
else
{
my
(
$h
,
$s
,
$v
) = RGBtoHSV(@{
$name
|| [0.5, 0.5, 0.5]});
my
$a
=
cos
(deg2rad(
$h
)) *
$s
* 100;
my
$b
=
sin
(deg2rad(
$h
)) *
$s
* 100;
my
$l
= 100 *
$v
;
return
floats5(
$l
,
$a
,
$b
);
}
}
sub
unfilter {
my
(
$filter
,
$stream
) =
@_
;
if
(
defined
$filter
) {
if
(
ref
(
$filter
) !~ /Array$/) {
$filter
= PDFArray(
$filter
);
}
my
@filts
;
my
(
$hasflate
) = -1;
my
(
$temp
,
$i
,
$temp1
);
@filts
=
map
{ (
"PDF::API2::Basic::PDF::Filter::"
.
$_
->val())->new() }
$filter
->elements();
foreach
my
$f
(
@filts
) {
$stream
=
$f
->infilt(
$stream
, 1);
}
}
return
$stream
;
}
sub
dofilter {
my
(
$filter
,
$stream
) =
@_
;
if
(
defined
$filter
) {
if
(
ref
(
$filter
) !~ /Array$/) {
$filter
= PDFArray(
$filter
);
}
my
@filts
;
my
$hasflate
= -1;
my
(
$temp
,
$i
,
$temp1
);
@filts
=
map
{ (
"PDF::API2::Basic::PDF::Filter::"
.
$_
->val())->new() }
$filter
->elements();
foreach
my
$f
(
@filts
) {
$stream
=
$f
->outfilt(
$stream
, 1);
}
}
return
$stream
;
}
sub
nameByUni {
my
$e
=
shift
();
return
$u2n
{
$e
} ||
sprintf
(
'uni%04X'
,
$e
);
}
sub
uniByName {
my
$e
=
shift
();
if
(
$e
=~ /^uni([0-9A-F]{4})$/) {
return
hex
($1);
}
return
$n2u
{
$e
} ||
undef
;
}
sub
initNameTable {
%u2n
= %{
$PDF::API2::Resource::Glyphs::u2n
};
%n2u
= %{
$PDF::API2::Resource::Glyphs::n2u
};
$pua
= 0xE000;
return
;
}
sub
defineName {
my
$name
=
shift
();
return
$n2u
{
$name
}
if
defined
$n2u
{
$name
};
$pua
++
while
defined
$u2n
{
$pua
};
$u2n
{
$pua
} =
$name
;
$n2u
{
$name
} =
$pua
;
return
$pua
;
}
sub
page_size {
my
(
$x1
,
$y1
,
$x2
,
$y2
) =
@_
;
if
(
defined
$x2
) {
return
(
$x1
,
$y1
,
$x2
,
$y2
);
}
elsif
(
defined
$y1
) {
return
(0, 0,
$x1
,
$y1
);
}
elsif
(
defined
$PaperSizes
{
lc
$x1
}) {
return
(0, 0, @{
$PaperSizes
{
lc
$x1
}});
}
elsif
(
$x1
=~ /^[\d\.]+$/) {
return
(0, 0,
$x1
,
$x1
);
}
else
{
return
(0, 0, 612, 792);
}
}
sub
getPaperSizes {
my
%sizes
= ();
foreach
my
$type
(
keys
%PaperSizes
) {
$sizes
{
$type
} = [@{
$PaperSizes
{
$type
}}];
}
return
%sizes
;
}
1;