#!/usr/bin/perl
#
#  Copyright (c) 1998
#   Sergey A. Babkin.  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
#  WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
#  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#  Sergey A. Babkin (sab123@hotmail.com, babkin@bellatlantic.net)
#

#
# Script that reads the Type1 font files and prints out the fonts.scale
# lines for them
#

# other substrings (regexps) that are considered irrelevant
# and sould be removed from the font names:
@wrongstr= (
	"koi8r",
	"koi8",
	"cp1251",
	"ibm1251",
	"win1251",
	"cp866",
	"ibm866",
	"iso8859[1-9]",
	"iso8859",
	"isolatin[0-9]",
	"isolatin",
	"latin[0-9]",
	"^ER ",
	"^K8 ",
);

sub usage
{
	print STDERR "Use: t1fdir [-g] <foundry> <encoding> [<file>...]\n"
}

$ghost=0;
if( $ARGV[0] eq "-g" ) {
	shift @ARGV;
	$ghost=1;
}

if($#ARGV<2) {
	&usage();
	exit 1;
}

$foundry=$ARGV[0];
shift @ARGV;
$encoding=$ARGV[0];
shift @ARGV;

for $name (@ARGV) {

	$familyname="";
	$fullname="";
	$fontname="";
	$weight="";
	$angle=0;

	open(FILE,"<$name") || die "Unable to open file $name\n";

	$type="p"; # by default

	while(<FILE>) {
		if(/eexec/) { last; }
		if(/^\/FamilyName.*\((.+)\)/ ) { $familyname= $1; }
		if(/^\/FullName.*\((.+)\)/ ) { $fullname= $1; }
		if(/^\/FontName.*\((.+)\)/ ) { $fontname= $1; }
		if(/^\/Weight.*\((.+)\)/ ) { $weight= $1; }
		if(/^\/ItalicAngle.*(\d+)/ ) { $angle= $1+0; }
		if(/^\/isFixedPitch/) {
			if(/true/) {
				$type="m";
			} else {
				$type="p";
			}
		}
	}

	# now try to interpret this information 

	$allinfo= $familyname ." ". $fullname ." ". $fontname ." ". $weight;
	$lcallinfo=$allinfo;
	$lcallinfo=~tr[A-Z][a-z];

	$familyname.="_"; # just a delimiter for substitutions
	$familyname=~s/Bold([^a-z])/$1/g;
	$familyname=~s/Italic([^a-z])/$1/g;
	$familyname=~s/Oblique([^a-z])/$1/g;
	$familyname=~s/Roman([^a-z])/$1/g;

	for $i (@wrongstr) { # for uppercase- and space- sensitive strings
		$familyname =~ s/$i//g;
	}

	$familyname=~tr[A-Z][a-z];
	$familyname=~tr[A-Za-z0-9][]cd;

	for $i (@wrongstr) { # for case-insensitive strings
		$familyname =~ s/$i//g;
	}

	if( $familyname eq "") {
		$familyname="unknown";
	}

	$fn=$name;
	$fn=~ s/.*\///g;

	if($ghost) {
		printf("/%s-%s-", $familyname, $encoding);

		$r=1;

		if( $allinfo =~ /Bold[^a-z]/
		|| $lcallinfo =~ /\bbold\b/ ) {
			printf("Bold");
			$r=0;
		}
		if( $allinfo =~ /Italic[^a-z]/
		|| $lcallinfo =~ /\bitalic\b/ 
		|| $angle>0 ) {
			printf("Italic");
			$r=0;
		} elsif( $allinfo =~ /Oblique[^a-z]/
		|| $lcallinfo =~ /\boblique\b/ 
		|| $angle<0 ) {
			printf("Oblique");
			$r=0;
		}

		if($r) {
			printf("Roman");
		}

		printf("\t (%s)	;\n",$fn);
	} else {
		printf("%s -%s-%s-",$fn,$foundry,$familyname);

		if( $allinfo =~ /Bold[^a-z]/
		|| $lcallinfo =~ /\bbold\b/ ) {
			printf("bold-");
		} else {
			printf("medium-");
		}

		if( $allinfo =~ /Italic[^a-z]/
		|| $lcallinfo =~ /\bitalic\b/ 
		|| $angle>0 ) {
			printf("i-");
		} elsif( $allinfo =~ /Oblique[^a-z]/
		|| $lcallinfo =~ /\boblique\b/ 
		|| $angle<0 ) {
			printf("o-");
		} else {
			printf("r-");
		}

		printf("normal--0-0-0-0-%s-0-%s\n",$type,$encoding);
	}

	close(FILE);
}
