#!/usr/bin/perl -w
#
#	CheckType1.pl		: Load Type 1 font into 3 segments
#	Deri James		: Sun 30 Jul 2017
#

use strict;

while (my $fn=shift)
{
	my $F;
	
	if (open($F,"<$fn"))
	{
		print "\n$fn\n";
		GetType1($F);
		close($F);
#		my $d=<STDIN>;
	}
}

my $remv;

sub GetType1
{
	my $F=shift;
	my ($sz,$head,$body,$tail)=(0,'','','');
	$sz=-s $F;
	$remv=0;
	
	$head=GetChunk($F,1,"currentfile eexec");
	$body=GetChunk($F,2,"00000000") if !eof($F);
	$tail=GetChunk($F,3,"cleartomark") if !eof($F);
	
	print "File=$sz, Font=",length($head)+length($body)+length($tail)+$remv,"\n";
}

sub GetChunk
{
	my $F=shift;
	my $segno=shift;
	my $ascterm=shift;
	my ($type,$hdr,$chunk,@msg);
	binmode($F);
	my $enc="ascii";
	
	while (1)
	{
		# There may be multiple chunks of the same type
		
		my $ct=read($F,$hdr,2);
		
		if ($ct==2)
		{
			if (substr($hdr,0,1) eq "\x80")
			{
				# binary chunk
				
				my $chunktype=ord(substr($hdr,1,1));
				$enc="binary";
				
				if (defined($type) and $type != $chunktype)
				{
					seek($F,-2,1);
					last;
				}
				
				$type=$chunktype;
				push(@msg,"EOF segment found"), return if $chunktype == 3;
				
				$ct=read($F,$hdr,4);
				$remv+=6;
				
				push(@msg,"Failed to read binary segment length"), return if $ct != 4;
				
				my $sl=unpack('L',$hdr);
				my $data;
				my $chk=read($F,$data,$sl);
				
				push(@msg,"Failed to read binary segment"), return if $chk != $sl;
				
				$chunk.=$data;
			}
			else
			{
				# ascii chunk
				
				my $hex=0;
				seek($F,-2,1);
#				binmode($F,":perlio");
				my $ct=0;
				
				while (1)
				{
					my $lin=<$F>;
					
					last if !$lin;
					
					$hex=1,$enc.=" hex" if $segno == 2 and !$ct and $lin=~m/^[A-F0-9a-f]{4,4}/;
					
					if ($segno !=2 and $lin=~m/^(.*$ascterm\n?)(.*)/)
					{
						$chunk.=$1;
						seek($F,-length($2)-1,1) if $2;
						last;
					}
					elsif ($segno == 2 and $lin=~m/^(.*?)($ascterm.*)/)
					{
						$chunk.=$1;
						seek($F,-length($2)-1,1) if $2;
						last;
					}
					
					chomp($lin), $lin=pack('H*',$lin) if $hex;
					$chunk.=$lin; $ct++;
				}
				
				last;
			}
		}
		else
		{
			push(@msg,"Failed to read 2 header bytes");
		}
	}
	
	print "Segment $segno ($enc) =\t",length($chunk),"\n";
	print join("\n",@msg) if $#msg >= 0;
	$#msg=-1;
	return($chunk);
}