summaryrefslogtreecommitdiff
path: root/language/chinese/CJK/cjk-4.8.5/contrib/wadalab/makeuniwada.pl
diff options
context:
space:
mode:
Diffstat (limited to 'language/chinese/CJK/cjk-4.8.5/contrib/wadalab/makeuniwada.pl')
-rw-r--r--language/chinese/CJK/cjk-4.8.5/contrib/wadalab/makeuniwada.pl333
1 files changed, 333 insertions, 0 deletions
diff --git a/language/chinese/CJK/cjk-4.8.5/contrib/wadalab/makeuniwada.pl b/language/chinese/CJK/cjk-4.8.5/contrib/wadalab/makeuniwada.pl
new file mode 100644
index 0000000000..826ea3d3cb
--- /dev/null
+++ b/language/chinese/CJK/cjk-4.8.5/contrib/wadalab/makeuniwada.pl
@@ -0,0 +1,333 @@
+#! /usr/bin/perl -w
+#
+# 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
+
+# This script creates virtual subfonts in Unicode encoding for Wadalab
+# subfonts. It can merge a JIS X 0208 and JIS X 0212 family into a single
+# set of Unicode subfonts.
+#
+# As prerequisites, it needs the files `JIS0208.TXT' and `JIS0212.TXT' from
+# the `OBSOLETE' directory in the `MAPPINGS' tree on ftp.unicode.org. It
+# also needs the file `DNP.sfd' which gives the relationship between JIS X
+# 0208 (and JIS X 0212) in EUC encoding and wadalab's DNP font encoding.
+# The program `vptovf' must be available (and in the path).
+#
+# Call the script as
+#
+# perl makeuniwada.pl namestem1 [namestem2] uni_namestem
+#
+# `namestem1' is the font in JIS X 0208 encoding. The optional `namestem2'
+# argument is the font in JIS X 0212, and `uni_namestem' holds the prefix
+# for the Unicode subfonts. `makeuniwada.pl' reads all AFM files from the
+# given wadalab font families.
+#
+# Example:
+#
+# perl makeuniwada.pl dmj mc2j udmj
+#
+# This call mixes the mincho-0-12 (dmj) with mincho-1-8 (mc2j) families.
+
+use strict;
+
+my $prog = $0;
+$prog =~ s@.*/@@;
+
+if ($#ARGV < 1 || $#ARGV > 2) {
+ die("usage: $prog namestem1 [namestem2] uni_namestem\n");
+}
+
+my $namestem1;
+my $namestem2;
+my $two_encodings = 0;
+my @args = @ARGV;
+
+$namestem1 = $ARGV[0];
+if ($#ARGV == 2) {
+ $namestem2 = $ARGV[1];
+ $two_encodings = 1;
+ shift;
+}
+my $uninamestem = $ARGV[1];
+
+
+# Read `DNP.sfd'.
+
+my %sfd;
+my @subfonts;
+
+read_sfdfile("DNP.sfd", \%sfd, \@subfonts);
+
+
+# Read encoding files.
+#
+# The files `JIS0208.TXT' and `JIS0212.TXT' are from the `OBSOLETE'
+# directory in the `MAPPINGS' tree on ftp.unicode.org.
+
+my %jisx0208;
+my %jisx0212;
+
+read_encfile("JIS0208.TXT", \%jisx0208, 1);
+if ($two_encodings) {
+ read_encfile("JIS0212.TXT", \%jisx0212, 0);
+}
+
+
+# Read AFM files.
+
+my @unicode;
+
+foreach my $sub (@subfonts) {
+ my $afmname = "$namestem1$sub.afm";
+
+ if (-f $afmname) {
+ read_afmfile($afmname, \@unicode, \%sfd, \%jisx0208, $sub);
+ }
+}
+if ($two_encodings) {
+ foreach my $sub (@subfonts) {
+ my $afmname = "$namestem2$sub.afm";
+
+ if (-f $afmname) {
+ read_afmfile($afmname, \@unicode, \%sfd, \%jisx0212, $sub);
+ }
+ }
+}
+
+
+# Write VPL files.
+
+my $index = 0;
+foreach my $i (0 .. 255) {
+ my @entries;
+
+ foreach my $j (0 .. 255) {
+ if (defined ($unicode[$index])) {
+ push(@entries, "$j $unicode[$index]");
+ }
+ $index++;
+ }
+
+ if ($#entries >= 0) {
+ write_vplfile($uninamestem . sprintf("%02x.vpl", $i), \@entries);
+ }
+}
+
+
+# Generate VF and TFM files, then remove the VPL files.
+
+my @vplfiles = glob("$uninamestem*.vpl");
+foreach my $vplfile (@vplfiles) {
+ print("Processing \`$vplfile'...\n");
+ my $arg = "vptovf $vplfile";
+ system($arg) == 0
+ || die("$prog: calling \`$arg' failed: $?");;
+ print("Removing \`$vplfile'...\n");
+ unlink($vplfile);
+}
+
+
+# Read an SFD file.
+#
+# $1: Name of the SFD file.
+# $2: Reference to the target hash file, mapping from the subfont index
+# to the character code. The format of the hash key 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, $sfdhash, $sfdarray) = @_;
+
+ print("Reading subfont definition file \`$sfdfile'...\n");
+
+ open(SFD, $sfdfile)
+ || die("$prog: can't open \`$sfdfile': $!\n");
+
+ # This loop doesn't handle the complete syntax of SFD files yet.
+ while (<SFD>) {
+ chop;
+ my @field = split(" ");
+ next if ($#field < 0);
+ next if ($field[0] =~ /^#/);
+
+ my $suffix = $field[0];
+ push(@{$sfdarray}, $suffix);
+
+ shift(@field);
+ my $index = 0;
+
+ while (@field) {
+ if ($field[0] =~ /(.*):$/) {
+ $index = $1;
+ }
+ elsif ($field[0] =~ /(0x[0-9A-Fa-f]+)_(0x[0-9A-Fa-f]+)/) {
+ foreach my $i (hex($1) .. hex($2)) {
+ $sfdhash->{"$suffix $index"} = $i;
+ $index++;
+ }
+ }
+ shift(@field);
+ }
+ }
+ close(SFD);
+}
+
+
+# Read encoding file.
+#
+# $1: Name of the encoding file.
+# $2: Reference to the target hash file, mapping from the charset
+# to Unicode.
+# $3: Set to 1 if the needed mapping data is not in field 1 and 2, but in
+# field 2 and 3.
+
+sub read_encfile {
+ my ($encfile, $enchash, $doshift) = @_;
+
+ print("Reading encoding file \`$encfile'...\n");
+
+ open(ENC, $encfile)
+ || die("$prog: can't open \`$encfile': $!\n");
+
+ while (<ENC>) {
+ chop;
+ my @field = split(" ");
+ next if ($#field < 0);
+ next if ($field[0] =~ /^#/);
+
+ if ($doshift) {
+ shift(@field);
+ }
+
+ my $unicode = $field[1];
+ $unicode =~ s/0x//;
+ my $value = hex($field[0]) + 0x8080;
+ $enchash->{$value} = hex($unicode);
+ }
+ close(ENC);
+}
+
+
+# Read AFM file.
+#
+# $1: Name of the AFM file.
+# $2: Reference to the target array which maps from Unicode to the string
+# "<subfont name> <subfont index> <width> <height> <depth>".
+# $3: Reference to the SFD hash (as extracted by `read_sfdfile').
+# $4: Reference to the encoding hash (as extracted by `read_encfile').
+# $5: Suffix.
+
+sub read_afmfile {
+ my ($afmfile, $unicarray, $sfdhash, $enchash, $suffix) = @_;
+
+ print("Reading metric file \`$afmfile'...\n");
+
+ open(AFM, $afmfile)
+ || die("$prog: can't open \`$afmfile': $!\n");
+
+ $afmfile =~ s/\.[^.]*$//;
+ while (<AFM>) {
+ if (/^C (\d+) ;/) {
+ my $key = "$suffix $1";
+ my $value = $sfdhash->{$key};
+ my $unicvalue = $enchash->{$value};
+ my $s = "$afmfile $1";
+
+ # Add advance width.
+ / WX (.*?) ;/;
+ $s .= " $1";
+
+ # Add glyph height and depth.
+ / B .*? (.*?) .*? (.*?) ;/;
+ $s .= " $1 $2";
+
+ $unicarray->[$unicvalue] = $s;
+ }
+ }
+ close(AFM);
+}
+
+
+# Write VPL file.
+#
+# $1: Name of the VPL file.
+# $2: Reference to list which holds the font entries. An entry has the
+# form `<idx> <subfont> <subfont_idx> <adv_width> <height> <depth>'.
+
+sub write_vplfile {
+ my ($vplfile, $glypharray) = @_;
+
+ my %subfonts;
+ my $subcount = 0;
+
+ foreach my $entry (@{$glypharray}) {
+ my @field = split(" ", $entry);
+ my $subfont = $field[1];
+ if (!defined ($subfonts{$subfont})) {
+ $subfonts{$subfont} = $subcount;
+ $subcount++;
+ }
+ }
+
+ print("Writing virtual property list file \`$vplfile'...\n");
+
+ open(VPL, ">", $vplfile)
+ || die("$prog: can't open \`$vplfile': $!\n");
+ my $oldfh = select(VPL);
+
+ print("(VTITLE Created by \`$prog " . join(" ", @args) . "')\n");
+ print("(FAMILY TEX-\U$uninamestem\E)\n");
+ print("(CODINGSCHEME DNPUNICODE)\n");
+ print("(FONTDIMEN\n");
+ print(" (SPACE R 0.5)\n");
+ print(" (XHEIGHT R 0.4)\n");
+ print(" (QUAD R 1)\n");
+ print(" )\n");
+
+ foreach my $subfont
+ (sort { $subfonts{$a} <=> $subfonts{$b} } keys %subfonts) {
+ print("(MAPFONT D $subfonts{$subfont}\n");
+ print(" (FONTNAME $subfont)\n");
+ print(" )\n");
+ }
+
+ foreach my $entry (@{$glypharray}) {
+ my @field = split(" ", $entry);
+ my $index = $field[0];
+ my $subnumber = $subfonts{$field[1]};
+ my $subindex = $field[2];
+ my $adv_width = $field[3] / 1000.0;
+ my $depth = $field[4] / -1000.0;
+ my $height = $field[5] / 1000.0;
+
+ print("(CHARACTER D $index\n");
+ print(" (CHARWD R $adv_width)\n");
+ print(" (CHARHT R $height)\n");
+ print(" (CHARDP R $depth)\n");
+ print(" (MAP\n");
+ print(" (SELECTFONT D $subnumber)\n");
+ print(" (SETCHAR D $subindex)\n");
+ print(" )\n");
+ print(" )\n");
+ }
+
+ close(VPL);
+ select($oldfh);
+}
+
+
+# eof