6 # The glyps list can be downloaded from
7 # http://partners.adobe.com/asn/developer/type/glyphlist.txt
8 # This URL is from this page:
9 # http://partners.adobe.com/asn/developer/type/unicodegn.html
10 # which is refered from
11 # http://partners.adobe.com/asn/developer/technotes/fonts.html
13 my $onlyHelvetica = 0;
15 my %globalName2Unicode;
20 my $indent2 = $indent1 x 3;
27 my $fn ="glyphlist.txt";
29 || die "Can't read $fn\n";
33 next unless /^([0-9A-F]{4});(\w+);/;
34 my $unicode = 0 + hex($1);
36 next if ($globalName2Unicode{$name});
37 $globalName2Unicode{$name} = $unicode;
46 $wc = "Helvetica.afm" if $onlyHelvetica;
47 $wc = "ZapfDin.afm" if 0;
48 $wc = "Helve*.afm" if 0;
49 $wc = "Times-BoldItalic.afm" if 0;
50 foreach my $fn (glob("$dir/$wc")) {
58 print STDERR "Compiling afm file: $fn\n";
59 my %fi = (); # font info
63 $fi{FontSpecificUnicodeNameToChar} = {};
65 $fi{filename} =~ s/.*\///;
68 open(FH, $fn) || die "Can't open $fn\n";
69 print STDERR "Reads global font info\n" if $q;
72 next if /^\s*$/ || /^\s*#/;
73 $fi{Ascender} = $1 if /^Ascender\s+(-?\d+)/;
74 $fi{Descender} = $1 if /^Descender\s+(-?\d+)/;
75 last if /^StartCharMetrics/;
76 next unless (/^(\S+)\s+(\S(.*\S)?)/);
80 $fi{"Afm$id"} = $value;
82 my $fontName = $fi{AfmFontName};
83 $c .= "\n\n/* ". ("-" x 66) . "*/\n";
84 $c .= "/* FontName: $fontName */\n";
85 $c .= "/* FullName: $fi{AfmFullName} */\n";
86 $c .= "/* FamilyName: $fi{AfmFamilyName} */\n";
87 $fi{cName} = $fontName;
88 $fi{cName} =~ s/\W/_/g;
91 read_charmetrics(\%fi, \%charMetrics);
93 read_kerning(\%fi, \%kerning) if /^StartKernPairs/;
96 my @names = keys %charMetrics;
97 print STDERR "Did read ", ($#names + 1), " font metrics\n";
99 write_font(\%fi, \%charMetrics, \%kerning);
104 my ($fiR, $charMetricsR) = @_;
105 print STDERR "Reads char metric info\n" if $q;
106 my $isZapfDingbats = $$fiR{AfmFontName} eq "ZapfDingbats";
107 my $ligaturesR = $$fiR{ligaturesR};
109 my %seenUnicodes = ();
112 next if /^\s*$/ || /^\s*#/;
113 last if /^EndCharMetrics/;
114 #next unless /N S / || /N comma /;
115 #next unless /N ([sfil]|fi) /;
118 # C 102 ; WX 333 ; N f ; B -169 -205 446 698 ; L i fi ; L l fl ;
119 my ($width, $unicode, $name, @charLigatures);
120 foreach (split/\s*;\s*/, $line) {
121 if (/^C\s+(-?\d+)/) {
123 } elsif (/^N\s+(\w+)/) {
125 } elsif (/^WX?\s+(-?\d+)/) {
126 $width = normalize_width($1, 0);
127 } elsif (/^L\s+(\w+)\s+(\w+)/) {
128 push(@charLigatures, $1, $2);
132 unless (defined $name) {
133 print STDERR "Glyph missing name and code: $_\n";
136 $unicode = name2uni($fiR, $name);
137 print STDERR "name2uni: $name -> $unicode\n" if $qU && 0;
138 } elsif (defined $name) {
139 my $std = $globalName2Unicode{$name};
141 print STDERR "Adds unicode mapping: ",
142 "$name -> $unicode\n" if $qU;
143 ${$$fiR{FontSpecificUnicodeNameToChar}}{$name} = $unicode;
148 if (!defined($unicode) || $unicode <= 0) {
149 next if $isZapfDingbats && $name =~ /^a(\d+)$/;
150 next if $$fiR{AfmFontName} eq "Symbol" && $name eq "apple";
151 print STDERR "Glyph '$name' has unknown unicode: $_\n";
154 unless (defined $width) {
155 print STDERR "Glyph '$name' missing width: $_\n";
158 if ($seenUnicodes{$unicode}) {
159 print STDERR "Duplicate character: unicode = $unicode, ",
160 "$name and ", $seenUnicodes{$unicode},
161 " (might be due to Adobe charset remapping)\n";
164 $seenUnicodes{$unicode} = $name;
167 $c{unicode} = $unicode;
169 $$charMetricsR{$unicode} = \%c;
170 $ligatures{$unicode} = \@charLigatures if $#charLigatures >= 0;
172 foreach my $unicode (keys %ligatures) {
173 my $aR = $ligatures{$unicode};
174 my $unicode2 = name2uni($fiR, $$aR[0]);
175 my $unicode3 = name2uni($fiR, $$aR[1]);
177 print STDERR "Missing ligature char 1: $$aR[0]\n";
181 print STDERR "Missing ligature char 2: $$aR[1]\n";
184 my $key = sprintf("%04d;%04d", $unicode, $unicode2);
185 $$ligaturesR{$key} = $unicode3;
191 my ($fiR, $name) = @_;
192 my $fontMapR = $$fiR{FontSpecificUnicodeNameToChar};
193 return $globalName2Unicode{$name} || $$fontMapR{$name};
198 my ($fiR, $kerningR) = @_;
199 print STDERR "Reads kerning info\n" if $q;
202 next if /^\s*$/ || /^\s*#/;
203 last if /^EndKernPairs/;
204 unless (/^KPX\s+(\w+)\s+(\w+)\s+(-?\d+)\s*$/) {
205 print STDERR "Can't parse kern spec: $_\n";
210 my $delta = normalize_width($3, 1);
212 my $unicode1 = name2uni($fiR, $name1);
213 my $unicode2 = name2uni($fiR, $name2);
214 unless ($unicode1 && $unicode2) {
215 print "Unknown kern pair: $name1 and $name2\n";
218 my $charR = $$kerningR{$unicode1};
219 unless (defined $charR) {
222 $$kerningR{$unicode1} = $charR;
224 $$charR{$unicode2} = $delta;
230 my ($fiR, $charMetricsR, $kerningR) = @_;
231 print STDERR "Writes font\n" if $q;
233 $$fiR{widthsA} = make_array();
234 $$fiR{kerning_indexA} = make_array();
235 $$fiR{kerning_dataA} = make_array();
236 $$fiR{highchars_indexA} = make_array();
237 $$fiR{ligaturesA} = make_array();
238 write_font_metrics($fiR, $charMetricsR, $kerningR);
239 write_ligatures($fiR);
240 my $widths_count = array_size($$fiR{widthsA});
241 my $kerning_index_count = array_size($$fiR{kerning_indexA});
242 my $kerning_data_count = array_size($$fiR{kerning_dataA});
243 my $highchars_count = array_size($$fiR{highchars_indexA});
244 my $ligatures_count = array_size($$fiR{ligaturesA}) / 3;
247 my $packedSize = $widths_count + 2 * $kerning_index_count +
248 $kerning_data_count + 2 * $highchars_count +
249 3 * 2 * $ligatures_count;
250 $info_code .= $indent1 . "{ /* $$fiR{filename} $packedSize bytes */\n";
251 $info_code .= $i2 . "\"$$fiR{AfmFontName}\", \"$$fiR{AfmFullName}\",\n";
252 $info_code .= $i2 . $$fiR{Ascender} . ", " . $$fiR{Descender} . ",\n";
253 $info_code .= $i2 . $$fiR{widthsACName} . ",\n";
254 $info_code .= $i2 . $$fiR{kerning_indexACName} . ",\n";
255 $info_code .= $i2 . $$fiR{kerning_dataACName} . ",\n";
256 $info_code .= $i2 . $$fiR{highchars_indexACName} . ", ";
257 $info_code .= $highchars_count . ",\n";
258 $info_code .= $i2 . $$fiR{ligaturesACName} . ", ";
259 $info_code .= $ligatures_count;
260 $info_code .= "},\n";
261 $font_code{$$fiR{AfmFullName}} = { TABLES => $$cR, INFO => $info_code};
264 sub write_font_metrics
266 my ($fiR, $charMetricsR, $kerningR) = @_;
267 print STDERR "Writes font metrics\n" if $q;
268 my $lastUnicode = 31;
270 my $widthsA = $$fiR{widthsA};
271 my $kerning_indexA = $$fiR{kerning_indexA};
272 my $kerning_dataA = $$fiR{kerning_dataA};
273 my $highchars_indexA = $$fiR{highchars_indexA};
274 my @uniArray = sort { $a <=> $b } keys %$charMetricsR;
275 my $highchars_count = 0;
279 if ($#uniArray < 0) {
280 last if $lastUnicode > 126;
282 } elsif ($lastUnicode < 126 && $uniArray[0] > $lastUnicode + 1) {
287 #print STDERR "fill for $lastUnicode, $#uniArray, $uniArray[0]\n";
288 append_to_array($widthsA, 0);
289 append_to_array($kerning_indexA, 0);
292 my $unicode = shift @uniArray;
293 next if $unicode < 32;
294 $lastUnicode = $unicode;
295 my $metricsR = $$charMetricsR{$unicode};
296 if ($unicode > 126) {
297 append_to_array($highchars_indexA, $unicode);
300 my $m = $$metricsR{width};
301 $m = "/* ".array_size($widthsA)."=$unicode */". $m if 0;
302 append_to_array($widthsA, $m);
303 my $kerningInfoR = $$kerningR{$unicode};
304 my $kerning_index = 0;
305 if (defined $kerningInfoR) {
308 foreach my $unicode2 (sort { $a <=> $b } keys %$kerningInfoR) {
309 my $delta = $$kerningInfoR{$unicode2};
311 append_escaped_16bit_int(\@kerns, $unicode2);
312 push(@kerns, $delta);
315 $kerning_index = append_8bit_subarray($kerning_dataA, $numKernings, @kerns);
317 append_to_array($kerning_indexA, $kerning_index);
319 $$fiR{kerning_indexA} = make_array() if !$had_kerning;
320 write_array($fiR, "widths", "afm_cuint8");
321 write_array($fiR, "kerning_index", "afm_sint16");
322 write_array($fiR, "kerning_data", "afm_cuint8");
323 write_array($fiR, "highchars_index", "afm_cuint16");
329 print STDERR "Writes font ligatures\n" if $q;
330 my $ligaturesA = $$fiR{ligaturesA};
331 my $ligaturesR = $$fiR{ligaturesR};
332 foreach (sort keys %$ligaturesR) {
333 unless (/^(\w{4});(\w{4})$/) {
334 die "Invalid ligature key: $_";
336 append_to_array($ligaturesA, $1 + 0, $2 + 0, $$ligaturesR{$_});
338 write_array($fiR, "ligatures", "afm_cunicode");
355 my ($aR, @newElements) = @_;
356 my $z1 = array_size($aR);
357 push(@$aR, @newElements);
358 my $z2 = array_size($aR);
359 my $zz = $#newElements +1;
362 sub append_8bit_subarray
364 my ($aR, $numItems, @newElements) = @_;
365 push(@$aR, 42) if !array_size($aR); # initial dummy value
366 die if $numItems > $#newElements + 1;
367 my $idx = $#{$aR} + 1;
368 #print "append_8bit_subarray ", ($#newElements+1), " = (", join(", ", @newElements), ") -> $idx\n";
369 append_escaped_16bit_int($aR, $numItems);
370 push(@$aR, @newElements);
371 die "Can't handle that big sub array, sorry...\n" if $idx > 50000;
375 sub append_escaped_16bit_int
377 my ($aR, $count) = @_;
378 die "Invalid count = 0\n" unless $count;
380 push(@$aR, 1, int($count / 256), int($count % 256));
381 print STDERR "full: $count\n" if 0;
382 } elsif ($count >= 254) {
383 push(@$aR, 0, $count - 254);
384 print STDERR "semi: $count\n" if 0;
386 push(@$aR, $count + 1);
398 my ($fiR, $name, $type) = @_;
399 my $aR = $$fiR{$name."A"};
400 my $cName = $$fiR{cName};
401 my $num = $#{$aR} + 1;
402 my $array_name_key = $name."ACName";
404 $$fiR{$array_name_key} = "NULL";
408 my $array_name = "afm_" . $cName . "_" . $name;
409 $$fiR{$array_name_key} = $array_name;
410 $$cR .= "static $type $array_name" . "[] = { /* $num */\n";
412 for (my $i = 0; $i < $num; $i++) {
413 $line .= "," if $i > 0;
414 if (length($line) > 65) {
428 my ($w, $signed) = @_;
429 my $n = int(($w + 3) / 6);
431 $n = -128 if $n < -128;
432 $n = 127 if $n > 127;
433 $n = 256 + $n if $n < 0; # make unsigned.
436 $n = 255 if $n > 255;
443 my $cfn = "../../src/rrd_afm_data.c";
446 my @fonts = sort keys %font_code;
447 unless ($#fonts >= 0) {
448 die "You must have at least 1 font.\n";
450 open(CFILE, ">$cfn") || die "Can't create $cfn\n";
451 print CFILE header($cfn);
452 print CFILE ${$font_code{$_}}{TABLES} foreach @fonts;
453 print CFILE "const afm_fontinfo afm_fontinfolist[] = {\n";
454 print CFILE ${$font_code{$_}}{INFO} foreach @fonts;
455 print CFILE $indent1 . "{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }\n";
456 print CFILE $indent0 . "};\n";
457 print CFILE $indent0 . "const int afm_fontinfo_count = ",
458 ($#fonts + 1), ";\n";
460 print STDERR "Compiled ", ($#fonts+1), " fonts.\n";
470 /****************************************************************************
471 * RRDtool 1.1.x Copyright Tobias Oetiker, 1997 - 2002
472 ****************************************************************************
473 * $fn Encoded afm (Adobe Font Metrics) for selected fonts.
474 ****************************************************************************
476 * THIS FILE IS AUTOGENERATED BY PERL. DO NOT EDIT.
478 ****************************************************************************/