diff options
Diffstat (limited to 'Master/texmf-dist/source/latex/CJK/utils/subfonts/uni2sfd.pl')
-rw-r--r-- | Master/texmf-dist/source/latex/CJK/utils/subfonts/uni2sfd.pl | 292 |
1 files changed, 292 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/latex/CJK/utils/subfonts/uni2sfd.pl b/Master/texmf-dist/source/latex/CJK/utils/subfonts/uni2sfd.pl new file mode 100644 index 00000000000..34c32134990 --- /dev/null +++ b/Master/texmf-dist/source/latex/CJK/utils/subfonts/uni2sfd.pl @@ -0,0 +1,292 @@ +#! /usr/bin/perl -w +# +# This script creates virtual subfonts in a font encoding given by a subfont +# definition file, based on Unicode subfonts. +# +# As prerequisites, it needs the programs `tftopl' and `vptovf' which must +# be in the path. +# +# Call the script as +# +# perl uni2sfd.pl uni_namestem sfd_file namestem codingscheme +# +# `uni_namestem' is the namestem of the Unicode subfonts; `uni2sfd.pl' +# appends the Unicode suffixes and reads the corresponding TFM files. +# `sfd_file' is the subfont definition file which maps Unicode input +# characters to the target subfont scheme using `namestem' as the namestem. +# `codingscheme' gives the value for the CODINGSCHEME parameter in the +# VF files (always converted to uppercase). +# +# Example: +# +# perl uni2sfd.pl bsmiu UBig5.sfd bsmilp cjkbig5 + +use strict; + +my $prog = $0; +$prog =~ s@.*/@@; + +if ($#ARGV != 3) { + die("usage: $prog uni_namestem sfd_file namestem codingscheme\n"); +} + +my $uninamestem = $ARGV[0]; +my $sfdfile = $ARGV[1]; +my $namestem = $ARGV[2]; +my $codingscheme = $ARGV[3]; + + +# Read subfont definition file. + +my %sfd; +my @subfonts; + +read_sfdfile($sfdfile, \%sfd, \@subfonts); + + +# Read TFM files. + +my @unimetrics; + +foreach my $sub (0 .. 0xFF) { + my $suffix = sprintf("%02x", $sub); + my $tfmname = "$uninamestem$suffix.tfm"; + + if (-f $tfmname) { + read_tfmfile($tfmname, \@unimetrics, $suffix); + } +} + + +# Write VPL files. + +foreach my $sub (@subfonts) { + my @entries; + + foreach my $i (0 .. 255) { + if (defined ($sfd{"$sub $i"})) { + my $index = $sfd{"$sub $i"}; + if (defined ($unimetrics[$index])) { + push(@entries, "$i $index $unimetrics[$index]"); + } + } + } + + if ($#entries >= 0) { + write_vplfile("$namestem$sub.vpl", \@entries); + } +} + + +# Generate VF and TFM files, then remove the VPL files. + +my @vplfiles = glob("$namestem*.vpl"); +foreach my $vplfile (@vplfiles) { + print("Processing \`$vplfile'...\n"); + my $arg = "vptovf $vplfile"; + system($arg) == 0 + || die("$prog: calling \`$arg' failed: $?\n"); + 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 character code +# to the subfont index. 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 (<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(@{$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 +# `<width> <heigth> <depth>'. +# $3: Subfont suffix. + +sub read_tfmfile { + my ($tfmfile, $unicarray, $suffix) = @_; + + 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 (<PL>) { + my $idx; + if (/^\(CHARACTER O (\d+)/) { + $idx = oct($1); + } + elsif (/^\(CHARACTER C (.)/) { + $idx = ord($1); + } + else { + next; + } + $idx += hex($suffix) * 256; + + my $wd = "0"; + my $ht = "0"; + my $dp = "0"; + + $_ = <PL>; + if (/\(CHARWD R (.*)\)/) { + $wd = "$1"; + $_ = <PL>; + } + if (/\(CHARHT R (.*)\)/) { + $ht = "$1"; + $_ = <PL>; + } + if (/\(CHARDP R (.*)\)/) { + $dp = "$1"; + } + + $unicarray->[$idx] = "$wd $ht $dp"; + } + close(PL); + print("Removing \`$tfmfile.pl'...\n"); + unlink("$tfmfile.pl"); +} + + +# Write VPL file. +# +# $1: Name of the VPL file. +# $2: Reference to list which holds the font entries. An entry has the +# form `<index> <Unicode> <width> <height> <depth>'. + +sub write_vplfile { + my ($vplfile, $glypharray) = @_; + + my %subfonts; + my $subcount = 0; + + foreach my $entry (@{$glypharray}) { + my @field = split(" ", $entry); + my $subfont = int($field[1] / 256); + 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$namestem\E)\n"); + print("(CODINGSCHEME \U$codingscheme\E)\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 $uninamestem" . sprintf("%02x", $subfont) . ")\n"); + print(" )\n"); + } + + foreach my $entry (@{$glypharray}) { + my @field = split(" ", $entry); + my $index = $field[0]; + my $subnumber = $subfonts{int($field[1] / 256)}; + my $subindex = $field[1] % 256; + my $width = $field[2]; + my $height = $field[3]; + my $depth = $field[4]; + + print("(CHARACTER D $index\n"); + print(" (CHARWD R $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 |