@ISA
=
qw(PDF::API2::Basic::TTF::Table)
;
sub
read
{
my
(
$self
) =
@_
;
my
(
$dat
,
$i
,
$j
,
$k
,
$id
,
@ids
,
$s
);
my
(
$start
,
$end
,
$range
,
$delta
,
$form
,
$len
,
$num
,
$ver
,
$sg
);
my
(
$fh
) =
$self
->{
' INFILE'
};
$self
->SUPER::
read
or
return
$self
;
$fh
->
read
(
$dat
, 4);
$self
->{
'Num'
} =
unpack
(
"x2n"
,
$dat
);
$self
->{
'Tables'
} = [];
for
(
$i
= 0;
$i
<
$self
->{
'Num'
};
$i
++)
{
$s
= {};
$fh
->
read
(
$dat
, 8);
(
$s
->{
'Platform'
},
$s
->{
'Encoding'
},
$s
->{
'LOC'
}) = (
unpack
(
"nnN"
,
$dat
));
$s
->{
'LOC'
} +=
$self
->{
' OFFSET'
};
push
(@{
$self
->{
'Tables'
}},
$s
);
}
for
(
$i
= 0;
$i
<
$self
->{
'Num'
};
$i
++)
{
$s
=
$self
->{
'Tables'
}[
$i
];
$fh
->
seek
(
$s
->{
'LOC'
}, 0);
$fh
->
read
(
$dat
, 2);
$form
=
unpack
(
"n"
,
$dat
);
$s
->{
'Format'
} =
$form
;
if
(
$form
== 0)
{
my
(
$j
) = 0;
$fh
->
read
(
$dat
, 4);
(
$len
,
$s
->{
'Ver'
}) =
unpack
(
'n2'
,
$dat
);
$fh
->
read
(
$dat
, 256);
$s
->{
'val'
} = {
map
{
$j
++; (
$_
? (
$j
- 1,
$_
) : ())}
unpack
(
"C*"
,
$dat
)};
}
elsif
(
$form
== 6)
{
my
(
$start
,
$ecount
);
$fh
->
read
(
$dat
, 8);
(
$len
,
$s
->{
'Ver'
},
$start
,
$ecount
) =
unpack
(
'n4'
,
$dat
);
$fh
->
read
(
$dat
,
$ecount
<< 1);
$s
->{
'val'
} = {
map
{
$start
++; (
$_
? (
$start
- 1,
$_
) : ())}
unpack
(
"n*"
,
$dat
)};
}
elsif
(
$form
== 2)
{
}
elsif
(
$form
== 4)
{
$fh
->
read
(
$dat
, 12);
(
$len
,
$s
->{
'Ver'
},
$num
) =
unpack
(
'n3'
,
$dat
);
$num
>>= 1;
$fh
->
read
(
$dat
,
$len
- 14);
for
(
$j
= 0;
$j
<
$num
;
$j
++)
{
$end
=
unpack
(
"n"
,
substr
(
$dat
,
$j
<< 1, 2));
$start
=
unpack
(
"n"
,
substr
(
$dat
, (
$j
<< 1) + (
$num
<< 1) + 2, 2));
$delta
=
unpack
(
"n"
,
substr
(
$dat
, (
$j
<< 1) + (
$num
<< 2) + 2, 2));
$delta
-= 65536
if
$delta
> 32767;
$range
=
unpack
(
"n"
,
substr
(
$dat
, (
$j
<< 1) +
$num
* 6 + 2, 2));
for
(
$k
=
$start
;
$k
<=
$end
;
$k
++)
{
if
(
$range
== 0 ||
$range
== 65535)
{
$id
=
$k
+
$delta
; }
else
{
$id
=
unpack
(
"n"
,
substr
(
$dat
, (
$j
<< 1) +
$num
* 6 +
2 + (
$k
-
$start
) * 2 +
$range
, 2)) +
$delta
; }
$id
-= 65536
if
$id
>= 65536;
$s
->{
'val'
}{
$k
} =
$id
if
(
$id
);
}
}
}
elsif
(
$form
== 8 ||
$form
== 12)
{
$fh
->
read
(
$dat
, 10);
(
$len
,
$s
->{
'Ver'
}) =
unpack
(
'x2N2'
,
$dat
);
if
(
$form
== 8)
{
$fh
->
read
(
$dat
, 8196);
$num
=
unpack
(
"N"
,
substr
(
$dat
, 8192, 4));
}
else
{
$fh
->
read
(
$dat
, 4);
$num
=
unpack
(
"N"
,
$dat
);
}
$fh
->
read
(
$dat
, 12 *
$num
);
for
(
$j
= 0;
$j
<
$num
;
$j
++)
{
(
$start
,
$end
,
$sg
) =
unpack
(
"N3"
,
substr
(
$dat
,
$j
* 12, 12));
for
(
$k
=
$start
;
$k
<=
$end
;
$k
++)
{
$s
->{
'val'
}{
$k
} =
$sg
++; }
}
}
elsif
(
$form
== 10)
{
$fh
->
read
(
$dat
, 18);
(
$len
,
$s
->{
'Ver'
},
$start
,
$num
) =
unpack
(
'x2N4'
,
$dat
);
$fh
->
read
(
$dat
,
$num
<< 1);
for
(
$j
= 0;
$j
<
$num
;
$j
++)
{
$s
->{
'val'
}{
$start
+
$j
} =
unpack
(
"n"
,
substr
(
$dat
,
$j
<< 1, 2)); }
}
}
$self
;
}
sub
ms_lookup
{
my
(
$self
,
$uni
) =
@_
;
$self
->find_ms ||
return
undef
unless
(
defined
$self
->{
' mstable'
});
return
$self
->{
' mstable'
}{
'val'
}{
$uni
};
}
sub
find_ms
{
my
(
$self
) =
@_
;
my
(
$i
,
$s
,
$alt
,
$found
);
return
(
$self
->{
' mstable'
})
if
(
defined
$self
->{
' mstable'
});
$self
->
read
unless
(
$self
->{
' read'
});
foreach
$i
(0..(
$self
->{Num}-1))
{
$s
=
$self
->{Tables}[
$i
];
if
(
$s
->{
'Platform'
} == 3)
{
$self
->{
' mstable'
} =
$s
;
$found
= 1
if
((
$s
->{
'Encoding'
} == 1) || (
$s
->{
'Encoding'
} == 0));
last
if
(
$found
);
}
elsif
(
$s
->{
'Platform'
} == 0 || (
$s
->{
'Platform'
} == 2 &&
$s
->{
'Encoding'
} == 1))
{
$alt
=
$s
; }
}
$self
->{
' mstable'
} =
$alt
unless
$found
;
$self
->{
' mstable'
};
}
sub
ms_enc
{
my
(
$self
) =
@_
;
my
(
$s
);
return
$self
->{
' mstable'
}{
'Encoding'
}
if
(
defined
$self
->{
' mstable'
} &&
$self
->{
' mstable'
}{
'Platform'
} == 3);
foreach
$s
(@{
$self
->{
'Tables'
}})
{
return
$s
->{
'Encoding'
}
if
(
$s
->{
'Platform'
} == 3);
}
return
undef
;
}
sub
out
{
my
(
$self
,
$fh
) =
@_
;
my
(
$loc
,
$s
,
$i
,
$base_loc
,
$j
,
@keys
);
return
$self
->SUPER::out(
$fh
)
unless
$self
->{
' read'
};
$base_loc
=
$fh
->
tell
();
$fh
->
print
(
pack
(
"n2"
, 0,
$self
->{
'Num'
}));
for
(
$i
= 0;
$i
<
$self
->{
'Num'
};
$i
++)
{
$fh
->
print
(
pack
(
"nnN"
,
$self
->{
'Tables'
}[
$i
]{
'Platform'
},
$self
->{
'Tables'
}[
$i
]{
'Encoding'
}, 0)); }
for
(
$i
= 0;
$i
<
$self
->{
'Num'
};
$i
++)
{
$s
=
$self
->{
'Tables'
}[
$i
];
@keys
=
sort
{
$a
<=>
$b
}
keys
%{
$s
->{
'val'
}};
$s
->{
' outloc'
} =
$fh
->
tell
();
if
(
$s
->{
'Format'
} < 8)
{
$fh
->
print
(
pack
(
"n3"
,
$s
->{
'Format'
}, 0,
$s
->{
'Ver'
})); }
else
{
$fh
->
print
(
pack
(
"n2N2"
,
$s
->{
'Format'
}, 0, 0,
$s
->{
'Ver'
})); }
if
(
$s
->{
'Format'
} == 0)
{
$fh
->
print
(
pack
(
"C256"
, @{
$s
->{
'val'
}}{0 .. 255}));
}
elsif
(
$s
->{
'Format'
} == 6)
{
$fh
->
print
(
pack
(
"n2"
,
$keys
[0],
$keys
[-1] -
$keys
[0] + 1));
$fh
->
print
(
pack
(
"n*"
, @{
$s
->{
'val'
}}{
$keys
[0] ..
$keys
[-1]}));
}
elsif
(
$s
->{
'Format'
} == 2)
{
}
elsif
(
$s
->{
'Format'
} == 4)
{
my
(
$num
,
$sRange
,
$eSel
,
$eShift
,
@starts
,
@ends
,
$doff
);
my
(
@deltas
,
$delta
,
@range
,
$flat
,
$k
,
$segs
,
$count
,
$newseg
,
$v
);
push
(
@keys
, 0xFFFF)
unless
(
$keys
[-1] == 0xFFFF);
$newseg
= 1;
$num
= 0;
for
(
$j
= 0;
$j
<=
$#keys
&&
$keys
[
$j
] <= 0xFFFF;
$j
++)
{
$v
=
$s
->{
'val'
}{
$keys
[
$j
]};
if
(
$newseg
)
{
$delta
=
$v
;
$doff
=
$j
;
$flat
= 1;
push
(
@starts
,
$keys
[
$j
]);
$newseg
= 0;
}
$delta
= 0
if
(
$delta
+
$j
-
$doff
!=
$v
);
$flat
= 0
if
(
$v
== 0);
if
(
$j
==
$#keys
||
$keys
[
$j
] + 1 !=
$keys
[
$j
+1])
{
push
(
@ends
,
$keys
[
$j
]);
push
(
@deltas
,
$delta
?
$delta
-
$keys
[
$doff
] : 0);
push
(
@range
,
$flat
);
$num
++;
$newseg
= 1;
}
}
(
$num
,
$sRange
,
$eSel
,
$eShift
) = PDF::API2::Basic::TTF::Utils::TTF_bininfo(
$num
, 2);
$fh
->
print
(
pack
(
"n4"
,
$num
* 2,
$sRange
,
$eSel
,
$eShift
));
$fh
->
print
(
pack
(
"n*"
,
@ends
));
$fh
->
print
(
pack
(
"n"
, 0));
$fh
->
print
(
pack
(
"n*"
,
@starts
));
$fh
->
print
(
pack
(
"n*"
,
@deltas
));
$count
= 0;
for
(
$j
= 0;
$j
<
$num
;
$j
++)
{
$delta
=
$deltas
[
$j
];
if
(
$delta
!= 0 &&
$range
[
$j
] == 1)
{
$range
[
$j
] = 0; }
else
{
$range
[
$j
] = (
$count
+
$num
-
$j
) << 1;
$count
+=
$ends
[
$j
] -
$starts
[
$j
] + 1;
}
}
$fh
->
print
(
pack
(
"n*"
,
@range
));
for
(
$j
= 0;
$j
<
$num
;
$j
++)
{
next
if
(
$range
[
$j
] == 0);
$fh
->
print
(
pack
(
"n*"
, @{
$s
->{
'val'
}}{
$starts
[
$j
] ..
$ends
[
$j
]}));
}
}
elsif
(
$s
->{
'Format'
} == 8 ||
$s
->{
'Format'
} == 12)
{
my
(
@jobs
,
$start
,
$current
,
$curr_glyf
,
$map
);
$map
=
"\000"
x 8192;
foreach
$j
(
@keys
)
{
if
(
$j
> 0xFFFF)
{
if
(
defined
$s
->{
'val'
}{
$j
>> 16})
{
$s
->{
'Format'
} = 12; }
vec
(
$map
,
$j
>> 16, 1) = 1;
}
if
(
$j
!=
$current
+ 1 ||
$s
->{
'val'
}{
$j
} !=
$curr_glyf
+ 1)
{
push
(
@jobs
, [
$start
,
$current
,
$curr_glyf
])
if
(
defined
$start
);
$start
=
$j
;
$current
=
$j
;
$curr_glyf
=
$s
->{
'val'
}{
$j
};
}
}
$fh
->
print
(
$map
)
if
(
$s
->{
'Format'
} == 8);
$fh
->
print
(
pack
(
'N'
,
$#jobs
+ 1));
foreach
$j
(
@jobs
)
{
$fh
->
print
(
pack
(
'N3'
, @{
$j
})); }
}
elsif
(
$s
->{
'Format'
} == 10)
{
$fh
->
print
(
pack
(
'N2'
,
$keys
[0],
$keys
[-1] -
$keys
[0] + 1));
$fh
->
print
(
pack
(
'n*'
,
$s
->{
'val'
}{
$keys
[0] ..
$keys
[-1]}));
}
$loc
=
$fh
->
tell
();
if
(
$s
->{
'Format'
} < 8)
{
$fh
->
seek
(
$s
->{
' outloc'
} + 2, 0);
$fh
->
print
(
pack
(
"n"
,
$loc
-
$s
->{
' outloc'
}));
}
else
{
$fh
->
seek
(
$s
->{
' outloc'
} + 4, 0);
$fh
->
print
(
pack
(
"N"
,
$loc
-
$s
->{
' outloc'
}));
}
$fh
->
seek
(
$base_loc
+ 8 + (
$i
<< 3), 0);
$fh
->
print
(
pack
(
"N"
,
$s
->{
' outloc'
} -
$base_loc
));
$fh
->
seek
(
$loc
, 0);
}
$self
;
}
sub
XML_element
{
my
(
$self
,
$context
,
$depth
,
$k
,
$val
) =
@_
;
my
(
$fh
) =
$context
->{
'fh'
};
my
(
$i
);
return
$self
if
(
$k
eq
'LOC'
);
return
$self
->SUPER::XML_element(
$context
,
$depth
,
$k
,
$val
)
unless
(
$k
eq
'val'
);
$fh
->
print
(
"$depth<mappings>\n"
);
foreach
$i
(
sort
{
$a
<=>
$b
}
keys
%{
$val
})
{
$fh
->
printf
(
"%s<map code='%04X' glyph='%s'/>\n"
,
$depth
.
$context
->{
'indent'
},
$i
,
$val
->{
$i
}); }
$fh
->
print
(
"$depth</mappings>\n"
);
$self
;
}
sub
reverse
{
my
(
$self
,
$tnum
) =
@_
;
my
(
$table
) =
defined
$tnum
?
$self
->{
'Tables'
}[
$tnum
] :
$self
->find_ms;
my
(
@res
,
$code
,
$gid
);
while
((
$code
,
$gid
) =
each
(%{
$table
->{
'val'
}}))
{
$res
[
$gid
] =
$code
unless
(
defined
$res
[
$gid
] &&
$res
[
$gid
] > 0 &&
$res
[
$gid
] <
$code
); }
@res
;
}
sub
is_unicode
{
my
(
$self
,
$index
) =
@_
;
my
(
$pid
,
$eid
) = (
$self
->{
'Tables'
}[
$index
]{
'Platform'
},
$self
->{
'Tables'
}[
$index
]{
'Encoding'
});
return
(
$pid
== 3 ||
$pid
== 0 || (
$pid
== 2 &&
$eid
== 1));
}
1;