librarian/font-optimizer/ext/Font-TTF/lib/ttfmod.pl

   1 #       Title:      TTFMOD.PL
   2 #       Author:     M. Hosken
   3 #       Description:    Read TTF file calling user functions for each table
   4 #                       and output transformed tables to new TTF file.
   5 #       Useage:     TTFMOD provides the complete control loop for processing
   6 #                   the TTF files.  All that the caller need supply is an
   7 #                   associative array of functions to call keyed by the TTF
   8 #                   table name and the two filenames.
   9 #
  10 #           &ttfmod($infile, $outfile, *fns [, @must]);
  11 #
  12 #                   *fns is an associative array keyed by table name with
  13 #                   values of the name of the subroutine in package main to
  14 #                   be called to transfer the table from INFILE to OUTFILE.
  15 #                   The subroutine is called with the following parameters and
  16 #                   expected return values:
  17 #
  18 #           ($len, $csum) = &sub(*INFILE, *OUTFILE, $len);
  19 #
  20 #                   INFILE and OUTFILE are the input and output streams, $len
  21 #                   is the length of the table according to the directory.
  22 #                   The return values are $len = new length of table to be
  23 #                   given in the table directory.  $csum = new value of table
  24 #                   checksum.  A way to test that this is correct is to
  25 #                   checksum the whole file (e.g. using CSUM.BAT) and to
  26 #                   ensure that the value is 0xB1B0AFBA according to a 32 bit
  27 #                   checksum calculated bigendien.
  28 #
  29 #                   @must consists of a list of tables which must exist in the
  30 #                   final output file, either by being there alread or by being
  31 #                   inserted.
  32 #
  33 # Modifications:
  34 # MJPH  1.00    22-SEP-1994     Original
  35 # MJPH  1.1     18-MAR-1998     Added @must to ttfmod()
  36 # MJPH  1.1.1   25-MAR-1998     Added $csum to copytab (to make reusable)
  37
  38 package ttfmod;
  39
  40 sub main'ttfmod {
  41     local($infile, $outfile, *fns, @must) = @_;
  42
  43     # open files as binary.  Notice OUTFILE is opened for update not just write
  44     open(INFILE, "$infile") || die "Unable top open \"$infile\" for reading";
  45     binmode INFILE;
  46     open(OUTFILE, "+>$outfile") || die "Unable to open \"$outfile\" for writing";
  47     binmode OUTFILE;
  48
  49     seek(INFILE, 0, 0);
  50     read(INFILE, $dir_head, 12) || die "Reading table header";
  51     ($dir_num) = unpack("x4n", $dir_head);
  52     print OUTFILE $dir_head;
  53     # read and unpack table directory
  54     for ($i = 0; $i < $dir_num; $i++)
  55         {
  56         read(INFILE, $dir_val, 16) || die "Reading table entry";
  57         $dir{unpack("a4", $dir_val)} = join(":", $i, unpack("x4NNN", $dir_val));
  58         print OUTFILE $dir_val;
  59         printf STDERR "%s %08x\n", unpack("a4", $dir_val), unpack("x8N", $dir_val)
  60                 if (defined $main'opt_z);
  61         }
  62     foreach $n (@must)
  63     {
  64         next if defined $dir{$n};
  65         $dir{$n} = "$i:0:-1:0";
  66         $i++; $dir_num++;
  67         print OUTFILE pack("a4NNN", $n, 0, -1, 0);
  68     }
  69     substr($dir_head, 4, 2) = pack("n", $dir_num);
  70     $csum = unpack("%32N*", $dir_head);
  71     $off = tell(OUTFILE);
  72     seek(OUTFILE, 0, 0);
  73     print OUTFILE $dir_head;
  74     seek (OUTFILE, $off, 0);
  75     # process tables in order they occur in the file
  76     @dirlist = sort byoffset keys(%dir);
  77     foreach $tab (@dirlist)
  78         {
  79         @tab_split = split(':', $dir{$tab});
  80         seek(INFILE, $tab_split[2], 0);         # offset
  81         $tab_split[2] = tell(OUTFILE);
  82         if (defined $fns{$tab})
  83             {
  84             $temp = "main'$fns{$tab}";
  85             ($dir_len, $sum) = &$temp(*INFILE, *OUTFILE, $tab_split[3]);
  86             }
  87         else
  88             {
  89             ($dir_len, $sum) = &copytab(*INFILE, *OUTFILE, $tab_split[3]);
  90             }
  91         $tab_split[3] = $dir_len;               # len
  92         $tab_split[1] = $sum;                   # checksum
  93         $out_dir{$tab} = join(":", @tab_split);
  94         }
  95     # now output directory in same order as original directory
  96     @dirlist = sort byindex keys(%out_dir);
  97     foreach $tab (@dirlist)
  98         {
  99         @tab_split = split(':', $out_dir{$tab});
 100         seek (OUTFILE, 12 + $tab_split[0] * 16, 0);     # directory index
 101         print OUTFILE pack("A4N3", $tab, @tab_split[1..3]);
 102         foreach $i (1..3, 1)        # checksum directory values with csum twice
 103             {
 104             $csum += $tab_split[$i];
 105     # this line ensures $csum stays within 32 bit bounds, clipping as necessary
 106             if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum--; }
 107             }
 108     # checksum the tag
 109         $csum += unpack("N", $tab);
 110         if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum--; }
 111         }
 112     # handle main checksum
 113     @tab_split = split(':', $out_dir{"head"});
 114     seek(OUTFILE, $tab_split[2], 0);
 115     read(OUTFILE, $head_head, 12);          # read first bit of "head" table
 116     @head_split = unpack("N3", $head_head);
 117     $tab_split[1] -= $head_split[2];        # subtract old checksum
 118     $csum -= $head_split[2] * 2;            # twice because had double effect
 119                                             # already
 120     if ($csum < 0 ) { $csum += 0xffffffff; $csum++; }
 121     $head_split[2] = 0xB1B0AFBA - $csum;    # calculate new checksum
 122     seek (OUTFILE, 12 + $tab_split[0] * 16, 0);
 123     print OUTFILE pack("A4N3", "head", @tab_split[1..3]);
 124     seek (OUTFILE, $tab_split[2], 0);       # rewrite first bit of "head" table
 125     print OUTFILE pack("N3", @head_split);
 126
 127     # finish up
 128     close(OUTFILE);
 129     close(INFILE);
 130     }
 131
 132 # support function for sorting by table offset
 133 sub byoffset {
 134     @t1 = split(':', $dir{$a});
 135     @t2 = split(':', $dir{$b});
 136     return 1 if ($t1[2] == -1);     # put inserted tables at the end
 137     return -1 if ($t2[2] == -1);
 138     return $t1[2] <=> $t2[2];
 139     }
 140
 141 # support function for sorting by directory entry order
 142 sub byindex {
 143     $t1 = split(':', $dir{$a}, 1);
 144     $t2 = split(':', $dir{$b}, 1);
 145     return $t1 <=> $t2;
 146     }
 147
 148 # default table action: copies a table from input to output, recalculating
 149 #   the checksum (just to be absolutely sure).
 150 sub copytab {
 151     local(*INFILE, *OUTFILE, $len, $csum) = @_;
 152
 153     while ($len > 0)
 154         {
 155         $count = ($len > 8192) ? 8192 : $len;       # 8K buffering
 156         read(INFILE, $buf, $count) == $count || die "Copying";
 157         $buf .= "\0" x (4 - ($count & 3)) if ($count & 3);      # pad to long
 158         print OUTFILE $buf;
 159         $csum += unpack("%32N*", $buf);
 160         if ($csum > 0xffffffff) { $csum -= 0xffffffff; $csum--; }
 161         $len -= $count;
 162         }
 163     ($_[2], $csum);
 164     }
 165
 166 # test routine to copy file from input to output, no changes
 167 package main;
 168
 169 if ($test_package)
 170     {
 171     &ttfmod($ARGV[0], $ARGV[1], *dummy);
 172     }
 173 else
 174     { 1; }