summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-01-11 23:49:47 +0000
committerKarl Berry <karl@freefriends.org>2006-01-11 23:49:47 +0000
commit2f4fdf541dc04813bd2c8e2f3fad9a2ae66b71a3 (patch)
tree8a7953deed6e0f2035d658c473dd6bb1eb6c1468 /Master/texmf-dist/source/latex/CJK/utils/subfonts/clonevf.pl
parent802dd52e36f5dfdf39b9565798a01ac525ff5e48 (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.pl105
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