Changeset 1870 for trunk/gsdl/bin/script

Timestamp:

2001-01-29T14:54:58+13:00 (23 years ago)

Author:

sjboddie

Message:

Tidied up language support stuff.

File:

• trunk/gsdl/bin/script/makemapfile.pl (modified) (3 diffs)

trunk/gsdl/bin/script/makemapfile.pl

@@ -26 +26 @@
 ###########################################################################
 
-# Creates a binary map file for use by complex character encodings
-# (e.g. CJK encodings like GBK and Shift-JIS). The map file is written to
-# the $GSDLHOME/unicode directory.
-
 BEGIN {
     die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
@@ -37 +33 @@
 
 use parsargv;
-use cjk;
+use util;
+
+# %translations is of the form:
+#
+# encodings{encodingname-encodingname}->blocktranslation
+# blocktranslation->[[0-255],[256-511], ..., [65280-65535]]
+#
+# Any of the top translation blocks can point to an undefined
+# value. This data structure aims to allow fast translation and 
+# efficient storage.
+%translations = ();
+
+# @array256 is used for initialisation, there must be
+# a better way...
+@array256 = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+
 &main();
 
@@ -55 +81 @@
     }
 
-    &cjk::makeencodingmapfile ($encoding, $mapfile);
+    if (!&loadencoding ($encoding, $mapfile)) {
+    die "couldn't load encoding $encoding";
+    }
+
+    # write out map files
+    &writemapfile ("$encoding-unicode", $encoding, 1);
+    &writemapfile ("unicode-$encoding", $encoding, 0);
 }
+
+sub writemapfile {
+    my ($encoding, $filename, $tounicode) = @_;
+
+    $filename .= ".ump"; # unicode map file
+    if ($tounicode) {
+    $filename = &util::filename_cat ($ENV{'GSDLHOME'}, "mappings", "to_uc", $filename);
+    } else {
+    $filename = &util::filename_cat ($ENV{'GSDLHOME'}, "mappings", "from_uc", $filename);
+    }
+
+    die "translation not defined" if (!defined $translations{$encoding});
+    my $block = $translations{$encoding};
+
+    print "writing $filename\n";
+    open (MAPFILE, ">" . $filename) || die;
+    binmode (MAPFILE);
+
+    my ($i, $j);
+    for ($i=0; $i<256; $i++) {
+    if (ref ($block->[$i]) eq "ARRAY") {
+        print MAPFILE pack ("C", $i);
+        for ($j=0; $j<256; $j++) {
+        # unsigned short in network order
+        print MAPFILE pack ("CC", int($block->[$i]->[$j] / 256), 
+                    $block->[$i]->[$j] % 256);
+        }
+    }
+    }
+    close (MAPFILE);
+}
+
+# loadencoding expects the mapfile to contain (at least) two
+# tab-separated fields. The first field is the mapped value
+# and the second field is the unicode value.
+#
+# It returns 1 if successful, 0 if unsuccessful
+sub loadencoding {
+    my ($encoding, $mapfile) = @_;
+    
+    my $to = "$encoding-unicode";
+    my $from = "unicode-$encoding";
+
+    # check to see if the encoding has already been loaded
+    if (defined $translations{$to} && defined $translations{$from}) {
+    return 1;
+    }
+
+    return 0 unless open (MAPFILE, $mapfile);
+
+    my ($line, @line);
+    $translations{$to} = [@array256];
+    $translations{$from} = [@array256];
+    while (defined ($line = <MAPFILE>)) {
+    chomp $line;
+    # remove comments
+    $line =~ s/\#.*$//;
+    next unless $line =~ /\S/;
+
+    # split the line into fields and do a few
+    # simple sanity checks
+    @line = split (/\t/, $line);
+    next unless (scalar(@line) >= 2 &&
+             $line[0] =~ /^0x/ &&
+             $line[1] =~ /^0x/);
+
+    my $char = hex($line[0]);
+    my $unic = hex($line[1]);
+
+    # might need this for some versions of gb but not gbk
+#   $char = $char | 0x8080 unless ($encoding =~ /gbk/i);
+
+    &addchartrans ($translations{$to}, $char, $unic);
+    &addchartrans ($translations{$from}, $unic, $char);
+    }
+
+    close (MAPFILE);
+
+    return 1;
+}
+
+# addchartrans adds one character translation to a translation block.
+# It also simplifies the translation block if possible.
+sub addchartrans {
+    my ($block, $from, $to) = @_;
+    my $i = 0;
+
+    my $high = ($from / 256) % 256;
+    my $low = $from % 256;
+
+    if (ref ($block->[$high]) ne "ARRAY") {
+    $block->[$high] = [@array256];
+    }
+    $block->[$high]->[$low] = $to;
+}