← Back to branch summary

~ubuntu-branches/ubuntu/dapper/groff/dapper

« back to all changes in this revision

Viewing changes to src/utils/afmtodit/afmtodit.pl

  • Committer: Bazaar Package Importer
  • Author(s): Colin Watson
  • Date: 2002-03-17 04:11:50 UTC
  • Revision ID: james.westby@ubuntu.com-20020317041150-wkgfawjc3gxlk0o5
Tags: upstream-1.17.2
Import upstream version 1.17.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/utils/afmtodit/afmtodit.pl
 
1
#! /usr/bin/perl -P-
 
2
# -*- Perl -*-
 
3
# Copyright (C) 1989-2000 Free Software Foundation, Inc.
 
4
#      Written by James Clark (jjc@jclark.com)
 
5
#
 
6
# This file is part of groff.
 
7
#
 
8
# groff is free software; you can redistribute it and/or modify it under
 
9
# the terms of the GNU General Public License as published by the Free
 
10
# Software Foundation; either version 2, or (at your option) any later
 
11
# version.
 
12
#
 
13
# groff is distributed in the hope that it will be useful, but WITHOUT ANY
 
14
# WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
15
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 
16
# for more details.
 
17
#
 
18
# You should have received a copy of the GNU General Public License along
 
19
# with groff; see the file COPYING.  If not, write to the Free Software
 
20
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
21
 
 
22
$prog = $0;
 
23
$prog =~ s@.*/@@;
 
24
 
 
25
do 'getopts.pl';
 
26
do Getopts('ve:sd:i:a:n');
 
27
 
 
28
if ($opt_v) {
 
29
    print "GNU afmtodit (groff) version @VERSION@\n";
 
30
    exit 0;
 
31
}
 
32
 
 
33
if ($#ARGV != 2) {
 
34
    die "Usage: $prog [-nsv] [-d DESC] [-e encoding] [-i n] [-a angle] afmfile mapfile font\n";
 
35
}
 
36
 
 
37
$afm = $ARGV[0];
 
38
$map = $ARGV[1];
 
39
$font = $ARGV[2];
 
40
$desc = $opt_d || "DESC";
 
41
 
 
42
# read the afm file
 
43
 
 
44
open(AFM, $afm) || die "$prog: can't open \`$ARGV[0]': $!\n";
 
45
 
 
46
while (<AFM>) {
 
47
    chop;
 
48
    @field = split(' ');
 
49
    if ($field[0] eq "FontName") {
 
50
        $psname = $field[1];
 
51
    }
 
52
    elsif($field[0] eq "ItalicAngle") {
 
53
        $italic_angle = -$field[1];
 
54
    }
 
55
    elsif ($field[0] eq "KPX") {
 
56
        if ($#field == 3) {
 
57
            push(kern1, $field[1]);
 
58
            push(kern2, $field[2]);
 
59
            push(kernx, $field[3]);
 
60
        }
 
61
    }
 
62
    elsif ($field[0] eq "italicCorrection") {
 
63
        $italic_correction{$field[1]} = $field[2];
 
64
    }
 
65
    elsif ($field[0] eq "leftItalicCorrection") {
 
66
        $left_italic_correction{$field[1]} = $field[2];
 
67
    }
 
68
    elsif ($field[0] eq "subscriptCorrection") {
 
69
        $subscript_correction{$field[1]} = $field[2];
 
70
    }
 
71
    elsif ($field[0] eq "StartCharMetrics") {
 
72
        while (<AFM>) {
 
73
            @field = split(' ');
 
74
            last if ($field[0] eq "EndCharMetrics");
 
75
            if ($field[0] eq "C") {
 
76
                $c = -1;
 
77
                $wx = 0;
 
78
                $n = "";
 
79
                $lly = 0;
 
80
                $ury = 0;
 
81
                $llx = 0;
 
82
                $urx = 0;
 
83
                $c = $field[1];
 
84
                $i = 2;
 
85
                while ($i <= $#field) {
 
86
                    if ($field[$i] eq "WX") {
 
87
                        $w = $field[$i + 1];
 
88
                        $i += 2;
 
89
                    }
 
90
                    elsif ($field[$i] eq "N") {
 
91
                        $n = $field[$i + 1];
 
92
                        $i += 2;
 
93
                    }
 
94
                    elsif ($field[$i] eq "B") {
 
95
                        $llx = $field[$i + 1];
 
96
                        $lly = $field[$i + 2];
 
97
                        $urx = $field[$i + 3];
 
98
                        $ury = $field[$i + 4];
 
99
                        $i += 5;
 
100
                    }
 
101
                    elsif ($field[$i] eq "L") {
 
102
                        push(ligatures, $field[$i + 2]);
 
103
                        $i += 3;
 
104
                    }
 
105
                    else {
 
106
                        while ($i <= $#field && $field[$i] ne ";") {
 
107
                            $i++;
 
108
                        }
 
109
                        $i++;
 
110
                    }
 
111
                }
 
112
                if (!$opt_e && $c != -1) {
 
113
                    $encoding[$c] = $n;
 
114
                    $in_encoding{$n} = 1;
 
115
                }
 
116
                $width{$n} = $w;
 
117
                $height{$n} = $ury;
 
118
                $depth{$n} = -$lly;
 
119
                $left_side_bearing{$n} = -$llx;
 
120
                $right_side_bearing{$n} = $urx - $w;
 
121
            }
 
122
        }
 
123
    }
 
124
}
 
125
close(AFM);
 
126
 
 
127
# read the DESC file
 
128
 
 
129
$sizescale = 1;
 
130
 
 
131
open(DESC, $desc) || die "$prog: can't open \`$desc': $!\n";
 
132
while (<DESC>) {
 
133
    next if /^#/;
 
134
    chop;
 
135
    @field = split(' ');
 
136
    last if $field[0] eq "charset";
 
137
    if ($field[0] eq "res") { $resolution = $field[1]; }
 
138
    if ($field[0] eq "unitwidth") { $unitwidth = $field[1]; }
 
139
    if ($field[0] eq "sizescale") { $sizescale = $field[1]; }
 
140
}
 
141
close(DESC);
 
142
 
 
143
if ($opt_e) {
 
144
    # read the encoding file
 
145
    
 
146
    open(ENCODING, $opt_e) || die "$prog: can't open \`$opt_e': $!\n";
 
147
    while (<ENCODING>) {
 
148
        chop;
 
149
        @field = split(' ');
 
150
        if ($#field == 1) {
 
151
            if ($field[1] >= 0 && defined $width{$field[0]}) {
 
152
                $encoding[$field[1]] = $field[0];
 
153
                $in_encoding{$field[0]} = 1;
 
154
            }
 
155
        }
 
156
    }
 
157
    close(ENCODING);
 
158
}
 
159
 
 
160
# read the map file
 
161
 
 
162
open(MAP, $map) || die "$prog: can't open \`$map': $!\n";
 
163
while (<MAP>) {
 
164
    next if /^#/;
 
165
    chop;
 
166
    @field = split(' ');
 
167
    if ($#field == 1 && $in_encoding{$field[0]}) {
 
168
        if (defined $mapped{$field[1]}) {
 
169
            warn "Both $mapped{$field[1]} and $field[0] map to $field[1]";
 
170
        }
 
171
        elsif ($field[1] eq "space") {
 
172
            # the PostScript character "space" is automatically mapped
 
173
            # to the groff character "space"; this is for grops
 
174
            warn "you are not allowed to map to the groff character `space'";
 
175
        }
 
176
        elsif ($field[0] eq "space") {
 
177
            warn "you are not allowed to map the PostScript character `space'";
 
178
        }
 
179
        else {
 
180
            $nmap{$field[0]} += 0;
 
181
            $map{$field[0],$nmap{$field[0]}} = $field[1];
 
182
            $nmap{$field[0]} += 1;
 
183
            $mapped{$field[1]} = $field[0];
 
184
        }
 
185
    }
 
186
}
 
187
close(MAP);
 
188
 
 
189
$italic_angle = $opt_a if $opt_a;
 
190
 
 
191
# print it all out
 
192
 
 
193
open(FONT, ">$font") || die "$prog: can't open \`$font' for output: $!\n";
 
194
select(FONT);
 
195
 
 
196
print("name $font\n");
 
197
print("internalname $psname\n") if $psname;
 
198
print("special\n") if $opt_s;
 
199
printf("slant %g\n", $italic_angle) if $italic_angle != 0;
 
200
printf("spacewidth %d\n", do conv($width{"space"})) if defined $width{"space"};
 
201
 
 
202
if ($opt_e) {
 
203
    $e = $opt_e;
 
204
    $e =~ s@.*/@@;
 
205
    print("encoding $e\n");
 
206
}
 
207
 
 
208
if (!$opt_n && $#ligatures >= 0) {
 
209
    print("ligatures");
 
210
    foreach $lig (@ligatures) {
 
211
        print(" $lig");
 
212
    }
 
213
    print(" 0\n");
 
214
}
 
215
 
 
216
if ($#kern1 >= 0) {
 
217
    print("kernpairs\n");
 
218
    
 
219
    for ($i = 0; $i <= $#kern1; $i++) {
 
220
        $c1 = $kern1[$i];
 
221
        $c2 = $kern2[$i];
 
222
        if ($in_encoding{$c1} == 1 && $nmap{$c1} != 0
 
223
            && $in_encoding{$c2} == 1 && $nmap{$c2} != 0) {
 
224
            for ($j = 0; $j < $nmap{$c1}; $j++) {
 
225
                for ($k = 0; $k < $nmap{$c2}; $k++) {
 
226
                    if ($kernx[$i] != 0) {
 
227
                        printf("%s %s %d\n",
 
228
                               $map{$c1,$j},
 
229
                               $map{$c2,$k},
 
230
                               do conv($kernx[$i]));
 
231
                    }
 
232
                }
 
233
            }
 
234
        }
 
235
    }
 
236
}
 
237
 
 
238
# characters not shorter than asc_boundary are considered to have ascenders
 
239
$asc_boundary = $height{"t"} - 1;
 
240
 
 
241
# likewise for descenders
 
242
$desc_boundary = $depth{"g"};
 
243
$desc_boundary = $depth{"j"} if $depth{"j"} < $desc_boundary;
 
244
$desc_boundary = $depth{"p"} if $depth{"p"} < $desc_boundary;
 
245
$desc_boundary = $depth{"q"} if $depth{"q"} < $desc_boundary;
 
246
$desc_boundary = $depth{"y"} if $depth{"y"} < $desc_boundary;
 
247
$desc_boundary -= 1;
 
248
 
 
249
if (defined $height{"x"}) {
 
250
    $xheight = $height{"x"};
 
251
}
 
252
elsif (defined $height{"alpha"}) {
 
253
    $xheight = $height{"alpha"};
 
254
}
 
255
else {
 
256
    $xheight = 450;
 
257
}
 
258
 
 
259
$italic_angle = $italic_angle*3.14159265358979323846/180.0;
 
260
$slant = sin($italic_angle)/cos($italic_angle);
 
261
$slant = 0 if $slant < 0;
 
262
 
 
263
print("charset\n");
 
264
for ($i = 0; $i < 256; $i++) {
 
265
    $ch = $encoding[$i];
 
266
    if ($ch ne "" && $ch ne "space") {
 
267
        $map{$ch,"0"} = "---" if $nmap{$ch} == 0;
 
268
        $type = 0;
 
269
        $h = $height{$ch};
 
270
        $h = 0 if $h < 0;
 
271
        $d = $depth{$ch};
 
272
        $d = 0 if $d < 0;
 
273
        $type = 1 if $d >= $desc_boundary;
 
274
        $type += 2 if $h >= $asc_boundary;
 
275
        printf("%s\t%d", $map{$ch,"0"}, do conv($width{$ch}));
 
276
        $italic_correction = 0;
 
277
        $left_math_fit = 0;
 
278
        $subscript_correction = 0;
 
279
        if (defined $opt_i) {
 
280
            $italic_correction = $right_side_bearing{$ch} + $opt_i;
 
281
            $italic_correction = 0 if $italic_correction < 0;
 
282
            $subscript_correction = $slant * $xheight * .8;
 
283
            $subscript_correction = $italic_correction if
 
284
                $subscript_correction > $italic_correction;
 
285
            $left_math_fit = $left_side_bearing{$ch} + $opt_i;
 
286
        }
 
287
        if (defined $italic_correction{$ch}) {
 
288
            $italic_correction = $italic_correction{$ch};
 
289
        }
 
290
        if (defined $left_italic_correction{$ch}) {
 
291
            $left_math_fit = $left_italic_correction{$ch};
 
292
        }
 
293
        if (defined $subscript_correction{$ch}) {
 
294
            $subscript_correction = $subscript_correction{$ch};
 
295
        }
 
296
        if ($subscript_correction != 0) {
 
297
            printf(",%d,%d", do conv($h), do conv($d));
 
298
            printf(",%d,%d,%d", do conv($italic_correction),
 
299
                   do conv($left_math_fit),
 
300
                   do conv($subscript_correction));
 
301
        }
 
302
        elsif ($left_math_fit != 0) {
 
303
            printf(",%d,%d", do conv($h), do conv($d));
 
304
            printf(",%d,%d", do conv($italic_correction),
 
305
                   do conv($left_math_fit));
 
306
        }
 
307
        elsif ($italic_correction != 0) {
 
308
            printf(",%d,%d", do conv($h), do conv($d));
 
309
            printf(",%d", do conv($italic_correction));
 
310
        }
 
311
        elsif ($d != 0) {
 
312
            printf(",%d,%d", do conv($h), do conv($d));
 
313
        }
 
314
        else {
 
315
            # always put the height in to stop groff guessing
 
316
            printf(",%d", do conv($h));
 
317
        }
 
318
        printf("\t%d", $type);
 
319
        printf("\t0%03o\t-- %s\n", $i, $ch);
 
320
        for ($j = 1; $j < $nmap{$ch}; $j++) {
 
321
            printf("%s\t\"\n", $map{$ch,$j});
 
322
        }
 
323
    }
 
324
    if ($ch eq "space" && defined $width{"space"}) {
 
325
        printf("space\t%d\t0\t0%03o\n", do conv($width{"space"}), $i);
 
326
    }
 
327
}
 
328
 
 
329
sub conv {
 
330
    $_[0]*$unitwidth*$resolution/(72*1000*$sizescale) + ($_[0] < 0 ? -.5 : .5);
 
331
}