BEGIN {
use
vars
qw(@ISA $VERSION)
;
@ISA
=
qw( PDF::API2::Resource::Font )
;
(
$VERSION
) =
'$Revision: 1.5 $'
=~ /Revision: (\S+)\s/;
}
sub
new {
my
(
$class
,
$pdf
,
$psfile
,
%opts
) =
@_
;
my
(
$self
,
$encoding
);
my
(
@w
,
$data
);
if
(
defined
$opts
{-afmfile}) {
$data
=
$class
->readAFM(
$opts
{-afmfile});
}
elsif
(
defined
$opts
{-pfmfile}) {
$data
=
$class
->readPFM(
$opts
{-pfmfile});
}
elsif
(
defined
$opts
{-xfmfile}) {
$data
=
$class
->readXFM(
$opts
{-xfmfile});
}
else
{
die
"no proper font-metrics file specified for '$psfile'."
;
}
$class
=
ref
$class
if
ref
$class
;
$self
=
$class
->SUPER::new(
$pdf
,
$data
->{apiname}.pdfkey());
$pdf
->new_obj(
$self
)
unless
(
$self
->is_obj(
$pdf
));
$self
->{
' data'
}=
$data
;
$self
->{
'Subtype'
} = PDFName(
"Type1"
);
$self
->{
'BaseFont'
} = PDFName(
$self
->fontname);
if
(
$opts
{-pdfname}) {
$self
->name(
$opts
{-pdfname});
}
$self
->{
'FontDescriptor'
}=
$self
->descrByData();
my
(
$l1
,
$l2
,
$l3
,
$stream
)=
$self
->readPFAPFB(
$psfile
);
my
$s
= PDFDict();
$self
->{
'FontDescriptor'
}->{
'FontFile'
} =
$s
;
$s
->{
'Length1'
} = PDFNum(
$l1
);
$s
->{
'Length2'
} = PDFNum(
$l2
);
$s
->{
'Length3'
} = PDFNum(
$l3
);
$s
->{
'Filter'
} = PDFArray(PDFName(
"FlateDecode"
));
$s
->{
' stream'
} =
$stream
;
if
(
defined
$pdf
) {
$pdf
->new_obj(
$s
);
}
$self
->encodeByData(
$opts
{-encode});
return
(
$self
);
}
sub
new_api {
my
(
$class
,
$api
,
@para
) =
@_
;
$class
=
ref
$class
if
ref
$class
;
my
$self
=
$class
->new(
$api
->{pdf},
@para
);
$self
->{
' apipdf'
}=
$api
->{pdf};
$self
->{
' api'
}=
$api
;
return
(
$self
);
}
sub
readPFAPFB {
my
(
$self
,
$file
) =
@_
;
my
(
$l1
,
$l2
,
$l3
,
$stream
,
$t1stream
,
@lines
,
$line
,
$head
,
$body
,
$tail
);
die
"cannot find font '$file' ..."
unless
(-f
$file
);
$l
=-s
$file
;
open
(INF,
$file
);
binmode
(INF,
':raw'
);
read
(INF,
$line
,2);
@lines
=
unpack
(
'C*'
,
$line
);
if
((
$lines
[0]==0x80) && (
$lines
[1]==1)) {
read
(INF,
$line
,4);
$l1
=
unpack
(
'V'
,
$line
);
seek
(INF,
$l1
,1);
read
(INF,
$line
,2);
@lines
=
unpack
(
'C*'
,
$line
);
if
((
$lines
[0]==0x80) && (
$lines
[1]==2)) {
read
(INF,
$line
,4);
$l2
=
unpack
(
'V'
,
$line
);
}
else
{
die
"corrupt pfb in file '$file' at marker='2'."
;
}
seek
(INF,
$l2
,1);
read
(INF,
$line
,2);
@lines
=
unpack
(
'C*'
,
$line
);
if
((
$lines
[0]==0x80) && (
$lines
[1]==1)) {
read
(INF,
$line
,4);
$l3
=
unpack
(
'V'
,
$line
);
}
else
{
die
"corrupt pfb in file '$file' at marker='3'."
;
}
seek
(INF,0,0);
@lines
=<INF>;
close
(INF);
$stream
=
join
(
''
,
@lines
);
$t1stream
=
substr
(
$stream
,6,
$l1
);
$t1stream
.=
substr
(
$stream
,12+
$l1
,
$l2
);
$t1stream
.=
substr
(
$stream
,18+
$l1
+
$l2
,
$l3
);
}
elsif
(
$line
eq
'%!'
) {
seek
(INF,0,0);
while
(
$line
=<INF>) {
if
(!
$l1
) {
$head
.=
$line
;
if
(
$line
=~/eexec$/){
chomp
(
$head
);
$head
.=
"\x0d"
;
$l1
=
length
(
$head
);
}
}
elsif
(!
$l2
) {
if
(
$line
=~/^0+$/) {
$l2
=
length
(
$body
);
$tail
=
$line
;
}
else
{
chomp
(
$line
);
$body
.=
pack
(
'H*'
,
$line
);
}
}
else
{
$tail
.=
$line
;
}
}
$l3
=
length
(
$tail
);
$t1stream
=
"$head$body$tail"
;
}
else
{
die
"unsupported font-format in file '$file' at marker='1'."
;
}
return
(
$l1
,
$l2
,
$l3
,
$t1stream
);
}
sub
readAFM {
my
(
$self
,
$file
)=
@_
;
my
$data
={};
$data
->{wx}={};
$data
->{bbox}={};
$data
->{char}=[];
$data
->{firstchar}=255;
$data
->{lastchar}=0;
if
(! -e
$file
) {
die
"file='$file' not existant."
;}
open
(AFMF,
$file
) or
die
"Can't find the AFM file for $file"
;
local
($/,
$_
) = (
"\n"
,
undef
);
while
(
$_
=<AFMF>) {
next
if
/^StartKernData/ .. /^EndKernData/;
next
if
/^StartComposites/ .. /^EndComposites/;
if
(/^StartCharMetrics/ .. /^EndCharMetrics/) {
next
unless
$_
=~/^CH?\s/;
my
(
$ch
) =
$_
=~/^CH?\s+(\d+)\s*;/;
$ch
=
$ch
||0;
my
(
$name
) =
$_
=~/\bN\s+(\.?\w+)\s*;/;
my
(
$wx
) =
$_
=~/\bWX\s+(\d+)\s*;/;
my
(
$bbox
) =
$_
=~/\bB\s+([^;]+);/;
$bbox
=~ s/\s+$//;
$data
->{avgwidth2} +=
$wx
;
$data
->{maxwidth} =
$data
->{maxwidth}<
$wx
?
$wx
:
$data
->{maxwidth};
$data
->{wx}->{
$name
} =
$wx
;
$data
->{bbox}->{
$name
} = [
split
(/\s+/,
$bbox
)];
if
(
$ch
>0) {
$data
->{
'char'
}->[
$ch
]=
$name
;
}
$data
->{lastchar} =
$data
->{lastchar}<
$ch
?
$ch
:
$data
->{lastchar};
$data
->{firstchar} =
$data
->{firstchar}>
$ch
?
$ch
:
$data
->{firstchar};
next
;
}
last
if
$_
=~/^EndFontMetrics/;
if
(/(^\w+)\s+(.*)/) {
my
(
$key
,
$val
) = ($1, $2);
$key
=
lc
$key
;
if
(
defined
$data
->{
$key
}) {
}
else
{
$val
=~s/[\x00\x1f]+//g;
$data
->{
$key
} =
$val
;
}
}
else
{
print
STDERR
"Can't parse: $_"
;
}
}
close
(AFMF);
unless
(
exists
$data
->{wx}->{
'.notdef'
}) {
$data
->{wx}->{
'.notdef'
} = 0;
$data
->{bbox}{
'.notdef'
} = [0, 0, 0, 0];
}
$data
->{avgwidth2} /=
scalar
keys
%{
$data
->{bbox}} ;
$data
->{avgwidth2} =
int
(
$data
->{avgwidth2});
$data
->{fontname}=~s/[^A-Za-z0-9]+//og;
if
(
defined
$data
->{fullname}) {
$data
->{altname}=
$data
->{fullname};
}
else
{
$data
->{altname}=
$data
->{familyname};
$data
->{altname}.=
' Italic'
if
(
$data
->{italicangle}<0);
$data
->{altname}.=
' Oblique'
if
(
$data
->{italicangle}>0);
$data
->{altname}.=
' '
.
$data
->{weight};
}
$data
->{apiname}=
$data
->{altname};
$data
->{altname}=~s/[^A-Za-z0-9]+//og;
$data
->{subname}=
$data
->{weight};
$data
->{subname}.=
' Italic'
if
(
$data
->{italicangle}<0);
$data
->{subname}.=
' Oblique'
if
(
$data
->{italicangle}>0);
$data
->{subname}=~s/[^A-Za-z0-9]+//og;
$data
->{missingwidth}||=
$data
->{avgwidth2};
$data
->{issymbol} = 0;
$data
->{fontbbox} = [
split
(/\s+/,
$data
->{fontbbox}) ];
$data
->{apiname}=
join
(
''
,
map
{
$_
=~s/[^A-Za-z0-9]+//og;
$_
=
ucfirst
(
lc
(
substr
(
$_
,0,2)));
$_
; }
split
(/\s+/,
$data
->{apiname}));
$data
->{flags} = 34;
$data
->{uni}||=[];
foreach
my
$n
(0..255) {
$data
->{uni}->[
$n
]=uniByName(
$data
->{char}->[
$n
] ||
'.notdef'
) || 0;
}
return
(
$data
);
}
sub
readPFM {
my
(
$self
,
$file
)=
@_
;
if
(! -e
$file
) {
die
"pfmfile='$file' not existant."
;}
my
$fh
=IO::File->new();
my
$data
={};
$data
->{issymbol} = 0;
$data
->{wx}={};
$data
->{bbox}={};
$data
->{kern}={};
$data
->{char}=[];
my
$buf
;
open
(
$fh
,
$file
) ||
return
undef
;
binmode
(
$fh
,
':raw'
);
read
(
$fh
,
$buf
,117 + 30);
my
%df
;
(
$df
{Version},
$df
{Size},
$df
{Copyright},
$df
{Type},
$df
{Point},
$df
{VertRes},
$df
{HorizRes},
$df
{Ascent},
$df
{InternalLeading},
$df
{ExternalLeading},
$df
{Italic},
$df
{Underline},
$df
{StrikeOut},
$df
{Weight},
$df
{CharSet},
$df
{PixWidth},
$df
{PixHeight},
$df
{PitchAndFamily},
$df
{AvgWidth},
$df
{MaxWidth},
$df
{FirstChar},
$df
{LastChar},
$df
{DefaultChar},
$df
{BreakChar},
$df
{WidthBytes},
$df
{Device},
$df
{Face},
$df
{BitsPointer},
$df
{BitsOffset},
$df
{SizeFields},
$df
{ExtMetricsOffset},
$df
{ExtentTable},
$df
{OriginTable},
$df
{PairKernTable},
$df
{TrackKernTable},
$df
{DriverInfo},
$df
{Reserved},
) =
unpack
(
"vVa60vvvvvvvCCCvCvvCvvCCCCvVVVV vVVVVVVV"
,
$buf
);
seek
(
$fh
,
$df
{Device},0);
read
(
$fh
,
$buf
,250);
(
$df
{postScript}) =
unpack
(
"Z*"
,
$buf
);
$buf
=
substr
(
$buf
,
length
(
$df
{postScript})+1,250);
(
$df
{windowsName}) =
unpack
(
"Z*"
,
$buf
);
$buf
=
substr
(
$buf
,
length
(
$df
{windowsName})+1,250);
(
$df
{psName}) =
unpack
(
"Z*"
,
$buf
);
seek
(
$fh
,
$df
{ExtMetricsOffset},0);
read
(
$fh
,
$buf
,52);
(
$df
{etmSize},
$df
{PointSize},
$df
{Orientation},
$df
{MasterHeight},
$df
{MinScale},
$df
{MaxScale},
$df
{MasterUnits},
$df
{CapHeight},
$df
{xHeight},
$df
{LowerCaseAscent},
$df
{LowerCaseDescent},
$df
{Slant},
$df
{SuperScript},
$df
{SubScript},
$df
{SuperScriptSize},
$df
{SubScriptSize},
$df
{UnderlineOffset},
$df
{UnderlineWidth},
$df
{DoubleUpperUnderlineOffset},
$df
{DoubleLowerUnderlineOffset},
$df
{DoubleUpperUnderlineWidth},
$df
{DoubleLowerUnderlineWidth},
$df
{StrikeOutOffset},
$df
{StrikeOutWidth},
$df
{KernPairs},
$df
{KernTracks} ) =
unpack
(
'v*'
,
$buf
);
$data
->{fontname}=
$df
{psName};
$data
->{fontname}=~s/[^A-Za-z0-9]+//og;
$data
->{apiname}=
$df
{windowsName};
$data
->{apiname}=
join
(
''
,
map
{
$_
=~s/[^A-Za-z0-9]+//og;
$_
=
ucfirst
(
lc
(
substr
(
$_
,0,2)));
$_
; }
split
(/\s+/,
$data
->{apiname}));
$data
->{upem}=1000;
$data
->{fontbbox}=[-100,-100,
$df
{MaxWidth},
$df
{Ascent}];
$data
->{stemv}=0;
$data
->{stemh}=0;
$data
->{lastchar}=
$df
{LastChar};
$data
->{firstchar}=
$df
{FirstChar};
$data
->{missingwidth}=
$df
{AvgWidth};
$data
->{maxwidth}=
$df
{MaxWidth};
$data
->{ascender}=
$df
{Ascent};
$data
->{descender}=-
$df
{LowerCaseDescent};
$data
->{flags} = 0;
$data
->{flags} |= 1
if
(((
$df
{PitchAndFamily} & 1) || (
$df
{PitchAndFamily} & 8)) && !(
$df
{PitchAndFamily} & 2));
$data
->{flags} |= 2
if
((
$df
{PitchAndFamily} & 16) && !(
$df
{PitchAndFamily} & 32));
$data
->{flags} |= 4
if
(
$df
{PitchAndFamily} & 80);
$data
->{flags} |= 8
if
(
$df
{PitchAndFamily} & 64);
$data
->{flags} |= 32
unless
(
$df
{PitchAndFamily} & 80);
$data
->{flags} |= 64
if
(
$df
{Italic});
$data
->{capheight}=
$df
{CapHeight};
$data
->{xheight}=
$df
{xHeight};
$data
->{uni}=[
unpack
(
'U*'
,decode(
'cp1252'
,
pack
(
'C*'
,(0..255)))) ];
$data
->{char}=[
map
{ nameByUni(
$_
) ||
'.notdef'
} @{
$data
->{uni}} ];
$data
->{italicangle}=-12
*$df
{Italic};
$data
->{isfixedpitch}=((
$df
{PitchAndFamily} & 8) || (
$df
{PitchAndFamily} & 1));
$data
->{underlineposition}=-
$df
{UnderlineOffset};
$data
->{underlinethickness}=
$df
{UnderlineWidth};
seek
(
$fh
,
$df
{ExtentTable},0);
foreach
my
$k
(
$df
{FirstChar} ..
$df
{LastChar}) {
read
(
$fh
,
$buf
,2);
my
(
$wx
)=
unpack
(
'v'
,
$buf
);
$data
->{wx}->{
$data
->{char}->[
$k
]}=
$wx
;
}
$data
->{pfm}=\
%df
;
close
(
$fh
);
return
(
$data
);
}
sub
readXFM {
my
(
$class
,
$xfmfile
) =
@_
;
die
"cannot find font '$xfmfile' ..."
unless
(-f
$xfmfile
);
my
$data
={};
return
(
$data
);
}
1;