#!/usr/bin/perl
# (c) Copyright 1998 Apostolos Syropoulos (apostolo@obelix.ee.duth.gr)
#
# This program works properly with Perl 5.004. If you have an earlier
# version of Perl 5, just rename the command ``sysseek'' to ``seek''.
# The program scans a DVI file and generates two files: genfont,
# which can be used to generate Type 3 fonts from MF sources with 
# the ``mf2pt3'' utility, and ``psfonts.map'', which can be used in the 
# conversion of a  DVI file into PostScript that uses Type 3 fonts
# generated with ``mf2pt3.pl''. 
#
# This program is actually a hack based on the ``dvitype'' program
# of Donald E. Knuth. So, if you don't understand what is going on,
# (which I suppose is just the case) just read the ``dvitype.web'' file.
# 
use integer;
################################################################
###############subroutines######################################
################################################################
sub signed_quad
{
    my ($a,$b,$c,$d) = unpack("cC3",$_[0]);
    return  (($a*256+$b)*256+$c)*256+$d;
}

sub unsinged_pair
{
    my ($a, $b) = unpack("C2",$_[0]);
    return $a*256+$b;
}

sub unsigned_trio
{
    my ($a, $b, $c) = unpack("C3",$_[0]);
    return ($a*265+$b)+$c;
}
#################################################################
##### Define certain constants###################################
#################################################################
$id_byte  = pack("C", 2);
$post     = pack("C", 248);
$nop      = 138;
$fnt_def1 = 243;
$fnt_def2 = 244;
$fnt_def3 = 245;
$fnt_def4 = 246;
################################################################
#############Start program######################################
################################################################
die "Usage: scandvi <dvi file>\n" if !@ARGV;
$file_name = $ARGV[0];
$dvi_file = $file_name . (($file_name !~ /\w+\.dvi/)? ".dvi" : "");
open(DVI, "$dvi_file")||die "Can't open $dvi_file\n";
sysseek DVI, 0, 2; 
$size=tell(DVI);
die "Bad DVI file: only $size bytes long\n" if ($size < 53);
$m=$size-4; 
do
{ 
   die "Bad DVI file: all 223s\n" if $m==0;
   sysseek DVI, $m, 0; 
   sysread DVI, $bytes, 1;
   $k=$bytes; 
   $m--;
}while ($k eq pack("C",223));
die "Bad DVI file: ID byte is $k\n" if $k ne $id_byte;
sysseek DVI, $m-3, 0; 
sysread DVI, $bytes, 4;
$q = &signed_quad($bytes);
die "Bad DVI file: post pointer $q at byte $m-3\n" if $q < 0 || $q > $m - 33;
sysseek DVI, $q, 0;
sysread DVI, $bytes, 1;
$k=$bytes;
die "Bad DVI file: byte $q is not post\n" if $k ne $post;
####################################################################  
print "Postamble starts at byte $q.\n";
sysread DVI, $bytes, 16; #ingnore p, numerator, denominator and mag information
sysread DVI, $bytes, 4;
print "maxv=",&signed_quad($bytes);
sysread DVI, $bytes, 4;
print ", maxh=", &signed_quad($bytes);
sysread DVI, $bytes, 2;
print ", maxstackdepth=", &unsinged_pair($bytes);
sysread DVI, $bytes, 2;
print ", totalpages=", &unsinged_pair($bytes),"\n";
#####################################################################
$nf=0;
do
{
    sysread DVI, $bytes, 1;
    $k = unpack("C", $bytes);
    if ($fnt_def <= $k && $k <= $fnt_def4)
    {
       if ($k == $fnt_def1)
       {
          sysread DVI, $bytes, 1;
          $fnt_num = unpack("C", $bytes);
       }
       elsif ($k == $fnt_def2)
       {  sysread DVI, $bytes, 2;
          $fnt_num = &unsinged_pair($bytes);
       }
       elsif ($k == $fnt_def3)
       {  sysread DVI, $bytes, 3;
          $fnt_num = &unsinged_trio($bytes);
       }
       elsif ($k == $fnt_def4)
       {  sysread DVI, $bytes, 4;
          $fnt_num = &singed_quad($bytes);
       }
       $font_num[$nf] = $fnt_num;
       $f = 0;
       $f++ while ($font_num[$f] != $fnt_num);
       sysread DVI, $bytes, 12; #omit check sum, scaled size, design size
       sysread DVI, $bytes, 1;
       $p = unpack("C",$bytes);
       sysread DVI, $bytes, 1;
       $n = unpack("C",$bytes);
#######print "Font $nf: ";
       if ($n+$p==0)
       {
	   print "null font name!\n";
       }
       else
       {
           sysread DVI, $bytes, $n+$p;
           $font_name[$nf] = unpack("a*",$bytes);
#######print $font_name[$nf],"\n";
       }
       $k=$nop; 
       $nf++;
    }    
} while ($k == $nop);
close DVI;    
##############################################################
open(SH, ">genfonts")||die "Can't create file genfonts\n";
open(PS, ">psfonts.map")||die "Can't create file psfonts.map";
$warnings=0;
foreach $font (@font_name)
{
    if ($font !~ /\D+\d+$/)
    {
       warn "Font $font has no design size; probably it's a PostScript font\n";
       $warnings++;
    }
    print SH "mf2pt3.pl $font\n";
    print PS "$font $font <$font.pt3\n";
}
close SH;
close PS;
if ($warnings>0)
{
    print "\n\n*** ";
    print "Please consider editing files: ";
    print " ``genfont\'\' and ``psfonts.map\'\'\n"
}
__END__