source: git/lib/afm2txf.pl @ 7196714

RELEASE/1.2debug-cidebug-ci-sanitisersstereowalls-data
Last change on this file since 7196714 was 95ed2ba, checked in by Olly Betts <olly@…>, 13 years ago

lib/afm2txf.pl: Fix to correctly handle non-ASCII glyphs by using
glyphshow in the generated PostScript? code rather than relying on the
numeric encoding order of the font to match Unicode (which doesn't
generally seem to be the case). Tweak to process files without
slurping them all into memory where that's easy to do.

git-svn-id: file:///home/survex-svn/survex/trunk@3662 4b37db11-9a0c-4f06-9ece-9ab7cdaee568

  • Property mode set to 100755
File size: 10.3 KB
Line 
1#!/usr/bin/perl -w
2
3# afm2txf.pl 0.2
4#
5# Generates .txf font textures from Type 1 fonts
6# Requirements: Ghostscript, ImageMagick
7#
8# Usage:
9#       afm2txf.pl [-o OUTPUT.txf] whatever.afm
10#
11# Changelog:
12#       0.2 (06/28/2002): Generate fonts with proper padding
13#       0.1 (06/28/2002): Initial version
14#
15# Copyright (C) 2002 Andrew James Ross
16# Copyright (C) 2010,2011 Olly Betts
17#
18# This program is free software; you can redistribute it and/or modify
19# it under the terms of the GNU General Public License version 2 as
20# published by the Free Software Foundation.
21
22use strict;
23
24my $output;
25if (scalar @ARGV >= 1) {
26    my $arg = $ARGV[0];
27    if ($arg =~ s/^-o//) {
28        shift;
29        if ($arg eq '') {
30            if (scalar @ARGV == 0) {
31                die "-o needs an argument\n";
32            }
33            $output = shift;
34        } else {
35            $output = $arg;
36        }
37    }
38}
39
40my $METRICS = shift or die; # AFM file
41
42# Texture size
43my $TEXSIZ = 256;
44
45# Padding around each character, for mipmap separation
46my $PADDING = 4;
47
48# Antialiasing multiplier.  Should be 16 for production work.  As low
49# as 4 works well for testing.
50my $DOWNSAMPLE = 16;
51
52# The printable ISO-8859-1 characters (and space and hard space) and their
53# postscript glyph names.  We use names because not all postscript
54# fonts are encoded using ASCII.  AFM metrics generated by ttf2afm, in
55# fact, don't have any numerical character IDs at all.  In principle,
56# this mechanism will work for any 8 bit font encoding, you just have
57# to do the legwork of figuring out the name to ID mapping.
58my %CHARS = ('space'=>32, 'exclam'=>33, 'quotedbl'=>34,
59             'numbersign'=>35, 'dollar'=>36, 'percent'=>37,
60             'ampersand'=>38, 'quotesingle'=>39, 'parenleft'=>40,
61             'parenright'=>41, 'asterisk'=>42, 'plus'=>43,
62             'comma'=>44, 'hyphen'=>45, 'period'=>46, 'slash'=>47,
63             'zero'=>48, 'one'=>49, 'two'=>50, 'three'=>51,
64             'four'=>52, 'five'=>53, 'six'=>54, 'seven'=>55,
65             'eight'=>56, 'nine'=>57, 'colon'=>58, 'semicolon'=>59,
66             'less'=>60, 'equal'=>61, 'greater'=>62, 'question'=>63,
67             'at'=>64, 'A'=>65, 'B'=>66, 'C'=>67, 'D'=>68, 'E'=>69,
68             'F'=>70, 'G'=>71, 'H'=>72, 'I'=>73, 'J'=>74, 'K'=>75,
69             'L'=>76, 'M'=>77, 'N'=>78, 'O'=>79, 'P'=>80, 'Q'=>81,
70             'R'=>82, 'S'=>83, 'T'=>84, 'U'=>85, 'V'=>86, 'W'=>87,
71             'X'=>88, 'Y'=>89, 'Z'=>90, 'bracketleft'=>91,
72             'backslash'=>92, 'bracketright'=>93, 'asciicircum'=>94,
73             'underscore'=>95, 'quoteleft'=>96, 'a'=>97, 'b'=>98, 'c'=>99,
74             'd'=>100, 'e'=>101, 'f'=>102, 'g'=>103, 'h'=>104,
75             'i'=>105, 'j'=>106, 'k'=>107, 'l'=>108, 'm'=>109,
76             'n'=>110, 'o'=>111, 'p'=>112, 'q'=>113, 'r'=>114,
77             's'=>115, 't'=>116, 'u'=>117, 'v'=>118, 'w'=>119,
78             'x'=>120, 'y'=>121, 'z'=>122, 'braceleft'=>123,
79             'bar'=>124, 'braceright'=>125, 'asciitilde'=>126,
80             'space'=>160, 'exclamdown'=>161, 'cent'=>162, 'sterling'=>163,
81             'currency'=>164, 'yen'=>165, 'brokenbar'=>166, 'section'=>167,
82             'dieresis'=>168, 'copyright'=>169, 'ordfeminine'=>170, 'guillemotleft'=>171,
83             'logicalnot'=>172, 'hyphen'=>173, 'registered'=>174, 'macron'=>175,
84             'degree'=>176, 'plusminus'=>177, 'twosuperior'=>178, 'threesuperior'=>179,
85             'acute'=>180, 'mu'=>181, 'paragraph'=>182, 'bullet'=>183,
86             'cedilla'=>184, 'onesuperior'=>185, 'ordmasculine'=>186, 'guillemotright'=>187,
87             'onequarter'=>188, 'onehalf'=>189, 'threequarters'=>190, 'questiondown'=>191,
88             'Agrave'=>192, 'Aacute'=>193, 'Acircumflex'=>194, 'Atilde'=>195,
89             'Adieresis'=>196, 'Aring'=>197, 'AE'=>198, 'Ccedilla'=>199,
90             'Egrave'=>200, 'Eacute'=>201, 'Ecircumflex'=>202, 'Edieresis'=>203,
91             'Igrave'=>204, 'Iacute'=>205, 'Icircumflex'=>206, 'Idieresis'=>207,
92             'Eth'=>208, 'Ntilde'=>209, 'Ograve'=>210, 'Oacute'=>211,
93             'Ocircumflex'=>212, 'Otilde'=>213, 'Odieresis'=>214, 'multiply'=>215,
94             'Oslash'=>216, 'Ugrave'=>217, 'Uacute'=>218, 'Ucircumflex'=>219,
95             'Udieresis'=>220, 'Yacute'=>221, 'Thorn'=>222, 'germandbls'=>223,
96             'agrave'=>224, 'aacute'=>225, 'acircumflex'=>226, 'atilde'=>227,
97             'adieresis'=>228, 'aring'=>229, 'ae'=>230, 'ccedilla'=>231,
98             'egrave'=>232, 'eacute'=>233, 'ecircumflex'=>234, 'edieresis'=>235,
99             'igrave'=>236, 'iacute'=>237, 'icircumflex'=>238, 'idieresis'=>239,
100             'eth'=>240, 'ntilde'=>241, 'ograve'=>242, 'oacute'=>243,
101             'ocircumflex'=>244, 'otilde'=>245, 'odieresis'=>246, 'divide'=>247,
102             'oslash'=>248, 'ugrave'=>249, 'uacute'=>250, 'ucircumflex'=>251,
103             'udieresis'=>252, 'yacute'=>253, 'thorn'=>254, 'ydieresis'=>255
104             );
105
106my %metrics = ();
107my %positions = ();
108
109#
110# Parse the font metrics.  This is a 5 element array.  All numbers are
111# expressed as a fraction of the line spacing.
112# 0:    nominal width (distance to the next character)
113# 1, 2: Coordinates of the lower left corner of the bounding box,
114#       relative to the nominal position.
115# 3, 4: Size of the bounding box
116#
117print STDERR "Reading font metrics...\n";
118my $FONT;
119open METRICS, '<', $METRICS or die $!;
120my $m;
121while (defined($m = <METRICS>)) {
122    if ($m =~ /^FontName (\S*)/) { $FONT = $1; next; }
123    next unless $m =~ /^C /;
124    chomp $m;
125
126    die "No name: $m" if $m !~ /N\s+([^\s]+)\s+;/;
127    my $name = $1;
128
129    die "No box: $m"
130        if $m !~ /B\s+([-0-9]+)\s+([-0-9]+)\s+([-0-9]+)\s+([-0-9]+)\s+;/;
131    my ($left, $bottom, $right, $top) = ($1/1000, $2/1000, $3/1000, $4/1000);
132
133    die "No width: $m" if $m !~ /WX\s+([-0-9]+)/;
134    my $nomwid = $1/1000; # nominal, not physical width!
135
136    # The coordinates of the corner relative to the character
137    # "position"
138    my ($x, $y) = (-$left, -$bottom);
139    my ($w, $h) = ($right-$left, $top-$bottom);
140
141    $metrics{$name} = [$nomwid, $x, $y, $w, $h];
142}
143close METRICS;
144
145die "No FontName found in metrics" if not defined $FONT;
146
147# Sanitise $FONT.
148$FONT =~ s!/!_!g;
149
150#
151# Find the height of the tallest character, and print some warnings
152#
153my $maxhgt = 0;
154foreach my $c (keys %CHARS) {
155    if(!defined $metrics{$c}) {
156        print STDERR "% WARNING: no metrics for char $c.  Skipping.\n";
157        next;
158    }
159    if($metrics{$c}->[4] > $maxhgt) { $maxhgt = $metrics{$c}->[4]; }
160}
161if($maxhgt == 0) {
162    print STDERR "No usable characters found.  Bailing out.\n";
163    exit 1;
164}
165
166#
167# Do the layout.  Keep increasing the row count until the characters
168# just fit.  This isn't terribly elegant, but it's simple.
169#
170print STDERR "Laying out";
171my $rows = 1;
172my $PS;
173my $LINEHGT;
174while(!defined ($PS = genPostscript($rows))) { $rows++; }
175print STDERR " ($rows rows)\n";
176
177#
178# Call ghostscript to render
179#
180print STDERR "Rendering Postscript...\n";
181my $res = $TEXSIZ * $DOWNSAMPLE;
182my $pid = open PS, "|gs -r$res -g${res}x${res} -sDEVICE=ppm -sOutputFile=\Q$FONT\E.ppm > /dev/null";
183die "Couldn't spawn ghostscript interpreter" if !defined $pid;
184foreach (@$PS) {
185    print PS "$_\n";
186}
187close PS;
188waitpid($pid, 0);
189
190#
191# Downsample with ImageMagick
192#
193print STDERR "Antialiasing image...\n";
194system("mogrify -geometry ${TEXSIZ}x${TEXSIZ} \Q$FONT\E.ppm") == 0
195    or die "Couldn't rescale $FONT.ppm";
196
197#
198# Generate the .txf file
199#
200print STDERR "Generating textured font file...\n";
201
202# Prune undefined glyphs
203foreach my $c (keys %metrics) {
204    delete $metrics{$c} if !defined $CHARS{$c};
205}
206
207sub round { sprintf "%.0f", $_[0] }
208$output = "$FONT.txf" unless defined $output;
209open TXF, '>', $output or die;
210print TXF pack "V", 0x667874ff;
211print TXF pack "V", 0x12345678;
212print TXF pack "V", 0;
213print TXF pack "V", $TEXSIZ;
214print TXF pack "V", $TEXSIZ;
215print TXF pack "V", round($TEXSIZ * $LINEHGT);
216print TXF pack "V", 0;
217print TXF pack "V", scalar(keys(%metrics));
218my @chars = sort { $CHARS{$a} <=> $CHARS{$b} } (keys %metrics);
219foreach my $c (@chars) {
220    my $m = $metrics{$c};
221    my $p = $positions{$c};
222    my $step = round($m->[0] * $LINEHGT * $TEXSIZ);
223
224    # Pad the bounding box, to handle areas that outside.  This can
225    # happen due to thick lines in the font path, or be an artifact of
226    # the downsampling.
227    my $w = round($m->[3] * $LINEHGT * $TEXSIZ + 2*$PADDING);
228    my $h = round($m->[4] * $LINEHGT * $TEXSIZ + 2*$PADDING);
229    my $xoff = -round($m->[1] * $LINEHGT * $TEXSIZ) - $PADDING;
230    my $yoff = -round($m->[2] * $LINEHGT * $TEXSIZ) - $PADDING;
231    my $x = round($p->[0] * $TEXSIZ - $PADDING);
232    my $y = round($p->[1] * $TEXSIZ - $PADDING);
233
234    print TXF pack "v", $CHARS{$c};
235    print TXF pack "C", $w;
236    print TXF pack "C", $h;
237    print TXF pack "c", $xoff;
238    print TXF pack "c", $yoff;
239    print TXF pack "C", $step;
240    print TXF pack "C", 0;
241    print TXF pack "v", $x;
242    print TXF pack "v", $y;
243}
244
245# Read in the .ppm file, dump the duplicate color values (ghostscript
246# won't generate pgm's) and write to the end of the .txf.  Remember to
247# swap the order of the rows; OpenGL textures are bottom-up.
248open PPM, "$FONT.ppm" or die;
249my $pixel;
250foreach my $r (1 .. $TEXSIZ) {
251    seek PPM, -3*$r*$TEXSIZ, 2 or die;
252    foreach (1 .. $TEXSIZ) {
253        read PPM, $pixel, 3 or die;
254        print TXF substr($pixel, 0, 1);
255    }
256}
257close PPM;
258close TXF;
259
260# Clean up
261unlink("$FONT.ppm");
262
263########################################################################
264########################################################################
265########################################################################
266
267sub genPostscript {
268    my $rows = shift;
269    my $rowhgt = 1/$rows;
270
271    my @PS = ();
272
273    # The canonical "point size" number, in texture space
274    $LINEHGT = ($rowhgt - 2*$PADDING/$TEXSIZ) / $maxhgt;
275
276    # Get to where we want.  Draw the whole thing in a 1 inch square at
277    # the bottom left of the "page".
278    push @PS, "72 72 scale";
279
280    # Fill the square with black
281    push @PS, "0 setgray";
282    push @PS, "-1 -1 moveto";
283    push @PS, "-1 1 lineto 1 1 lineto 1 -1 lineto";
284    push @PS, "closepath";
285    push @PS, "fill";
286
287    # Draw in white
288    push @PS, "1 setgray";
289
290    # Generate our PUSH @PS, font
291    push @PS, "/$FONT findfont $LINEHGT scalefont setfont";
292
293    my $x = $PADDING/$TEXSIZ;
294    my $y = 1 - $rowhgt + $PADDING/$TEXSIZ;
295    my @chars = sort { $CHARS{$a} <=> $CHARS{$b} } (keys %CHARS);
296    foreach my $c (@chars) {
297        my $m = $metrics{$c};
298        next if !defined $m;
299
300        # No space?
301        my $w = $m->[3]*$LINEHGT;
302        if($x + $w + $PADDING/$TEXSIZ > 1) {
303            $x = $PADDING/$TEXSIZ;
304            $y -= $rowhgt;
305            return undef if $y < 0;
306        }
307
308        # Record where in the texture the box ended up
309        $positions{$c} = [$x, $y];
310
311        my $vx = $x + $m->[1]*$LINEHGT;
312        my $vy = $y + $m->[2]*$LINEHGT;
313
314        push @PS, "$vx $vy moveto";
315        push @PS, "/$c glyphshow";
316
317        # Next box...
318        $x += $w + 2*$PADDING/$TEXSIZ;
319    }
320
321    push @PS, "showpage";
322
323    return \@PS;
324}
Note: See TracBrowser for help on using the repository browser.