#!/usr/bin/perl
#
#(c) Copyright 1998 Apostolos Syropoulos
#                   apostolo@obelix.ee.duth.gr
# 
   $mfplain="mfplain \'\\mode=localfont; \\batchmode; ";
   $notdef=pack("ai4","u",0,0,0,0);
   for($i=0; $i<=255; $i++){ $BoundingBox[$i]=$notdef }

   @Encoding = ("/_a0", "/_a1", "/_a2", "/_a3", "/_a4", 
                "/_a5", "/_a6", "/_a7", "/_a8", 
                "/_a9", "/_a10", "/_a11", "/_a12", 
                "/_a13", "/_a14", "/_a15", "/_a16", 
                "/_a17", "/_a18", "/_a19", "/_a20", 
                "/_a21", "/_a22", "/_a23", "/_a24", 
                "/_a25", "/_a26", "/_a27", "/_a28", 
                "/_a29", "/_a30", "/_a31", "/_a32", 
                "/_a33", "/_a34", "/_a35", "/_a36", 
                "/_a37", "/_a38", "/_a39", "/_a40", 
                "/_a41", "/_a42", "/_a43", "/_a44", 
                "/_a45", "/_a46", "/_a47", "/_a48", 
                "/_a49", "/_a50", "/_a51", "/_a52", 
                "/_a53", "/_a54", "/_a55", "/_a56", 
                "/_a57", "/_a58", "/_a59", "/_a60", 
                "/_a61", "/_a62", "/_a63", "/_a64", 
                "/_a65", "/_a66", "/_a67", "/_a68", 
                "/_a69", "/_a70", "/_a71", "/_a72", 
                "/_a73", "/_a74", "/_a75", "/_a76", 
                "/_a77", "/_a78", "/_a79", "/_a80", 
                "/_a81", "/_a82", "/_a83", "/_a84", 
                "/_a85", "/_a86", "/_a87", "/_a88", 
                "/_a89", "/_a90", "/_a91", "/_a92", 
                "/_a93", "/_a94", "/_a95", "/_a96", 
                "/_a97", "/_a98", "/_a99", "/_a100", 
                "/_a101", "/_a102", "/_a103", "/_a104", 
                "/_a105", "/_a106", "/_a107", "/_a108", 
                "/_a109", "/_a110", "/_a111", "/_a112", 
                "/_a113", "/_a114", "/_a115", "/_a116", 
                "/_a117", "/_a118", "/_a119", "/_a120", 
                "/_a121", "/_a122", "/_a123", "/_a124", 
                "/_a125", "/_a126", "/_a127", "/_a128", 
                "/_a129", "/_a130", "/_a131", "/_a132", 
                "/_a133", "/_a134", "/_a135", "/_a136", 
                "/_a137", "/_a138", "/_a139", "/_a140", 
                "/_a141", "/_a142", "/_a143", "/_a144", 
                "/_a145", "/_a146", "/_a147", "/_a148", 
                "/_a149", "/_a150", "/_a151", "/_a152", 
                "/_a153", "/_a154", "/_a155", "/_a156", 
                "/_a157", "/_a158", "/_a159", "/_a160", 
                "/_a161", "/_a162", "/_a163", "/_a164", 
                "/_a165", "/_a166", "/_a167", "/_a168", 
                "/_a169", "/_a170", "/_a171", "/_a172", 
                "/_a173", "/_a174", "/_a175", "/_a176", 
                "/_a177", "/_a178", "/_a179", "/_a180", 
                "/_a181", "/_a182", "/_a183", "/_a184", 
                "/_a185", "/_a186", "/_a187", "/_a188", 
                "/_a189", "/_a190", "/_a191", "/_a192", 
                "/_a193", "/_a194", "/_a195", "/_a196", 
                "/_a197", "/_a198", "/_a199", "/_a200", 
                "/_a201", "/_a202", "/_a203", "/_a204", 
                "/_a205", "/_a206", "/_a207", "/_a208", 
                "/_a209", "/_a210", "/_a211", "/_a212", 
                "/_a213", "/_a214", "/_a215", "/_a216", 
                "/_a217", "/_a218", "/_a219", "/_a220", 
                "/_a221", "/_a222", "/_a223", "/_a224", 
                "/_a225", "/_a226", "/_a227", "/_a228", 
                "/_a229", "/_a230", "/_a231", "/_a232", 
                "/_a233", "/_a234", "/_a235", "/_a236", 
                "/_a237", "/_a238", "/_a239", "/_a240", 
                "/_a241", "/_a242", "/_a243", "/_a244", 
                "/_a245", "/_a246", "/_a247", "/_a248", 
                "/_a249", "/_a250", "/_a251", "/_a252", 
                "/_a253", "/_a254", "/_a255");


$argc = @ARGV;
$design_size = -1;
$nodel = 0;
$eofill = 0;
$noID = 1;
SWITCHES: while($_ = $ARGV[0], /^-/)
{
    shift;
    if(/^-d(\d+)/)
    {
        $design_size = $1;
    }
    elsif(/^-nodel$/)
    {
        $nodel = 1;
    }
    elsif(/^-eofill$/)
    {
        $eofill = 1;
    }
    elsif(/^-I(\d+)$/)
    {
      die "UniqueID must lie in the range 4,000,000...4,999,999\n"
      if ($1 > 4999999 || $1 < 4000000);
      $UniqueID = $1;
      $noID = 0;
    }
    elsif (!@ARGV)
    {
        last SWITCHES;
    }
}    
if (!@ARGV)
{
   print <<Usage;
This ``mf2pt3'' version 1.1
Usage: mf2pt3 [-dsize] [-nodel] [-eofill] [-IUniqueID] <METAFONT file name>
Usage
exit(0);
}
else
{
   $MFfile = $ARGV[0];
}
if ($noID)
{
      srand();
      $UniqueID = int(999999*rand())+4000000;

}

if ($design_size == -1)
{
   if ($MFfile =~ /\D+(\d+)$/)
   {
      $design_size=$1;
   }
   else
   {
      die "$MFfile must be a PostScript font name: there is no design size.\n";
   }
}
if($design_size >100)
{
   $mag_factor=$design_size/1000;
}
else
{
   $mag_factor=$design_size/10;
}
$mag = 100 /$mag_factor;

   $MFfile = $1 if $MFfile =~ /(\w+)\.\w*/;



   $mfplain .= "mag=$mag; input $MFfile \'";
   system($mfplain);
   if (!(-e "$MFfile.tfm"))
   {
      $nodel || unlink "mpout.log";  
      die "$MFfile: no such font in system\n";
   }

        opendir(Dir, ".");
        $pattern = "$MFfile" . "\\.\\d+";
        @EPSFs = grep(/$pattern/, readdir(Dir));
        closedir Dir;

     $Min_llx = $Min_lly = $Max_urx = $Max_ury = 0; 
     
        $total_chars = @EPSFs+1;
        foreach $file (@EPSFs)
        {
           open(EPSF_FILE,"$file")||die "Can't open file $file\n";
           while (<EPSF_FILE>)
           {
              $BBox = pack("ai4","d",$1,$2,$3,$4)
              if /%%BoundingBox: (-?\d+) (-?\d+) (-?\d+) (-?\d+)/;
           }
           close EPSF_FILE;
           $_=$file;
           /$MFfile\.(\d+)/;
           $BoundingBox[$1] = $BBox;
           ($_, $llx, $lly, $urx, $ury) = unpack("ai4", $BBox);
           $Min_llx = $llx if $llx < $Min_llx;
           $Min_lly = $lly if $lly < $Min_lly;
           $Max_urx = $urx if $urx > $Max_urx;
           $Max_ury = $ury if $ury > $Max_ury;
        }

      open(TYPE3, ">$MFfile.pt3")||die "Can't create file $MFfile.pt3\n";
      $date = localtime;
      print TYPE3 <<DATA;
%!PS-Adobe-2.0
%%Creator: mf2pt3 1.1 Copyright 1998 Apostolos Syropoulos
%%CreationDate: $date
%%EndComments
11 dict % 11 entries
begin
    /FontType 3 def
    /UniqueID $UniqueID def
    /FontName /$MFfile def
    /FontBBox [ $Min_llx $Min_lly $Max_urx $Max_ury] def 
    /FontMatrix [ 0.001 0 0 0.001 0 0 ] def
    /Encoding 256 array def
    0 1 255 { Encoding exch /.notdef put } for
DATA
       for($i=0; $i<=256; $i++)
       {
          $_ = unpack("ai4", $BoundingBox[$i]);
          print TYPE3 "Encoding $i $Encoding[$i] put\n" if $_ eq "d";
       } 
    
       print TYPE3 "/BoundingBoxes $total_chars dict def\n";
       print TYPE3 "BoundingBoxes begin\n";
       print TYPE3 "/.notdef { 0 0 0 0 } def\n";
       for($i=0; $i<=256; $i++)
       {
          ($_, $llx, $lly, $urx, $ury) = unpack("ai4",$BoundingBox[$i]);
          print TYPE3 "$Encoding[$i] [ $llx $lly $urx $ury ] def\n" 
                                                     if $_ eq "d";
       }
       print TYPE3 "end %BoundingBoxes\n"; 
      

       print TYPE3 "/Metrics $total_chars dict def\n";
       print TYPE3 "Metrics begin\n";
       print TYPE3 "/.notdef 0 def\n";
       for($i=0; $i<=256; $i++)
       {
          ($_, $llx, $lly, $urx, $ury) = unpack("ai4",$BoundingBox[$i]);
          $diff = $urx - $llx;
          print TYPE3 "$Encoding[$i] $diff  def\n" if $_ eq "d";
       }
       print TYPE3 "end %Metrics\n";

   
        print TYPE3 "/CharProcs $total_chars dict def\n";
        print TYPE3 "CharProcs begin\n";
        print TYPE3 "/.notdef { } def\n";
        for($i=0; $i<=256; $i++)
        {
          $_ = unpack("ai4", $BoundingBox[$i]);
          if ($_ eq "d")
          {
             open(CHAR, "$MFfile.$i")||
             die "Can't open file $MFfile.$i\n"; 
             $code = ""; #"100 100 scale\n";
             while (<CHAR>)
             {
                $code .= $_ if $_ !~ /^%/;
             }
             close CHAR;
             $code =~ s/showpage\n*//mg; #eliminate showpage
             $code =~ s/\d setgray//mg;  #eliminate setgray
             $code =~ s/(\d*)\.\d+/$1/mg; #chop decimal digits
             print TYPE3 $Encoding[$i], " { %\n";
             if ($eofill)
             {
                $code =~ s/gsave fill/GSAVE FILL/mg;  # save for soon restore
                $code =~ s/fill//mg;                  # eliminate fill
                $code =~ s/newpath//mg;               # eliminate fill
                $code =~ s/GSAVE FILL/gsave fill/mg;  # restore 
                print TYPE3 $code, "eofill\n";
 
             }
             else
             {
                print TYPE3 $code;
             }
             print TYPE3 "} bind def\n";
          }
        }  
        print TYPE3 "end %CharProcs\n"; 

 print TYPE3 <<BUILDGLYPH;
    /BuildGlyph {
         exch
         begin
             dup
             Metrics exch get % get x displacement
             0                % set y displacement
             2 index
             BoundingBoxes
             exch get aload pop
             setcachedevice
             CharProcs exch get
             exec
             fill
         end
    } def
    currentdict
end
/$MFfile exch definefont
pop
BUILDGLYPH
close TYPE3;

 
     
  
   if (!$nodel)
   {
      unlink @EPSFs;
      unlink "$MFfile.log", "$MFfile.tfm";
   }

print "\n$MFfile $MFfile <$MFfile.pt3\n";