use
vars
qw(@ISA %fields)
;
@ISA
=
qw(Font::TTF::Table)
;
sub
read
{
my
(
$self
) =
@_
;
my
(
$dat
,
$fh
,
$numDescs
,
$tag
,
$descs
);
$self
->SUPER::
read
or
return
$self
;
$fh
=
$self
->{
' INFILE'
};
$fh
->
read
(
$dat
, 4);
$self
->{
'version'
} = TTF_Unpack(
"f"
,
$dat
);
$fh
->
read
(
$dat
, 4);
foreach
(1 ..
unpack
(
"N"
,
$dat
)) {
$fh
->
read
(
$tag
, 4);
$fh
->
read
(
$dat
, 4);
$descs
->{
$tag
} = (
$tag
eq
'nalf'
) ?
unpack
(
"N"
,
$dat
) : TTF_Unpack(
"f"
,
$dat
);
}
$self
->{
'descriptors'
} =
$descs
;
$self
;
}
sub
out
{
my
(
$self
,
$fh
) =
@_
;
my
(
$descs
);
return
$self
->SUPER::out(
$fh
)
unless
$self
->{
' read'
};
$fh
->
print
(TTF_Pack(
"f"
,
$self
->{
'version'
}));
$descs
=
$self
->{
'descriptors'
} or {};
$fh
->
print
(
pack
(
"N"
,
scalar
keys
%$descs
));
foreach
(
sort
keys
%$descs
) {
$fh
->
print
(
$_
);
$fh
->
print
((
$_
eq
'nalf'
) ?
pack
(
"N"
,
$descs
->{
$_
}) : TTF_Pack(
"f"
,
$descs
->{
$_
}));
}
$self
;
}
sub
print
{
my
(
$self
,
$fh
) =
@_
;
my
(
$descs
,
$k
);
$self
->
read
;
$fh
=
'STDOUT'
unless
defined
$fh
;
$descs
=
$self
->{
'descriptors'
};
foreach
$k
(
sort
keys
%$descs
) {
if
(
$k
eq
'nalf'
) {
$fh
->
printf
(
"Descriptor '%s' = %d\n"
,
$k
,
$descs
->{
$k
});
}
else
{
$fh
->
printf
(
"Descriptor '%s' = %f\n"
,
$k
,
$descs
->{
$k
});
}
}
$self
;
}
1;