diff options
author | Karl Berry <karl@freefriends.org> | 2006-01-11 23:49:47 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2006-01-11 23:49:47 +0000 |
commit | 2f4fdf541dc04813bd2c8e2f3fad9a2ae66b71a3 (patch) | |
tree | 8a7953deed6e0f2035d658c473dd6bb1eb6c1468 /Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl | |
parent | 802dd52e36f5dfdf39b9565798a01ac525ff5e48 (diff) |
trunk/Master/texmf-dist/source/latex/CJK
git-svn-id: svn://tug.org/texlive/trunk@118 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl')
-rw-r--r-- | Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl b/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl new file mode 100644 index 00000000000..f6b35b207a5 --- /dev/null +++ b/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl @@ -0,0 +1,105 @@ +#! /usr/bin/perl -w +# +# This script clones a virtual font from a TFM file. +# +# As prerequisites, it needs the programs `tftopl' and `vptovf', which must +# be in the path. +# +# Call the script as +# +# perl clonevf.pl tfm_name vf_name +# +# Example: +# +# perl clonevf.pl bsmiuv bsmilp + +use strict; + +my $prog = $0; +$prog =~ s@.*/@@; + +if ($#ARGV != 1) { + die("usage: $prog tfm_name vf_name\n"); +} + +my $tfmname = $ARGV[0]; +my $vfname = $ARGV[1]; + + +# Create PL file. + +print("Processing metrics file \`$tfmname.tfm'...\n"); + +my $arg = "tftopl $tfmname.tfm > $tfmname.pl"; +system($arg) == 0 +|| die("$prog: calling \`$arg' failed: $?\n"); + + +# Create VPL file. + +print("Writing virtual property list file \`$vfname.vpl'...\n"); + +open(PL, "$tfmname.pl") +|| die("$prog: can't open \`$tfmname.pl': $!\n"); + +open(VPL, ">", "$vfname.vpl") +|| die("$prog: can't open \`$vfname.vpl': $!\n"); + +print(VPL "(VTITLE Created by \`$prog " . join(" ", @ARGV) . "')\n"); +print(VPL "(FAMILY TEX-\U$vfname\E)\n"); + +my $have_mapfont = 0; +while (<PL>) { + next if /^\(FAMILY/; + next if /^\(CHECKSUM/; + + if (/^\(CHARACTER (.*)/) { + if (!$have_mapfont) { + print(VPL "(MAPFONT D 0\n"); + print(VPL " (FONTNAME $tfmname)\n"); + print(VPL " )\n"); + $have_mapfont = 1; + } + + my $char = $1; + + print(VPL $_); + + $_ = <PL>; + if (/CHARWD/) { + print(VPL $_); + $_ = <PL>; + } + if (/CHARHT/) { + print(VPL $_); + $_ = <PL>; + } + if (/CHARDP/) { + print(VPL $_); + $_ = <PL>; + } + + print(VPL " (MAP\n"); + print(VPL " (SELECTFONT D 0)\n"); + print(VPL " (SETCHAR $char)\n"); + print(VPL " )\n"); + } + + print(VPL $_); +} + +close(PL); +close(VPL); + +print("Processing \`$vfname.vpl'\n"); +$arg = "vptovf $vfname.vpl"; +system($arg) == 0 +|| die("$prog: calling \`$arg' failed: $?\n"); + +print("Removing \`$tfmname.pl'...\n"); +unlink("$tfmname.pl"); +print("Removing \`$vfname.vpl'...\n"); +unlink("$vfname.vpl"); + + +# eof |