165 lines
2.8 KiB
Perl
165 lines
2.8 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Copyright (c) 1998-2000
|
|
# Sergey A. Babkin. All rights reserved.
|
|
#
|
|
# See the full text of the license in the COPYRIGHT file.
|
|
#
|
|
# Sergey A. Babkin (sab123@hotmail.com, babkin@users.sourceforge.net)
|
|
#
|
|
|
|
#
|
|
# Script to transcode the Type1 disassembled font to other encoding
|
|
#
|
|
|
|
# calculation of UniqueID from old UID and encoding name
|
|
# we don't have unsigned integer arithmetic in Perl
|
|
# so we try to do at least something
|
|
sub newuid
|
|
{
|
|
use integer;
|
|
my ($u,$enc)=@_;
|
|
my $i, $uid;
|
|
|
|
$uid=substr($u, -6, 6);
|
|
$u=substr($u, 0, 4);
|
|
|
|
$uid+=0;
|
|
for $i (split(//,$enc)) {
|
|
$uid*=37;
|
|
$uid+=ord($i);
|
|
$uid+=($uid>>16) & 0xff;
|
|
$uid&=0xffffff;
|
|
}
|
|
|
|
($uid % 1000000) + 4000000;
|
|
#$u . substr(sprintf("%d",$uid), 0, 5);
|
|
}
|
|
|
|
if($#ARGV != 1) {
|
|
printf(STDERR "Use: trans src-table dst-table <src-font >dst-font\n");
|
|
exit 1;
|
|
}
|
|
|
|
# tables are formatted in two columns, one row per character
|
|
# name decimal-code
|
|
|
|
# Read the destination table
|
|
|
|
open(FILE,"<".$ARGV[1])
|
|
or die "Unable to read $ARGV[2]\n";
|
|
while(<FILE>) {
|
|
@sl=split(/\s+/);
|
|
$dst{$sl[0]}=$sl[1];
|
|
}
|
|
close(FILE);
|
|
|
|
#read the source table and build the translation table
|
|
|
|
open(FILE,"<".$ARGV[0])
|
|
or die "Unable to read $ARGV[0]\n";
|
|
while(<FILE>) {
|
|
@sl=split(/\s+/);
|
|
$trans{$sl[1]}=$dst{$sl[0]};
|
|
}
|
|
close(FILE);
|
|
|
|
# name of the encoding, for UniqueID
|
|
$encname=$ARGV[1];
|
|
$encname =~ s|^.*\/||g;
|
|
$encname =~ s|\..*$||g;
|
|
|
|
# now read the font file, skip everything upto the encoding table
|
|
# we suppose that the file was autogenerated by ttf2pt1 with my patches
|
|
|
|
while(<STDIN>) {
|
|
if( /^\/FontName\s+(\S+)/) {
|
|
$fontname=$1;
|
|
}
|
|
if( /^\/UniqueID\s+(\S+)/) {
|
|
use integer;
|
|
my $uid=$1;
|
|
$_=sprintf("/UniqueID %u def\n", &newuid($uid, $encname));
|
|
}
|
|
print $_;
|
|
if(/^\/Encoding/) {
|
|
$fontfile=1;
|
|
last;
|
|
}
|
|
if(/^StartCharMetrics/) {
|
|
$fontfile=0;
|
|
last;
|
|
}
|
|
}
|
|
|
|
# read the old encoding table and build the new encoding table
|
|
|
|
if($fontfile) { # .t1a
|
|
while($row=<STDIN>) {
|
|
if( $row !~ /^dup/) {
|
|
last;
|
|
}
|
|
|
|
@sl=split(/\s+/,$row);
|
|
|
|
$new=$trans{$sl[1]};
|
|
if($new eq "") {
|
|
$new=$sl[1];
|
|
if($enc{$new} eq "") {
|
|
$enc{$new}=$sl[2];
|
|
}
|
|
} else {
|
|
$enc{$new}=$sl[2];
|
|
}
|
|
}
|
|
|
|
# print new encoding table
|
|
|
|
for $i (0..255) {
|
|
if($enc{$i}) {
|
|
printf("dup %d %s put\n",$i,$enc{$i});
|
|
} else {
|
|
printf("dup %d /.notdef put\n",$i);
|
|
}
|
|
}
|
|
} else { # .afm
|
|
while($row=<STDIN>) {
|
|
if($row !~ /^C\s+(\d+)(\s*;.*)\n/) {
|
|
last;
|
|
}
|
|
$code=$1;
|
|
$part2=$2;
|
|
|
|
$new=$trans{$code};
|
|
if($new eq "") {
|
|
$new=$code;
|
|
if($enc{$new} eq "") {
|
|
$enc{$new}=$part2;
|
|
}
|
|
} else {
|
|
$enc{$new}=$part2;
|
|
}
|
|
}
|
|
|
|
# print new encoding table
|
|
|
|
for $i (0..255) {
|
|
if($enc{$i}) {
|
|
printf("C %d%s\n",$i,$enc{$i});
|
|
}
|
|
}
|
|
}
|
|
|
|
print $row;
|
|
|
|
# now copy the rest of file
|
|
|
|
while(<STDIN>) {
|
|
if( /^\/UniqueID\s+(\S+)/) {
|
|
use integer;
|
|
my $uid=$1;
|
|
$_=sprintf("/UniqueID %u def\n", &newuid($uid, $encname));
|
|
}
|
|
print;
|
|
}
|