From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- .../CJK/cjk-4.8.4/utils/subfonts/sfd2uni.pl | 348 +++++++++++++++++++++ 1 file changed, 348 insertions(+) create mode 100644 language/chinese/CJK/cjk-4.8.4/utils/subfonts/sfd2uni.pl (limited to 'language/chinese/CJK/cjk-4.8.4/utils/subfonts/sfd2uni.pl') diff --git a/language/chinese/CJK/cjk-4.8.4/utils/subfonts/sfd2uni.pl b/language/chinese/CJK/cjk-4.8.4/utils/subfonts/sfd2uni.pl new file mode 100644 index 0000000000..a82a3cb10f --- /dev/null +++ b/language/chinese/CJK/cjk-4.8.4/utils/subfonts/sfd2uni.pl @@ -0,0 +1,348 @@ +#! /usr/bin/perl -w +# +# This script creates virtual subfonts in Unicode encoding for a font +# encoding given by a subfont definition file (which must use Unicode +# code points). +# +# As prerequisites it needs the programs `tftopl' and `vptovf' which must be +# in the path. +# +# Call the script as +# +# perl sfd2uni.pl sfd-file namestem uni-namestem codingscheme +# +# `sfd-file' is the subfont definition file, `namestem' is the name stem +# of the subfonts defined in `sfd-file', and `uni-namestem' holds the prefix +# for the Unicode subfonts. `codingscheme' (converted to uppercase) is used +# for the CODINGSCHEME parameter in the resulting TFM files. +# +# `sfd2uni.pl' reads all TFM files from the font family with name stem +# `namestem'. +# +# Example: +# +# perl sfd2uni.pl UKS-HLaTeX.sfd wmj uwmj HLATEX +# +# A collection of useful subfont definition files for CJK fonts can be found +# in the ttf2pk package. + +# Copyright (C) 1994-2015 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 != 3) { + die("usage: $prog sfd-file namestem uni-namestem codingscheme\n"); +} + +my $sfdfile = $ARGV[0]; +my $namestem = $ARGV[1]; +my $uninamestem = $ARGV[2]; +my $codingscheme = $ARGV[3]; + + +# Read subfont definition file. + +my %sfd; +my @subfonts; + +read_sfdfile($sfdfile, \%sfd, \@subfonts); + + +# Read TFM files. + +my @unicmetrics; + +foreach my $sub (@subfonts) { + my $tfmname = "$namestem$sub.tfm"; + + read_tfmfile($tfmname, \@unicmetrics, \%sfd, $sub); +} + + +# Read FONTDIMEN block. + +my $fontdimen = read_fontdimen("$namestem$subfonts[0].tfm"); + + +# Write VPL files. + +my $index = 0; +foreach my $i (0 .. 255) { + my @entries; + + foreach my $j (0 .. 255) { + if (defined ($unicmetrics[$index])) { + push(@entries, "$j $unicmetrics[$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 key value 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"); + + 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(@{$sfdarray}, $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) { + $sfdhash->{"$suffix $index"} = $i; + $index++; + } + } + else { + my $value = $field[0]; + $value = oct($value) if ($value =~ /^0/); + $sfdhash->{"$suffix $index"} = $value; + $index++; + } + shift(@field); + } + } + close(SFD); +} + + +# Read TFM file. +# +# $1: Name of the TFM file. +# $2: Reference to the target array holding metric information in the form +# ` '. +# $3: Reference to a hash created by `read_sfdfile'. +# $4: Subfont suffix. + +sub read_tfmfile { + my ($tfmfile, $unicarray, $sfdhash, $sub) = @_; + + print("Processing metrics file \`$tfmfile'...\n"); + my $arg = "tftopl $tfmfile > $tfmfile.pl"; + system($arg) == 0 + || die("$prog: calling \`$arg' failed: $?\n"); + + print("Reading property list file \`$tfmfile.pl'...\n"); + open(PL, "$tfmfile.pl") + || die("$prog: can't open \`$tfmfile.pl': $!\n"); + + while () { + my $index; + if (/^\(CHARACTER O (\d+)/) { + $index = oct($1); + } + elsif (/^\(CHARACTER C (.)/) { + $index = ord($1); + } + else { + next; + } + + my $wd = "0"; + my $ht = "0"; + my $dp = "0"; + + $_ = ; + if (/\(CHARWD R (.*)\)/) { + $wd = "$1"; + $_ = ; + } + if (/\(CHARHT R (.*)\)/) { + $ht = "$1"; + $_ = ; + } + if (/\(CHARDP R (.*)\)/) { + $dp = "$1"; + } + + if (defined ($sfdhash->{"$sub $index"})) { + $unicarray->[$sfdhash->{"$sub $index"}] = "$sub $index $wd $ht $dp"; + } + } + close(PL); + print("Removing \`$tfmfile.pl'...\n"); + unlink("$tfmfile.pl"); +} + + +# Read FONTDIMEN block of a TFM file. +# +# $1: Name of the TFM file. +# +# Return the block as a string. + +sub read_fontdimen { + my ($tfmfile) = @_; + + print("Processing metrics file \`$tfmfile'...\n"); + my $arg = "tftopl $tfmfile > $tfmfile.pl"; + system($arg) == 0 + || die("$prog: calling \`$arg' failed: $?\n"); + + print("Reading property list file \`$tfmfile.pl'...\n"); + open(PL, "$tfmfile.pl") + || die("$prog: can't open \`$tfmfile.pl': $!\n"); + + my $s = ""; + my $have_fontdimen = 0; + + while () { + if (/^\(FONTDIMEN/) { + $have_fontdimen = 1; + } + + if ($have_fontdimen) { + $s .= $_; + + last if (/^ \)/); + } + } + + close(PL); + print("Removing \`$tfmfile.pl'...\n"); + unlink("$tfmfile.pl"); + + return $s; +} + + +# Write VPL file. +# +# $1: Name of the VPL file. +# $2: Reference to list which holds the font entries. An entry has the +# form ` '. + +sub write_vplfile { + my ($vplfile, $metricsarray) = @_; + + my %subfonts; + my $subcount = 0; + + foreach my $entry (@{$metricsarray}) { + 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(" ", @ARGV) . "')\n"); + print("(FAMILY TEX-\U$uninamestem\E)\n"); + print("(CODINGSCHEME \U$codingscheme\E)\n"); + print $fontdimen; + + foreach my $subfont + (sort { $subfonts{$a} <=> $subfonts{$b} } keys %subfonts) { + print("(MAPFONT D $subfonts{$subfont}\n"); + print(" (FONTNAME $namestem$subfont)\n"); + print(" )\n"); + } + + foreach my $entry (@{$metricsarray}) { + my ($index, $subnumber, $subindex, $wd, $ht, $dp) = split(" ", $entry); + + print("(CHARACTER D $index\n"); + print(" (CHARWD R $wd)\n"); + print(" (CHARHT R $ht)\n"); + print(" (CHARDP R $dp)\n"); + print(" (MAP\n"); + print(" (SELECTFONT D $subfonts{$subnumber})\n"); + print(" (SETCHAR D $subindex)\n"); + print(" )\n"); + print(" )\n"); + } + + close(VPL); + select($oldfh); +} + + +# eof -- cgit v1.2.3