summaryrefslogtreecommitdiff
path: root/language/chinese/CJK/cjk-4.8.5/utils/subfonts/hlatex2agl.pl
diff options
context:
space:
mode:
Diffstat (limited to 'language/chinese/CJK/cjk-4.8.5/utils/subfonts/hlatex2agl.pl')
-rw-r--r--language/chinese/CJK/cjk-4.8.5/utils/subfonts/hlatex2agl.pl477
1 files changed, 477 insertions, 0 deletions
diff --git a/language/chinese/CJK/cjk-4.8.5/utils/subfonts/hlatex2agl.pl b/language/chinese/CJK/cjk-4.8.5/utils/subfonts/hlatex2agl.pl
new file mode 100644
index 0000000000..d0b0ffea02
--- /dev/null
+++ b/language/chinese/CJK/cjk-4.8.5/utils/subfonts/hlatex2agl.pl
@@ -0,0 +1,477 @@
+#! /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 <wl@gnu.org>
+#
+# 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 (<SFD>) {
+ 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 (<AGL>) {
+ 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 `<suffix1> <idx1>[,<suffix2> <idx2>[,...]]'.
+# $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 (<VPL>) {
+ 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 `<suffix> <index>', 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 (<INFILE>) {
+ # 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 (<INFILE>) {
+ # 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