[fb5791d] | 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: |
---|
[72f37d2] | 9 | # afm2txf.pl [-o OUTPUT.txf] whatever.afm |
---|
[fb5791d] | 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 |
---|
[95ed2ba] | 16 | # Copyright (C) 2010,2011 Olly Betts |
---|
[fb5791d] | 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 | |
---|
| 22 | use strict; |
---|
| 23 | |
---|
[72f37d2] | 24 | my $output; |
---|
| 25 | if (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 | |
---|
[fb5791d] | 40 | my $METRICS = shift or die; # AFM file |
---|
| 41 | |
---|
| 42 | # Texture size |
---|
| 43 | my $TEXSIZ = 256; |
---|
| 44 | |
---|
| 45 | # Padding around each character, for mipmap separation |
---|
| 46 | my $PADDING = 4; |
---|
| 47 | |
---|
| 48 | # Antialiasing multiplier. Should be 16 for production work. As low |
---|
| 49 | # as 4 works well for testing. |
---|
| 50 | my $DOWNSAMPLE = 16; |
---|
| 51 | |
---|
[1dafcb8] | 52 | # The printable ISO-8859-1 characters (and space and hard space) and their |
---|
[fb5791d] | 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. |
---|
| 58 | my %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, |
---|
[9ce6a65] | 73 | 'underscore'=>95, 'quoteleft'=>96, 'a'=>97, 'b'=>98, 'c'=>99, |
---|
[fb5791d] | 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, |
---|
[1dafcb8] | 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 | ); |
---|
[fb5791d] | 105 | |
---|
| 106 | my %metrics = (); |
---|
| 107 | my %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 | # |
---|
| 117 | print STDERR "Reading font metrics...\n"; |
---|
| 118 | my $FONT; |
---|
[95ed2ba] | 119 | open METRICS, '<', $METRICS or die $!; |
---|
| 120 | my $m; |
---|
| 121 | while (defined($m = <METRICS>)) { |
---|
| 122 | if ($m =~ /^FontName (\S*)/) { $FONT = $1; next; } |
---|
| 123 | next unless $m =~ /^C /; |
---|
[fb5791d] | 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); |
---|
[845fac6] | 140 | |
---|
[fb5791d] | 141 | $metrics{$name} = [$nomwid, $x, $y, $w, $h]; |
---|
| 142 | } |
---|
[95ed2ba] | 143 | close METRICS; |
---|
[fb5791d] | 144 | |
---|
| 145 | die "No FontName found in metrics" if not defined $FONT; |
---|
| 146 | |
---|
[7c7cffd] | 147 | # Sanitise $FONT. |
---|
| 148 | $FONT =~ s!/!_!g; |
---|
| 149 | |
---|
[fb5791d] | 150 | # |
---|
| 151 | # Find the height of the tallest character, and print some warnings |
---|
| 152 | # |
---|
| 153 | my $maxhgt = 0; |
---|
| 154 | foreach my $c (keys %CHARS) { |
---|
| 155 | if(!defined $metrics{$c}) { |
---|
[845fac6] | 156 | print STDERR "% WARNING: no metrics for char $c. Skipping.\n"; |
---|
[fb5791d] | 157 | next; |
---|
| 158 | } |
---|
| 159 | if($metrics{$c}->[4] > $maxhgt) { $maxhgt = $metrics{$c}->[4]; } |
---|
| 160 | } |
---|
| 161 | if($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 | # |
---|
| 170 | print STDERR "Laying out"; |
---|
| 171 | my $rows = 1; |
---|
| 172 | my $PS; |
---|
| 173 | my $LINEHGT; |
---|
| 174 | while(!defined ($PS = genPostscript($rows))) { $rows++; } |
---|
| 175 | print STDERR " ($rows rows)\n"; |
---|
| 176 | |
---|
| 177 | # |
---|
| 178 | # Call ghostscript to render |
---|
| 179 | # |
---|
| 180 | print STDERR "Rendering Postscript...\n"; |
---|
| 181 | my $res = $TEXSIZ * $DOWNSAMPLE; |
---|
[233995e] | 182 | my $pid = open PS, "|gs -r$res -g${res}x${res} -sDEVICE=ppm -sOutputFile=\Q$FONT\E.ppm > /dev/null"; |
---|
[fb5791d] | 183 | die "Couldn't spawn ghostscript interpreter" if !defined $pid; |
---|
[95ed2ba] | 184 | foreach (@$PS) { |
---|
| 185 | print PS "$_\n"; |
---|
| 186 | } |
---|
[fb5791d] | 187 | close PS; |
---|
| 188 | waitpid($pid, 0); |
---|
| 189 | |
---|
| 190 | # |
---|
| 191 | # Downsample with ImageMagick |
---|
| 192 | # |
---|
| 193 | print STDERR "Antialiasing image...\n"; |
---|
[233995e] | 194 | system("mogrify -geometry ${TEXSIZ}x${TEXSIZ} \Q$FONT\E.ppm") == 0 |
---|
[fb5791d] | 195 | or die "Couldn't rescale $FONT.ppm"; |
---|
| 196 | |
---|
| 197 | # |
---|
| 198 | # Generate the .txf file |
---|
| 199 | # |
---|
| 200 | print STDERR "Generating textured font file...\n"; |
---|
| 201 | |
---|
| 202 | # Prune undefined glyphs |
---|
| 203 | foreach my $c (keys %metrics) { |
---|
| 204 | delete $metrics{$c} if !defined $CHARS{$c}; |
---|
| 205 | } |
---|
| 206 | |
---|
| 207 | sub round { sprintf "%.0f", $_[0] } |
---|
[72f37d2] | 208 | $output = "$FONT.txf" unless defined $output; |
---|
| 209 | open TXF, '>', $output or die; |
---|
[fb5791d] | 210 | print TXF pack "V", 0x667874ff; |
---|
| 211 | print TXF pack "V", 0x12345678; |
---|
| 212 | print TXF pack "V", 0; |
---|
| 213 | print TXF pack "V", $TEXSIZ; |
---|
| 214 | print TXF pack "V", $TEXSIZ; |
---|
| 215 | print TXF pack "V", round($TEXSIZ * $LINEHGT); |
---|
| 216 | print TXF pack "V", 0; |
---|
| 217 | print TXF pack "V", scalar(keys(%metrics)); |
---|
| 218 | my @chars = sort { $CHARS{$a} <=> $CHARS{$b} } (keys %metrics); |
---|
| 219 | foreach 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); |
---|
[46cd512] | 229 | my $xoff = -round($m->[1] * $LINEHGT * $TEXSIZ) - $PADDING; |
---|
| 230 | my $yoff = -round($m->[2] * $LINEHGT * $TEXSIZ) - $PADDING; |
---|
[fb5791d] | 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. |
---|
| 248 | open PPM, "$FONT.ppm" or die; |
---|
| 249 | my $pixel; |
---|
[95ed2ba] | 250 | foreach my $r (1 .. $TEXSIZ) { |
---|
| 251 | seek PPM, -3*$r*$TEXSIZ, 2 or die; |
---|
| 252 | foreach (1 .. $TEXSIZ) { |
---|
[fb5791d] | 253 | read PPM, $pixel, 3 or die; |
---|
[95ed2ba] | 254 | print TXF substr($pixel, 0, 1); |
---|
[fb5791d] | 255 | } |
---|
| 256 | } |
---|
| 257 | close PPM; |
---|
| 258 | close TXF; |
---|
| 259 | |
---|
| 260 | # Clean up |
---|
[7c7cffd] | 261 | unlink("$FONT.ppm"); |
---|
[fb5791d] | 262 | |
---|
| 263 | ######################################################################## |
---|
| 264 | ######################################################################## |
---|
| 265 | ######################################################################## |
---|
| 266 | |
---|
| 267 | sub genPostscript { |
---|
| 268 | my $rows = shift; |
---|
| 269 | my $rowhgt = 1/$rows; |
---|
| 270 | |
---|
| 271 | my @PS = (); |
---|
[845fac6] | 272 | |
---|
[fb5791d] | 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"; |
---|
[845fac6] | 279 | |
---|
[fb5791d] | 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"; |
---|
[845fac6] | 289 | |
---|
[fb5791d] | 290 | # Generate our PUSH @PS, font |
---|
| 291 | push @PS, "/$FONT findfont $LINEHGT scalefont setfont"; |
---|
[845fac6] | 292 | |
---|
[fb5791d] | 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; |
---|
[845fac6] | 313 | |
---|
[fb5791d] | 314 | push @PS, "$vx $vy moveto"; |
---|
[95ed2ba] | 315 | push @PS, "/$c glyphshow"; |
---|
[845fac6] | 316 | |
---|
[fb5791d] | 317 | # Next box... |
---|
| 318 | $x += $w + 2*$PADDING/$TEXSIZ; |
---|
| 319 | } |
---|
[845fac6] | 320 | |
---|
[fb5791d] | 321 | push @PS, "showpage"; |
---|
| 322 | |
---|
| 323 | return \@PS; |
---|
| 324 | } |
---|