/[classpath]/classpath/doc/unicode/unicode-muncher.pl
ViewVC logotype

Diff of /classpath/doc/unicode/unicode-muncher.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by ericb, Sun Feb 17 07:30:03 2002 UTC revision 1.3 by ericb, Mon Feb 18 20:07:17 2002 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl -w
2  # unicode-muncher -- Script to generate Unicode data for java.lang.Character  # unicode-muncher.pl -- generate Unicode database for java.lang.Character
3  # Copyright (C) 1998, 2002 Free Software Foundation, Inc.  # Copyright (C) 1998, 2002 Free Software Foundation, Inc.
4  #  #
5  # This file is part of GNU Classpath.  # This file is part of GNU Classpath.
# Line 36  Line 36 
36  # obligated to do so.  If you do not wish to do so, delete this  # obligated to do so.  If you do not wish to do so, delete this
37  # exception statement from your version.  # exception statement from your version.
38    
39    # Inspired by code from Artur Biesiadowski.
40    # author Eric Blake <ebb9@email.byu.edu>
41    #
42    # Usage: ./unicode-muncher <UnicodeData.txt> <CharData.java>
43    #   where <UnicodeData.txt> is obtained from www.unicode.org (named
44    #   UnicodeData-3.0.0.txt for Unicode version 3.0.0), and <CharData.java>
45    #   is the final location for the Java interface gnu.java.lang.CharData.
46    #   As of JDK 1.4, use Unicode version 3.0.0 for best results.
47    
48    ##
49    ## Convert a 16-bit integer to a Java source code String literal character
50    ##
51    sub javaChar($) {
52        my ($char) = @_;
53        die "Out of range: $char\n" if $char < -0x8000 or $char > 0xffff;
54        $char += 0x10000 if $char < 0;
55        # Special case characters that must be escaped, or are shorter as ASCII
56        return sprintf("\\%03o", $char) if $char < 0x20;
57        return "\\\"" if $char == 0x22;
58        return "\\\\" if $char == 0x5c;
59        return pack("C", $char) if $char < 0x7f;
60        return sprintf("\\u%04x", $char);
61    }
62    
63    ##
64    ## Convert the text UnicodeData file from www.unicode.org into a Java
65    ## interface with string constants holding the compressed information.
66    ##
67    @TYPECODES = qw(Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp Cc Cf
68                    SKIPPED Co Cs Pd Ps Pe Pc Po Sm Sc Sk So Pi Pf);
69    @DIRCODES = qw(L R AL EN ES ET AN CS NSM BN B S WS ON LRE LRO RLE RLO PDF);
70    
71    $NOBREAK_FLAG  = 32;
72    $MIRRORED_FLAG = 64;
73    
74    my @info = ();
75    my $titlecase = "";
76    my $count = 0;
77    my $range = 0;
78    
79    die "Usage: $0 <UnicodeData.txt> <CharData.java>" unless @ARGV == 2;
80    open (UNICODE, "< $ARGV[0]") || die "Can't open Unicode attribute file: $!\n";
81    
82  # This is lots of really ugly hacked up Perl code.  # Stage 1: Parse the attribute file
83  # It works.  Don't touch it, or it'll break.  $| = 1;
84  # I'm far from proud of it.  If you want to fix it so it  print "GNU Classpath Unicode Attribute Database Generator 2.0\n";
85  # works with strict mode, please do so.  print "Copyright (C) 1998, 2002 Free Software Foundation, Inc.\n";
86  # See unicode.database.format for information on the files  print "Parsing attributes file";
87  # this program generates.  while(<UNICODE>) {
88        print "." unless $count++ % 1000;
89  # usage: unicode-muncher.pl UnicodeData-3.0.0.txt      chomp;
90        s/\r//g;
91  sub write_char {      my ($ch, $name, $category, undef, $bidir, $decomp, undef, undef, $numeric,
92      my $wnum = ($jnum < 65534) ? $hex - $jnum : $jnum;          $mirrored, undef, undef, $upcase, $lowcase, $title) = split ';';
93      $buf = pack ("Cn3c", ($jmirrored << 6) | ($jnobreakspace << 5) | $cat,      $ch = hex($ch);
94                   $wnum, $jupper, $jlower, $jdir);      next if $ch > 0xffff; # Ignore surrogate pairs, since Java does
95      print CHAR $buf;  
96      if (! defined $hash{$buf}) {      my ($type, $numValue, $upperchar, $lowerchar, $direction);
97          $hash{$buf} = $offset;  
98        $type = 0;
99        while ($category !~ /^$TYPECODES[$type]$/) {
100            if (++$type == @TYPECODES) {
101                die "$ch: Unknown type: $category";
102            }
103      }      }
104      $offset += 8;      $type |= $NOBREAK_FLAG if ($decomp =~ /noBreak/);
105  }      $type |= $MIRRORED_FLAG if ($mirrored =~ /Y/);
106    
107  sub end_block {      if ($numeric =~ /^[0-9]+$/) {
108      my $joffset;          $numValue = $numeric;
109      print BLOCK (pack ("n", $start));          die "numValue too big: $ch, $numValue\n" if $numValue >= 0x7fff;
110      print BLOCK (pack ("n", $lhex));      } elsif ($numeric eq "") {
111      $characters += $lhex - $start + 1;          # Special case sequences of 'a'-'z'
112      $blocks++;          if ($ch >= 0x0041 && $ch <= 0x005a) {
113                $numValue = $ch - 0x0037;
114      # calculate next offset          } elsif ($ch >= 0x0061 && $ch <= 0x007a) {
115      if ($comp == 1) {              $numValue = $ch - 0x0057;
116          $joffset = $hash{$buf};          } elsif ($ch >= 0xff21 && $ch <= 0xff3a) {
117          if ($joffset + 8 < $offset) { # Reuse a previous attribute              $numValue = $ch - 0xff17;
118              $offset -= 8;          } elsif ($ch >= 0xff41 && $ch <= 0xff5a) {
119              seek CHAR, $offset, SEEK_SET;              $numValue = $ch - 0xff37;
120            } else {
121                $numValue = -1;
122          }          }
123      } else {      } else {
124          $joffset = $offset - 8 * ($lhex - $start + 1);          $numValue = -2;
125          $comp = 0; # Create a string of uncompressed attributes      }
126    
127        $upperchar = $upcase ? hex($upcase) - $ch : 0;
128        $lowerchar = $lowcase ? hex($lowcase) - $ch : 0;
129        if ($title ne $upcase) {
130            my $titlechar = $title ? hex($title) : $ch;
131            $titlecase .= pack("n2", $ch, $titlechar);
132        }
133    
134        $direction = 0;
135        while ($bidir !~ /^$DIRCODES[$direction]$/) {
136            if (++$direction == @DIRCODES) {
137                $direction = -1;
138                last;
139            }
140      }      }
     die "sanity: offset out of range!\n" if ($joffset >= 32768);  
     print BLOCK (pack ("n", ($comp << 15) | $joffset));  
141    
142      # setup next starting block      if ($range) {
143      $start = $hex;          die "Expecting end of range at $ch\n" unless $name =~ /Last>$/;
144      # default to unknown compression          for ($range + 1 .. $ch - 1) {
145      $comp = 2;              $info[$_] = pack("n5", $type, $numValue, $upperchar,
146                                 $lowerchar, $direction);
147            }
148            $range = 0;
149        } elsif ($name =~ /First>$/) {
150            $range = $ch;
151        }
152        $info[$ch] = pack("n5", $type, $numValue, $upperchar, $lowerchar,
153                          $direction);
154  }  }
155    close UNICODE;
156    
157  open (DATA, $ARGV[0]) || die "Can't open Unicode attribute file: $!\n";  # Stage 2: Compress the data structures
158    printf "\nCompressing data structures";
159    $count = 0;
160    my $info = ();
161    my %charhash = ();
162    my @charinfo = ();
163    
164    for $ch (0 .. 0xffff) {
165        print "." unless $count++ % 0x1000;
166        if (! defined $info[$ch]) {
167            $info[$ch] = pack("n5", 0, -1, 0, 0, -1);
168        }
169    
170  open (TITLECASE, ">titlecase.uni") || die ("Can't open titlecase file: $!\n");      my ($type, $numVal, $upper, $lower, $direction) = unpack("n5", $info[$ch]);
171  binmode TITLECASE;      if (! exists $charhash{$info[$ch]}) {
172  open (CHAR, ">character.uni") || die ("Can't open character file: $!\n");          push @charinfo, [ $numVal, $upper, $lower, $direction ];
173  binmode CHAR;          $charhash{$info[$ch]} = $#charinfo;
174  open (BLOCK, ">block.uni") || die ("Can't open block file: $!\n");      }
175  binmode BLOCK;      $info .= pack("n", ($charhash{$info[$ch]} << 7) | $type);
176    }
177    
178  $| = 1;  my $charlen = @charinfo;
179  print "GNU Classpath Unicode Attribute Database Generator 1.1\n";  my $bestshift;
180  print "Copyright (C) 1998, 2002 Free Software Foundation, Inc.\n";  my $bestest = 1000000;
181  print "Creating";  my $bestblkstr;
182    die "Too many unique character entrie: $charlen\n" if $charlen > 512;
183    print "\nUnique character entries: $charlen\n";
184    
185    for $i (3 .. 8) {
186        my $blksize = 1 << $i;
187        my %blocks = ();
188        my @blkarray = ();
189        my ($j, $k);
190        print "shift: $i";
191    
192        for ($j = 0; $j < 0x10000; $j += $blksize) {
193            my $blkkey = substr $info, 2 * $j, 2 * $blksize;
194            if (! exists $blocks{$blkkey}) {
195                push @blkarray, $blkkey;
196                $blocks{$blkkey} = $#blkarray;
197            }
198        }
199        my $blknum = @blkarray;
200        my $blocklen = $blknum * $blksize;
201        printf " before %5d", $blocklen;
202    
203        # Now we try to pack the blkarray as tight as possible by finding matching
204        # heads and tails.
205        for ($j = $blksize - 1; $j > 0; $j--) {
206            my %tails = ();
207            for $k (0 .. $#blkarray) {
208                next if ! defined $blkarray[$k];
209                my $len = length $blkarray[$k];
210                my $tail = substr $blkarray[$k], $len - $j * 2;
211                if (exists $tails{$tail}) {
212                    push @{$tails{$tail}}, $k;
213                } else {
214                    $tails{$tail} = [ $k ];
215                }
216            }
217    
218  $offset = 0;          # tails are calculated, now calculate the heads and merge.
219  $hex = -1;        BLOCK:
220  $buf = "";          for $k (0 .. $#blkarray) {
221  $characters = 0;              next if ! defined $blkarray[$k];
222  $blocks = 0;              my $tomerge = $k;
223  $ignored = 0;              while (1) {
224  while (<DATA>) {                  my $head = substr($blkarray[$tomerge], 0, $j * 2);
225      $llhex = $lhex;                  my $entry = $tails{$head};
226      $lhex = $hex;                  next BLOCK if ! defined $entry;
227      ($hex, $name, $category, $comb_class, $bidir, $decomp, $decimal, $digit,  
228       $numeric, $mirrored, $unicode1n, $comment, $upcase, $lowcase, $titlecase)                  my $other = shift @{$entry};
229          = split(/;/);                  if ($other == $tomerge) {
230                        if (@{$entry}) {
231      print "." if (++$count % 1000 == 0);                          push @{$entry}, $other;
232                                    $other = shift @{$entry};
233      # convert unicode index strings to hex                      } else {
234      $hex = hex($hex);                          push @{$entry}, $other;
235      if ($hex > 0xffff) { # Ignore surrogates, since Java does                          next BLOCK;
236          $ignored++;                      }
237          $lhex = $llhex;                  }
238          $hex = $lhex;                  if (@{$entry} == 0) {
239          next;                      delete $tails{$head};
240      }                  }
241      $upcase = hex($upcase);  
242      $lowcase = hex($lowcase);                  # a match was found
243      $titlecase = hex($titlecase);                  my $merge = $blkarray[$other]
244                        . substr($blkarray[$tomerge], $j * 2);
245      $jnobreakspace = ($category eq "Zs" && $decomp =~ /noBreak/) ? 1 : 0;                  $blocklen -= $j;
246                    $blknum--;
247      # handle getNumericValue(). $jnum is either -1 for no value, -2 for  
248      # non-positive integer value, or the offset of the value from $hex                  if ($other < $tomerge) {
249      if ($numeric eq "") {                      $blkarray[$tomerge] = undef;
250          $jnum = 65535;          # does not have a numeric value                      $blkarray[$other] = $merge;
251          # Special case sequences of 'a'-'z'                      my $len = length $merge;
252          if ($hex >= 0x0041 && $hex <= 0x005a) {                      my $tail = substr $merge, $len - $j * 2;
253              $jnum = 0x0037;                      $tails{$tail} = [ map { $_ == $tomerge ? $other : $_ }
254          } elsif ($hex >= 0x0061 && $hex <= 0x007a) {                                        @{$tails{$tail}} ];
255              $jnum = 0x0057;                      next BLOCK;
256          } elsif ($hex >= 0xff21 && $hex <= 0xff3a) {                  }
257              $jnum = 0xff17;                  $blkarray[$tomerge] = $merge;
258          } elsif ($hex >= 0xff41 && $hex <= 0xff5a) {                  $blkarray[$other] = undef;
259              $jnum = 0xff37;              }
260          }          }
261      } else {      }
262          if ($numeric =~ /^[0-9]+$/) {      my $blockstr;
263              $jnum = $hex - $numeric;    # nonnegative integer value      for $k (0 .. $#blkarray) {
264              die "sanity: numeric out of range!\n" if ($jnum >= 65534 ||          $blockstr .= $blkarray[$k] if defined $blkarray[$k];
265                                                        $jnum <= -65534);      }
266          } else {  
267              $jnum = 65534;      # other integer value      die "Unexpected $blocklen" if length($blockstr) != 2 * $blocklen;
268          }      my $estimate = 2 * $blocklen + (0x20000 >> $i) + 8 * $charlen;
269      }  
270        printf " after merge %5d: %6d bytes\n", $blocklen, $estimate;
271      # handle uppercase mapping - use the offset from $hex      if ($estimate < $bestest) {
272      $jupper = ($upcase == 0) ? 0 : ($hex - $upcase);          $bestest = $estimate;
273            $bestshift = $i;
274      # handle lowercase mapping - use the offset from $hex          $bestblkstr = $blockstr;
275      $jlower = ($lowcase == 0) ? 0 : ($hex - $lowcase);      }
276    }
277      # handle titlecase mapping - go ahead and output to file  
278      if ($titlecase != $upcase) {  my @blocks;
279          $titlecase = $hex if ($titlecase == 0);  my $blksize = 1 << $bestshift;
280          print TITLECASE (pack ("n2", $hex, $titlecase));  for ($j = 0; $j < 0x10000; $j += $blksize) {
281      }      my $blkkey = substr $info, 2 * $j, 2 * $blksize;
282        my $index = index $bestblkstr, $blkkey;
283      # handle category      while ($index & 1) {
284      $_ = $category;          die "not found: $j" if $index == -1;
285      CAT: {          $index = index $bestblkstr, $blkkey, $index + 1;
286          if (/Cn/) { $cat = 0; last CAT; } # unassigned      }
287          if (/Lu/) { $cat = 1; last CAT; } # letter, uppercase      push @blocks, ($index / 2);
288          if (/Ll/) { $cat = 2; last CAT; } # letter, lowercase  }
289          if (/Lt/) { $cat = 3; last CAT; } # letter, titlecase  
290          if (/Lm/) { $cat = 4; last CAT; } # letter, modifier  # Phase 3: Generate the file
291          if (/Lo/) { $cat = 5; last CAT; } # letter, other  die "UTF-8 limit of blocks may be exceeded: " . scalar(@blocks) . "\n"
292          if (/Mn/) { $cat = 6; last CAT; } # mark, non-spacing      if @blocks > 0xffff / 3;
293          if (/Me/) { $cat = 7; last CAT; } # mark, enclosing  die "UTF-8 limit of data may be exceeded: " . length($bestblkstr) . "\n"
294          if (/Mc/) { $cat = 8; last CAT; } # mark, spacing combining      if length($bestblkstr) > 0xffff / 3;
295          if (/Nd/) { $cat = 9; last CAT; } # number, decimal digit  {
296          if (/Nl/) { $cat = 10; last CAT; } # number, letter      print "Generating $ARGV[1] with shift of $bestshift";
297          if (/No/) { $cat = 11; last CAT; } # number, other      open OUTPUT, "> $ARGV[1]" or die "Failed creating output file: $!\n";
298          if (/Zs/) { $cat = 12; last CAT; } # separator, space      print OUTPUT <<EOF;
299          if (/Zl/) { $cat = 13; last CAT; } # separator, line  /* gnu/java/lang/CharData -- Database for java.lang.Character Unicode info
300          if (/Zp/) { $cat = 14; last CAT; } # separator, paragraph     Copyright (C) 2002 Free Software Foundation, Inc.
301          if (/Cc/) { $cat = 15; last CAT; } # other, control     *** This file is generated by doc/unicode/unicode-muncher.pl ***
302          if (/Cf/) { $cat = 16; last CAT; } # other, format  
303          # Sun skipped 17 - don't ask me why -- rao  This file is part of GNU Classpath.
304          if (/Co/) { $cat = 18; last CAT; } # other, private use  
305          if (/Cs/) { $cat = 19; last CAT; } # other, surrogate  GNU Classpath is free software; you can redistribute it and/or modify
306          if (/Pd/) { $cat = 20; last CAT; } # punctuation, dash  it under the terms of the GNU General Public License as published by
307          if (/Ps/) { $cat = 21; last CAT; } # punctuation, open  the Free Software Foundation; either version 2, or (at your option)
308          if (/Pe/) { $cat = 22; last CAT; } # punctuation, close  any later version.
309          if (/Pc/) { $cat = 23; last CAT; } # punctuation, connector  
310          if (/Po/) { $cat = 24; last CAT; } # punctuation, other  GNU Classpath is distributed in the hope that it will be useful, but
311          if (/Sm/) { $cat = 25; last CAT; } # symbol, math  WITHOUT ANY WARRANTY; without even the implied warranty of
312          if (/Sc/) { $cat = 26; last CAT; } # symbol, currency  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
313          if (/Sk/) { $cat = 27; last CAT; } # symbol, modifier  General Public License for more details.
314          if (/So/) { $cat = 28; last CAT; } # symbol, other  
315          if (/Pi/) { $cat = 29; last CAT; } # punctuation, initial quote  You should have received a copy of the GNU General Public License
316          if (/Pf/) { $cat = 30; last CAT; } # punctuation, final quote  along with GNU Classpath; see the file COPYING.  If not, write to the
317          $cat = 0; # unassigned  Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
318      }  02111-1307 USA.
319    
320      # handle mirrored characters  Linking this library statically or dynamically with other modules is
321      $jmirrored = ($mirrored eq "Y") ? 1 : 0;  making a combined work based on this library.  Thus, the terms and
322    conditions of the GNU General Public License cover the whole
323      # handle directionality  combination.
324      $_ = $bidir;  
325      BIDIR: {  As a special exception, the copyright holders of this library give you
326          if (/^L$/) { $jdir = 0; last BIDIR; } # Left-to-Right  permission to link this library with independent modules to produce an
327          if (/^R$/) { $jdir = 1; last BIDIR; } # Right-to-Left  executable, regardless of the license terms of these independent
328          if (/^AL$/) { $jdir = 2; last BIDIR; } # Right-to-Left Arabic  modules, and to copy and distribute the resulting executable under
329          if (/^EN$/) { $jdir = 3; last BIDIR; } # European Number  terms of your choice, provided that you also meet, for each linked
330          if (/^ES$/) { $jdir = 4; last BIDIR; } # European Numer Separator  independent module, the terms and conditions of the license of that
331          if (/^ET$/) { $jdir = 5; last BIDIR; } # European Numer Terminator  module.  An independent module is a module which is not derived from
332          if (/^AN$/) { $jdir = 6; last BIDIR; } # Arabic Number  or based on this library.  If you modify this library, you may extend
333          if (/^CS$/) { $jdir = 7; last BIDIR; } # Common Number Separator  this exception to your version of the library, but you are not
334          if (/^NSM$/) { $jdir = 8; last BIDIR; } # Non-Spacing Mark  obligated to do so.  If you do not wish to do so, delete this
335          if (/^BN$/) { $jdir = 9; last BIDIR; } # Boundary Neutral  exception statement from your version. */
336          if (/^B$/) { $jdir = 10; last BIDIR; } # Paragraph Separator  
337          if (/^S$/) { $jdir = 11; last BIDIR; } # Segment Separator  package gnu.java.lang;
338          if (/^WS$/) { $jdir = 12; last BIDIR; } # Whitespace  
339          if (/^ON$/) { $jdir = 13; last BIDIR; } # Other Neutral  /**
340          if (/^LRE$/) { $jdir = 14; last BIDIR; } # Left-to-Right Embedding   * This contains the info about the unicode characters, that
341          if (/^LRO$/) { $jdir = 15; last BIDIR; } # Left-to-Right Override   * java.lang.Character needs.  It is generated automatically from
342          if (/^RLE$/) { $jdir = 16; last BIDIR; } # Right-to-Left Embedding   * <code>$ARGV[0]</code>, by some perl scripts.  This Unicode
343          if (/^RLO$/) { $jdir = 17; last BIDIR; } # Right-to-Left Override   * definition file can be found on the <a href="http://www.unicode.org">
344          if (/^PDF$/) { $jdir = 18; last BIDIR; } # Pop Directional Format   * http://www.unicode.org</a> website.  JDK 1.4 uses Unicode version 3.0.0.
345          $jdir = -1; # undefined   *
346      }   * The data is stored as string constants, but Character will convert these
347     * Strings to their respective <code>char[]</code> components.  The field
348    CHAR: {   * <code>BLOCKS</code> stores the offset of a block of 2<sup>SHIFT</sup>
349        # starting point   * characters within <code>DATA</code>.  The DATA field, in turn, stores
350        if ($hex == 0) {   * information about each character in the low order bits, and an offset
351            &write_char;   * into the attribute tables <code>UPPER</code>, <code>LOWER</code>,
352            $comp = 2;            # compressed block state unknown until next ch   * <code>NUM_VALUE</code>, and <code>DIRECTION</code>.  Notice that the
353            $start = 0;   * attribute tables are much smaller than 0xffff entries; as many characters
354            last CHAR;   * in Unicode share common attributes.  Finally, there is a listing for
355        }   * <code>TITLE</code> exceptions (most characters just have the same
356     * title case as upper case).
357        # handle mandatory blocks   *
358        if ($name =~ /First>$/) {   * \@author doc/unicode/unicode-muncher.pl (written by Artur Biesiadowski,
359            &end_block;   *         Eric Blake)
360            &write_char;   * \@see Character
361            $comp = 1;   */
362            $mand_block = 1;  public interface CharData
363            last CHAR;  {
364        }    /**
365        # end mandatory block     * The character shift amount to look up the block offset. In other
366        if ($mand_block) {     * words, <code>BLOCKS.value[ch >> SHIFT] + (ch & ~(-1 << SHIFT))</code>
367            $mand_block = 0;     * is the index where <code>ch</code> is described in <code>DATA</code>.
368            last CHAR;     */
369        }    int SHIFT = $bestshift;
370    
371        # not sequential, end block.    /**
372        if (($lhex+1) != $hex) {     * The mapping of character blocks to their location in <code>DATA</code>.
373            &end_block;     */
374            &write_char;    String BLOCKS
375            last CHAR;  EOF
376        }  
377        for ($i = 0; $i < @blocks / 11; $i++) {
378        # check to see if we can compress this character into the current block          print OUTPUT $i ? "\n    + \"" : "    = \"";
379        if ($cat == $lcat &&          for $j (0 .. 10) {
380            $jnum == $ljnum &&              last if @blocks <= $i * 11 + $j;
381            $jnobreakspace == $ljnobreakspace &&              my $val = $blocks[$i * 11 + $j];
382            $jupper == $ljupper &&              print OUTPUT javaChar($val);
383            $jlower == $ljlower &&          }
384            $jmirrored == $ljmirrored &&          print OUTPUT "\"";
385            $jdir == $ljdir) {      }
386            if ($comp == 2) { $comp = 1; } # start compressing  
387            # end uncompressed block      print OUTPUT <<EOF;
388            if ($comp == 0) {  ;
389                $tmp = $lhex;  
390                $lhex = $llhex;    /**
391                $offset -= 8;     * Information about each character.  The low order 5 bits form the
392                &end_block;     * character type, the next bit is a flag for non-breaking spaces, and the
393                $start = $lhex = $tmp;     * next bit is a flag for mirrored directionality.  The high order 9 bits
394                $offset += 8;     * form the offset into the attribute tables.  Note that this limits the
395                $comp = 1;     * number of unique character attributes to 512, which is not a problem
396            }     * as of Unicode version 3.2.0, but may soon become one.
397        } else {     */
398            if ($comp == 2) { $comp = 0; };    String DATA
399            if ($comp == 1) { &end_block; }  EOF
400            &write_char;  
401        }      my $len = length($bestblkstr) / 2;
402    }      for ($i = 0; $i < $len / 11; $i++) {
403            print OUTPUT $i ? "\n    + \"" : "    = \"";
404      # copy over all the variables to their "last" counterparts          for $j (0 .. 10) {
405      $lcat = $cat;              last if $len <= $i * 11 + $j;
406      $ljnum = $jnum;              my $val = unpack "n", substr($bestblkstr, 2 * ($i*11 + $j), 2);
407      $ljnobreakspace = $jnobreakspace;              print OUTPUT javaChar($val);
408      $ljupper = $jupper;          }
409      $ljlower = $jlower;          print OUTPUT "\"";
410      $ljmirrored = $jmirrored;      }
411      $ljdir = $jdir;  
412        print OUTPUT <<EOF;
413    ;
414    
415      /**
416       * This is the attribute table for computing the numeric value of a
417       * character.  The value is -1 if Unicode does not define a value, -2
418       * if the value is not a positive integer, otherwise it is the value.
419       * Note that this is a signed value, but stored as an unsigned char
420       * since this is a String literal.
421       */
422      String NUM_VALUE
423    EOF
424    
425        $len = @charinfo;
426        for ($i = 0; $i < $len / 11; $i++) {
427            print OUTPUT $i ? "\n    + \"" : "    = \"";
428            for $j (0 .. 10) {
429                last if $len <= $i * 11 + $j;
430                my $val = $charinfo[$i * 11 + $j][0];
431                print OUTPUT javaChar($val);
432            }
433            print OUTPUT "\"";
434        }
435    
436        print OUTPUT <<EOF;
437    ;
438    
439      /**
440       * This is the attribute table for computing the uppercase representation
441       * of a character.  The value is the signed difference between the
442       * character and its uppercase version.  Note that this is stored as an
443       * unsigned char since this is a String literal.
444       */
445      String UPPER
446    EOF
447    
448        $len = @charinfo;
449        for ($i = 0; $i < $len / 11; $i++) {
450            print OUTPUT $i ? "\n    + \"" : "    = \"";
451            for $j (0 .. 10) {
452                last if $len <= $i * 11 + $j;
453                my $val = $charinfo[$i * 11 + $j][1];
454                print OUTPUT javaChar($val);
455            }
456            print OUTPUT "\"";
457        }
458    
459        print OUTPUT <<EOF;
460    ;
461    
462      /**
463       * This is the attribute table for computing the lowercase representation
464       * of a character.  The value is the signed difference between the
465       * character and its lowercase version.  Note that this is stored as an
466       * unsigned char since this is a String literal.
467       */
468      String LOWER
469    EOF
470    
471        $len = @charinfo;
472        for ($i = 0; $i < $len / 11; $i++) {
473            print OUTPUT $i ? "\n    + \"" : "    = \"";
474            for $j (0 .. 10) {
475                last if $len <= $i * 11 + $j;
476                my $val = $charinfo[$i * 11 + $j][2];
477                print OUTPUT javaChar($val);
478            }
479            print OUTPUT "\"";
480        }
481    
482        print OUTPUT <<EOF;
483    ;
484    
485      /**
486       * This is the attribute table for computing the directionality class
487       * of a character.  At present, the value is in the range 0 - 18 if the
488       * character has a direction, otherwise it is -1.  Note that this is
489       * stored as an unsigned char since this is a String literal.
490       */
491      String DIRECTION
492    EOF
493    
494        $len = @charinfo;
495        for ($i = 0; $i < $len / 11; $i++) {
496            print OUTPUT $i ? "\n    + \"" : "    = \"";
497            for $j (0 .. 10) {
498                last if $len <= $i * 11 + $j;
499                my $val = $charinfo[$i * 11 + $j][3];
500                print OUTPUT javaChar($val);
501            }
502            print OUTPUT "\"";
503        }
504    
505        print OUTPUT <<EOF;
506    ;
507    
508      /**
509       * This is the listing of titlecase special cases (all other character
510       * can use <code>UPPER</code> to determine their titlecase).  The listing
511       * is a sequence of character pairs; converting the first character of the
512       * pair to titlecase produces the second character.
513       */
514      String TITLE
515    EOF
516    
517        $len = length($titlecase) / 2;
518        for ($i = 0; $i < $len / 11; $i++) {
519            print OUTPUT $i ? "\n    + \"" : "    = \"";
520            for $j (0 .. 10) {
521                last if $len <= $i * 11 + $j;
522                my $val = unpack "n", substr($titlecase, 2 * ($i*11 + $j), 2);
523                print OUTPUT javaChar($val);
524            }
525            print OUTPUT "\"";
526        }
527    
528        print OUTPUT ";\n}\n";
529        close OUTPUT;
530  }  }
531  $lhex = $hex;                   # setup final block write  print "\nDone.\n";
 &end_block;                     # write final block  
 truncate CHAR, $offset + 8;     # remove final duplicate record, if it exists  
   
 close(DATA);  
 close(TITLECASE);  
 close(CHAR);  
 close(BLOCK);  
   
 print "ok\n";  
 print "Created " . ($offset + 8)/8 . " attributes for $characters "  
     . "Unicode characters in $blocks blocks.\n"  
     . "(Ignored $ignored surrogates.)\n";  

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26