#!/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;
}