Workaround was bad.
[librarian.git] / 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; }