#! /usr/bin/perl -w # # This script adds AGL compliant glyph names to fonts from the HLaTeX # package version 0.97 or newer. Note that only glyphs actually used in the # (virtual) HLaTeX subfonts get new names; additionally, the used glyph # shapes in the HLaTeX fonts aren't always correct -- consider this script # as an auxiliary means, not a definitive solution. At least the Hangul and # Hanja shapes are correct. # # As prerequisites, it needs the programs `t1asm' and `t1disasm' (from the # t1utils package) and `vftovp' which must be in the path. The subfont # definition file `UKS-HLaTeX.sfd' (from the ttf2pk package) and the file # # http://partners.adobe.com/public/developer/en/opentype/aglfn13.txt # # are necessary also. # # Call the script as # # perl hlatex2agl.pl virtual-namestem real-namestem sfd-file # # `virtual-namestem' specifies the name stem of the virtual subfonts # directly used by LaTeX; both the VF and TFM files are needed. # `real-namestem' gives the name stem of the real subfonts used by the # virtual fonts; TFM, AFM, and PFB files are needed. # # Example: # # perl hlatex2agl.pl wmj umj UKS-HLaTeX.sfd # Copyright (C) 1994-2021 Werner Lemberg # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program in doc/COPYING; if not, write to the Free # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, # MA 02110-1301 USA use strict; my $prog = $0; $prog =~ s@.*/@@; if ($#ARGV != 2) { die("usage: $prog virtual-namestem real-namestem sfd-file\n"); } my $virtnamestem = $ARGV[0]; my $realnamestem = $ARGV[1]; my $sfdfile = $ARGV[2]; # Read UKS-HLaTeX.sfd. my @sfd; my @virtsubfonts; read_sfdfile($sfdfile, \@sfd, \@virtsubfonts); # Read AGL file. my %agl; read_aglfile("aglfn13.txt", \%agl); # Read VF files. my %vpl; my %subfonts; for my $suffix (@virtsubfonts) { read_vffile("$virtnamestem$suffix.vf", $suffix, \%vpl, \%subfonts); } # Decompose all Hangul syllables. my @hangul; decompose_hangul(\@hangul); # Build glyph names. my %names; build_glyphnames(\%names); # Process AFM files. foreach my $suffix (sort (keys %subfonts)) { process_afmfile("$realnamestem$suffix.afm", $suffix); } # Process PFB files. foreach my $suffix (sort (keys %subfonts)) { process_pfbfile("$realnamestem$suffix.pfb", $suffix); } # Read an SFD file. # # $1: Name of the SFD file. # $2: Reference to the target array, mapping from Unicode to the subfont. # The format of the array values is the concatenation of the subfont # suffix, a space, and the index. # $3: Reference to a target array which holds the subfont suffixes. sub read_sfdfile { my ($sfdfile, $sfdarray, $subarray) = @_; print("Reading subfont definition file \`$sfdfile'...\n"); open(SFD, $sfdfile) || die("$prog: can't open \`$sfdfile': $!\n"); my $line; my $continuation = 0; while () { chop; next if /^\s*$/; next if /^#/; if ($continuation) { $line .= $_; } else { $line = $_; } $continuation = 0; if ($line =~ s/\\$//) { $continuation = 1; next; } $_ = $line; my @field = split(" "); my $suffix = $field[0]; push(@{$subarray}, $suffix); shift(@field); my $index = 0; while (@field) { if ($field[0] =~ /(.*):$/) { $index = $1; } elsif ($field[0] =~ /(.*)_(.*)/) { my $start = $1; my $end = $2; $start = oct($start) if ($start =~ /^0/); $end = oct($end) if ($end =~ /^0/); foreach my $i ($start .. $end) { $sfdarray->[$i] = "$suffix $index"; $index++; } } else { my $value = $field[0]; $value = oct($value) if ($value =~ /^0/); $sfdarray->[$value] = "$suffix $index"; $index++; } shift(@field); } } close(SFD); } # Read an AGL file. # # $1: Name of the AGL file. # $2: Reference to the target hash file, mapping from the Unicode value # to the glyph name. sub read_aglfile { my ($aglfile, $aglhash) = @_; print("Reading Adobe Glyph List file \`$aglfile'...\n"); open(AGL, $aglfile) || die("$prog: can't open \`$aglfile': $!\n"); while () { chop; next if /^\s*$/; next if /^#/; my @field = split(";"); $aglhash->{hex($field[0])} = $field[1]; } close(AGL); } # Read a VF file. # # $1: Name of the VF file. # $2: Subfont suffix. # $3: Reference to a target hash, mapping from the virtual subfont to the # real subfonts. The format of the key is the concatenation of the # subfont suffix, a space, and the index. The format of the hash value # is ` [, [,...]]'. # $4: Reference to a target hash, collecting the suffixes of the real # subfonts. sub read_vffile { my ($vffile, $vfsuffix, $vplhash, $subfonthash) = @_; my $vplfile = "$vffile.vpl"; print("Creating virtual property list file \`$vplfile'...\n"); my $arg = "vftovp -charcode-format=octal $vffile > $vplfile"; system("$arg") == 0 || die("$prog: calling \`$arg' failed: $?"); print("Reading \`$vplfile'...\n"); open(VPL, $vplfile) || die("$prog: can't open \`$vplfile': $!\n"); my @subfonts; my $subindex; my $index; my $currfont; my $map = ""; while () { if (/\(MAPFONT D ([0-9]+)/) { $subindex = $1; } elsif (/\(FONTNAME $realnamestem(.*?)\)/) { $subfonts[$subindex] = $1; if (!defined ($subfonthash->{$1})) { $subfonthash->{$1} = 1; } } elsif (/\(CHARACTER O ([0-7]+)/) { # Save data from previous CHARACTER block. $vplhash->{"$vfsuffix $index"} = $map if ($map); # Reset variables. $index = oct($1); $currfont = 0; $map = ""; } elsif (/\(SELECTFONT D ([0-9]+)\)/) { $currfont = $1; } elsif (/\(SETCHAR O ([0-7]+)\)/) { $map .= "," if ($map); $map .= "$subfonts[$currfont] " . oct($1); } } # Save data from last CHARACTER block. $vplhash->{"$vfsuffix $index"} = $map if ($map); close(VPL); unlink($vplfile); } # Decompose all Unicode Hangul syllables into Jamo elements. # # $1: The target array, mapping from Unicode value to a list of Jamos (in # Unicode), separated by commata. # # This follows the algorithm given in the Unicode standard. sub decompose_hangul { my ($hangularray) = @_; my $s_base = 0xAC00; my $l_base = 0x1100; my $v_base = 0x1161; my $t_base = 0x11A7; my $s_count = 11172; my $l_count = 19; my $v_count = 21; my $t_count = 28; my $n_count = $v_count * $t_count; for my $s ($s_base .. ($s_base + $s_count - 1)) { my $s_index = $s - $s_base; my $l = $l_base + int($s_index / $n_count); my $v = $v_base + int(($s_index % $n_count) / $t_count); my $t = $t_base + $s_index % $t_count; my $jamos = "$l,$v"; $jamos .= ",$t" if ($t != $t_base); $hangularray->[$s] = $jamos; } } # Build glyph names. # # $1: The target hash which maps from real subfonts to glyph names. Keys # are of the form ` ', hash values are AGL compliant # glyph names. Glyph variants get a trailing suffix of the form `.N', # where is is a running number starting with 1. Example: `uni1100.24'. sub build_glyphnames { my ($nameshash) = @_; my @entries; foreach my $unicode (0 .. 0xFFFF) { next if !defined ($sfd[$unicode]); my $virtdata = $sfd[$unicode]; # We assume that only Hangul syllables are composed of more than # a single element. if (defined ($hangul[$unicode])) { my @unijamos = split(",", $hangul[$unicode]); my @jamos = split(",", $vpl{$virtdata}); foreach my $i (0 .. $#jamos) { if (!defined ($nameshash->{$jamos[$i]})) { if (defined ($entries[$unijamos[$i]])) { $nameshash->{$jamos[$i]} = sprintf("uni%04X.%d", $unijamos[$i], $entries[$unijamos[$i]]); $entries[$unijamos[$i]] += 1; } else { $nameshash->{$jamos[$i]} = sprintf("uni%04X", $unijamos[$i]); $entries[$unijamos[$i]] = 1; } } } } else { if (defined ($agl{$unicode})) { $nameshash->{$vpl{$virtdata}} = $agl{$unicode}; } else { $nameshash->{$vpl{$virtdata}} = sprintf("uni%04X", $unicode); } } } } # Process AFM file. # # $1: Name of the AFM file to process. The file is first saved, then all # glyph names are replaced for which an AGL compliant glyph name is # known. # $2: The suffix. sub process_afmfile { my ($afmfile, $sub) = @_; print("Processing \`$afmfile'...\n"); if (!-f $afmfile) { die("$prog: \`$afmfile' doesn't exist\n"); } rename($afmfile, "$afmfile.old"); open(INFILE, "$afmfile.old") || die("$prog: can't open \`$afmfile.old': $!\n"); open(OUTFILE, ">", "$afmfile") || die("$prog: can't open \`$afmfile': $!\n"); while () { # Replace the `kxx' entries. if (/ N k(.*?) ;/) { my $index = hex($1); if (defined ($names{"$sub $index"})) { s/ N .*? ;/ N $names{"$sub $index"} ;/; } } # Update version number. s/001\.000/001.001/; s/Altsys\ Fontographer\ 4\.1\ 1\/10\/95$/001.001/; print(OUTFILE $_); # Add comment. if (/^Comment\ UniqueID/ || /^Comment\ Generated/) { print(OUTFILE "Comment AGL compliant glyph names added " . "by script $prog 2005-Jul-27.\n"); } } close(INFILE); close(OUTFILE); } # Process PFB file. # # $1: Name of the PFB file to process. The file is first saved, then all # glyph names are replaced for which an AGL compliant glyph name is # known. # $2: The suffix. sub process_pfbfile { my ($pfbfile, $sub) = @_; my $arg; print("Processing \`$pfbfile'...\n"); if (!-f $pfbfile) { die("$prog: \`$pfbfile' doesn't exist\n"); } rename($pfbfile, "$pfbfile.old"); $arg = "t1disasm < $pfbfile.old > $pfbfile.disasm.old"; system("$arg") == 0 || die("$prog: calling \`$arg' failed: $?"); open(INFILE, "$pfbfile.disasm.old") || die("$prog: can't open \`$pfbfile.disasm.old': $!\n"); open(OUTFILE, ">", "$pfbfile.disasm") || die("$prog: can't open \`$pfbfile.disasm': $!\n"); while () { # Replace the `kxx' entries. if (m@/k(.*?) @) { my $index = hex($1); if (defined ($names{"$sub $index"})) { s@/k.*? @/$names{"$sub $index"} @; } } # Update version number. s/001\.000/001.001/; print(OUTFILE $_); # Add comment. if (/^%%CreationDate/) { print(OUTFILE "% AGL compliant glyph names added " . "by script $prog 2005-Jul-27.\n"); } } close(INFILE); close(OUTFILE); $arg = "t1asm < $pfbfile.disasm > $pfbfile"; system("$arg") == 0 || die("$prog: calling \`$arg' failed: $?"); unlink("$pfbfile.disasm.old", "$pfbfile.disasm"); } # eof