]> mj.ucw.cz Git - libucw.git/blob - charset/misc/gen-charconv
Renamed tabgen to gen-charconv.
[libucw.git] / 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, "unicode/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 "Character expansions\n";
114 if (open(EXTRA, "misc/user_expand")) {
115         while (<EXTRA>) {
116                 chomp;
117                 (/^\s*$/ || /^#/) && next;
118                 s/0x([0-9a-zA-Z]+)/hex($1)/ge;
119                 (/^(\S+)\s+(.*)$/) || die "Syntax error in user expansions";
120                 $expand{$1} = $2;
121         }
122         close EXTRA;
123 }
124 print "static unsigned short int x_to_output[$ncs][$unique] = {\n";
125 $pstr = 256;
126 for($c=0; $c<$ncs; $c++) {
127         print "\n/* $charsets[$c] */\n{\n";
128         for($i=0; $i<$unique; $i++) {
129                 $u = $x2u[$i];
130                 do {
131                         $r = $u;
132                         $u = "";
133                         foreach $x (split (/ /, $r)) {
134                                 if (defined($k = $u2x{$x}) && defined $cx[$c]{$k}) {
135                                         $u = "$u $x";
136                                 } elsif (defined($k = $expand{$x})) {
137                                         $u = "$u $k";
138                                 }
139                         }
140                         $u =~ s/^ //;
141                 } while ($r ne $u);
142                 $u = "";
143                 foreach $x (split (/ /, $r)) {
144                         if (defined($k = $u2x{$x})) {
145                                 if ($k != 256 && defined ($k = $cx[$c]{$k})) {
146                                         $u = $u . pack("C", $k);
147                                 }
148                         }
149                 }
150                 if (length($u) == 1) {
151                         $z = unpack("C", $u);
152                 } else {
153                         if (!defined($string{$u})) {
154                                 $string{$u} = $pstr;
155                                 $strval{$pstr} = $u;
156                                 $pstr += 1 + length($u);
157                         }
158                         $z = $string{$u};
159                 }
160                 print "$z,", ($i % 16 == 15) ? "\n" : " ";
161         }
162         if ($i % 16) { print "\n"; }
163         print "},\n";
164 }
165 print "};\n\n";
166
167 print STDERR "And Tubular Bells...\n";
168 print "static unsigned char string_table[] = {\n";
169 $i = 256;
170 while ($i < $pstr) {
171         $w = $strval{$i};
172         print length $w, ",";
173         foreach $x (unpack("C256", $w)) {
174                 print " $x,";
175         }
176         print "\n";
177         $i += 1 + length $w;
178 }
179 print "};\n";
180
181 print STDERR "Done.\n";