charset/misc/gen-charconv

   1 #!/usr/bin/perl
   2 #
   3 #       Character Set Table Generator 1.0
   4 #       (c) 1998 Martin Mares <mj@atrey.karlin.mff.cuni.cz>
   5 #
   6 #       This program can be freely distributed and used according to the terms
   7 #       of the GNU General Public License.
   8 #
   9
  10 # Internal codes 0..255 are mapped to UniCode 0..255
  11 # Internal code 256 is the replacement character (U#FFFD)
  12
  13 $ncs = 0;
  14
  15 print "/* Generated by tabgen 1.0, please don't edit manually. */\n\n";
  16
  17 print STDERR "Charset list...\n";
  18
  19 while (<>) {
  20         chomp;
  21         (/^\w*$/ || /^#/) && next;
  22         $charsets[$ncs++] = $_;
  23 }
  24
  25 print STDERR "Found $ncs charsets, counting unique codes...\n";
  26
  27 for($unique=0; $unique<256; $unique++) {
  28         $u2x{$unique} = $unique;
  29         $x2u[$unique] = $unique;
  30 }
  31 $u2x{0xFFFD} = $unique;
  32 $x2u[$unique++] = 0xFFFD;
  33 print "static unsigned short int input_to_x[$ncs][256] = {\n";
  34 for($x=0; $x<$ncs; $x++) {
  35         $a = $charsets[$x];
  36         print "\n/* $a */\n{\n";
  37         open (A, $a) || die "Error opening $a";
  38         while (<A>) {
  39                 chomp;
  40                 (/^\w*$/ || /^#/) && next;
  41                 ($i, $u, $c) = split /\t/;
  42                 $cc[$x][hex $i] = $u;
  43         }
  44         close A;
  45         for($i=0; $i<256; $i++) {
  46                 $u = hex((defined $cc[$x][$i]) ? $cc[$x][$i] : "FFFD");
  47                 if (!defined $u2x{$u}) {
  48                         $x2u[$unique] = $u;
  49                         $u2x{$u} = $unique++;
  50                 }
  51                 $o = $u2x{$u};
  52                 print "$o,", ($i % 16 == 15) ? "\n" : " ";
  53                 $cc[$x][$i] = $o;
  54                 $cx[$x]{$o} = $i;
  55         }
  56         print "},\n";
  57 }
  58 print "};\n\n";
  59
  60 print STDERR "$unique unique codes...\n";
  61
  62 print "static unsigned short int x_to_uni[$unique] = {\n";
  63 for($i=0; $i<$unique; $i++) {
  64         print "$x2u[$i],", ($i % 16 == 15) ? "\n" : " ";
  65 }
  66 if ($i % 16) { print "\n"; }
  67 print "};\n\n";
  68
  69 print STDERR "UNICODE table...\n";
  70 for($i=0; $i<$unique; $i++) {
  71         $u = $x2u[$i];
  72         $p = $u / 256;
  73         $pg[$p] = 1;
  74 }
  75 for($i=0; $i<256; $i++) {
  76         if ($pg[$i]) {
  77                 print "static unsigned short int uni_to_x_$i\[256\] = {\n";
  78                 for($j=0; $j<256; $j++) {
  79                         $u = 256*$i + $j;
  80                         $u = defined($u2x{$u}) ? $u2x{$u} : 256;
  81                         print "$u,", ($j % 16 == 15) ? "\n" : " ";
  82                 }
  83                 print "};\n\n";
  84         }
  85 }
  86 print "static unsigned short int *uni_to_x[256] = {\n";
  87 for($i=hex "FF00"; $i<=hex "FFFF"; $i++) {
  88         if (defined $u2x{$i} && $i != 0xFFFD) { die "Invalid replacement strategy!"; }
  89 }
  90 for($i=0; $i<256; $i++) {
  91         print "uni_to_x_", $pg[$i] ? $i : "255", ",", ($i % 4 == 3) ? "\n" : " ";
  92 }
  93 print "};\n\n";
  94
  95 print STDERR "UniData file...\n";
  96 open (U, "unidata/UnicodeData.txt") || die "No UnicodeData file";
  97 while (<U>) {
  98         chomp;
  99         ($num,$name,$_,$_,$_,$exp) = split /;/;
 100         if ($exp ne "") {
 101                 $exp =~ s/^<.*> *//g;
 102                 $a = "";
 103                 foreach $x (split (/ /, $exp)) {
 104                         if ($x ne "0020") {
 105                                 $a = $a . " " . hex $x;
 106                         }
 107                 }
 108                 ($expand{hex $num} = $a) =~ s/^ //;
 109         }
 110 }
 111 close U;
 112
 113 print STDERR "Accent rules\n";
 114 if (open(ACC, "misc/user_unacc")) {
 115         while (<ACC>) {
 116                 chomp;
 117                 (/^\s*$/ || /^#/) && next;
 118                 s/0x([0-9a-zA-Z]+)/hex($1)/ge;
 119                 (/^(\d+)\s+(\d+)$/) || die "Syntax error in user accent rules";
 120                 $expand{$1} = $2;
 121         }
 122         close ACC;
 123 }
 124
 125 print STDERR "Character expansions\n";
 126 if (open(EXTRA, "misc/user_expand")) {
 127         while (<EXTRA>) {
 128                 chomp;
 129                 (/^\s*$/ || /^#/) && next;
 130                 s/0x([0-9a-zA-Z]+)/hex($1)/ge;
 131                 (/^(\d+)\s+(.*)$/) || die "Syntax error in user expansions";
 132                 $expand{$1} = $2;
 133         }
 134         close EXTRA;
 135 }
 136
 137 print "static unsigned short int x_to_output[$ncs][$unique] = {\n";
 138 $pstr = 256;
 139 for($c=0; $c<$ncs; $c++) {
 140         print "\n/* $charsets[$c] */\n{\n";
 141         for($i=0; $i<$unique; $i++) {
 142                 $u = $x2u[$i];
 143                 do {
 144                         $r = $u;
 145                         $u = "";
 146                         foreach $x (split (/ /, $r)) {
 147                                 if (defined($k = $u2x{$x}) && defined $cx[$c]{$k}) {
 148                                         $u = "$u $x";
 149                                 } elsif (defined($k = $expand{$x})) {
 150                                         $u = "$u $k";
 151                                 }
 152                         }
 153                         $u =~ s/^ //;
 154                 } while ($r ne $u);
 155                 $u = "";
 156                 foreach $x (split (/ /, $r)) {
 157                         if (defined($k = $u2x{$x})) {
 158                                 if ($k != 256 && defined ($k = $cx[$c]{$k})) {
 159                                         $u = $u . pack("C", $k);
 160                                 }
 161                         }
 162                 }
 163                 if (length($u) == 1) {
 164                         $z = unpack("C", $u);
 165                 } else {
 166                         if (!defined($string{$u})) {
 167                                 $string{$u} = $pstr;
 168                                 $strval{$pstr} = $u;
 169                                 $pstr += 1 + length($u);
 170                         }
 171                         $z = $string{$u};
 172                 }
 173                 print "$z,", ($i % 16 == 15) ? "\n" : " ";
 174         }
 175         if ($i % 16) { print "\n"; }
 176         print "},\n";
 177 }
 178 print "};\n\n";
 179
 180 print STDERR "And Tubular Bells...\n";
 181 print "static unsigned char string_table[] = {\n";
 182 $i = 256;
 183 while ($i < $pstr) {
 184         $w = $strval{$i};
 185         print length $w, ",";
 186         foreach $x (unpack("C256", $w)) {
 187                 print " $x,";
 188         }
 189         print "\n";
 190         $i += 1 + length $w;
 191 }
 192 print "};\n";
 193
 194 print STDERR "Done.\n";