@ISA
=
qw(PDF::API2::Basic::TTF::Table)
;
sub
read
{
my
(
$self
) =
@_
;
my
(
$featureCount
,
$features
);
$self
->SUPER::read_dat or
return
$self
;
(
$self
->{
'version'
},
$featureCount
) = TTF_Unpack(
"fS"
,
$self
->{
' dat'
});
$features
= [];
foreach
(1 ..
$featureCount
) {
my
(
$feature
,
$nSettings
,
$settingTable
,
$featureFlags
,
$nameIndex
)
= TTF_Unpack(
"SSLSS"
,
substr
(
$self
->{
' dat'
},
$_
* 12, 12));
push
@$features
,
{
'feature'
=>
$feature
,
'name'
=>
$nameIndex
,
'exclusive'
=> ((
$featureFlags
& 0x8000) != 0),
'settings'
=> { TTF_Unpack(
"S*"
,
substr
(
$self
->{
' dat'
},
$settingTable
,
$nSettings
* 4)) }
};
}
$self
->{
'features'
} =
$features
;
delete
$self
->{
' dat'
};
$self
;
}
sub
out
{
my
(
$self
,
$fh
) =
@_
;
my
(
$features
,
$numFeatures
,
$settings
,
$featuresData
,
$settingsData
);
return
$self
->SUPER::out(
$fh
)
unless
$self
->{
' read'
};
$features
=
$self
->{
'features'
};
$numFeatures
=
@$features
;
foreach
(
@$features
) {
$settings
=
$_
->{
'settings'
};
$featuresData
.= TTF_Pack(
"SSLSS"
,
$_
->{
'feature'
},
scalar
keys
%$settings
,
12 + 12 *
$numFeatures
+
length
$settingsData
,
(
$_
->{
'exclusive'
} ? 0x8000 : 0x0000),
$_
->{
'name'
});
foreach
(
sort
{
$a
<=>
$b
}
keys
%$settings
) {
$settingsData
.= TTF_Pack(
"SS"
,
$_
,
$settings
->{
$_
});
}
}
$fh
->
print
(TTF_Pack(
"fSSL"
,
$self
->{
'version'
},
$numFeatures
, 0, 0));
$fh
->
print
(
$featuresData
);
$fh
->
print
(
$settingsData
);
$self
;
}
sub
print
{
my
(
$self
,
$fh
) =
@_
;
my
(
$names
,
$features
,
$settings
);
$self
->
read
;
$names
=
$self
->{
' PARENT'
}->{
'name'
};
$names
->
read
;
$fh
=
'STDOUT'
unless
defined
$fh
;
$features
=
$self
->{
'features'
};
foreach
(
@$features
) {
$fh
->
printf
(
"Feature %d, %s, name %d # '%s'\n"
,
$_
->{
'feature'
},
(
$_
->{
'exclusive'
} ?
"exclusive"
:
"additive"
),
$_
->{
'name'
},
$names
->{
'strings'
}[
$_
->{
'name'
}][1][0]{0});
$settings
=
$_
->{
'settings'
};
foreach
(
sort
{
$a
<=>
$b
}
keys
%$settings
) {
$fh
->
printf
(
"\tSetting %d, name %d # '%s'\n"
,
$_
,
$settings
->{
$_
},
$names
->{
'strings'
}[
$settings
->{
$_
}][1][0]{0});
}
}
$self
;
}
sub
settingName
{
my
(
$self
,
$feature
,
$setting
) =
@_
;
$self
->
read
;
my
$names
=
$self
->{
' PARENT'
}->{
'name'
};
$names
->
read
;
my
$features
=
$self
->{
'features'
};
my
(
$featureEntry
) =
grep
{
$_
->{
'feature'
} ==
$feature
}
@$features
;
my
$featureName
=
$names
->{
'strings'
}[
$featureEntry
->{
'name'
}][1][0]{0};
my
$settingName
=
$featureEntry
->{
'exclusive'
}
?
$names
->{
'strings'
}[
$featureEntry
->{
'settings'
}->{
$setting
}][1][0]{0}
:
$names
->{
'strings'
}[
$featureEntry
->{
'settings'
}->{
$setting
& ~1}][1][0]{0}
. ((
$setting
& 1) == 0 ?
" On"
:
" Off"
);
(
$featureName
,
$settingName
);
}
1;