#! /usr/bin/perl

# fontmap: program to make a psfonts.map
#
#
# put this with the font-files
# usage: perl fontmap
# depends on the existance of afm-files
# assumes the use of pfa-files

# Fulko van Westrenen
# 20 Jan 2003
# 
#  http://www.umantec.nl/varia/


sub findfontname {
  my ($fn) = @_;
  my $fontname;
  open IN, "<$fn" ||die "cannot open $fn to read \n";
  while (<IN>) {
    if (/^FontName /) {
      chomp;
      $fontname = (split(/ /,$_))[1];
      $fontname =~ tr/^A-Za-z0-9\-_/ /c; #remove rubbish
      $fontname =~ s/ //g;
      return $fontname;
      close(IN);
    }
  }
  return "";
  close(IN);
}


$dir = `ls *.afm`;
$dir =~ s/\n/ /g;
@dir = split(/ +/, $dir);

open MAP, ">psfontsextra.map" ||die "cannot create file\n";

@tmp=@dir;
#get the normal fonts
for (grep(/8a.{0,1}\.afm/,@tmp)) {
  $fn=$_;
  $fontname=findfontname($fn);
  $fn =~ s/\.afm//;
  $bn = $fn;
  $bn =~ s/8a/8r/;
  print MAP "$bn $fontname \"TeXBase1Encoding ReEncodeFont \" <8r.enc <$fn.pfa \n"
}

#make the oblique fonts
#remove them if the family contains a oblique version 
#       and this routime makes them also
@tmp=@dir;
for (grep(/[^io]8a.{0,1}\.afm/,@tmp)) {
  $fn=$_;
  $fontname=findfontname($fn);
  $fn =~ s/\.afm//;
  $bn = $fn;
  $bn =~ s/8a/o8r/; #add "o"
  print MAP "$bn $fontname \".167 SlantFont TeXBase1Encoding ReEncodeFont \" <8r.enc <$fn.pfa \n"
}

@tmp=@dir;
#make the expert list
for (grep(/8x.{0,1}\.afm/,@tmp)) {
  $fn=$_;
  $fontname=findfontname($fn);
  $fn =~ s/\.afm//;
  $bn = $fn;
  print MAP "$bn $fontname <$fn.pfa \n"
}

@tmp=@dir;
#make the specials
for (grep(/[0-7,9].{0,2}\.afm/,@tmp)) {
  $fn=$_;
  $fontname=findfontname($fn);
  $fn =~ s/\.afm//;
  $bn = $fn;
  print MAP "$bn $fontname <$fn.pfa \n"
}

close MAP;
