5 usage
: mkutable
[-n
] [-f
#] type... [--] [<] UnicodeData.txt
6 -n
= take non
-matching types
7 -f
= zero
-based type field
(default 2)
10 use vars
qw( $opt_f $opt_n );
14 exit (main() ? 1 : 0);
19 my $args = join ' ', @ARGV;
20 my $header = "/* Generated by \"$0 $args\" on $date */\n";
22 die $USAGE if not getopts('f:n');
23 $type_field = $opt_f if $opt_f;
26 while ($arg = shift @ARGV) {
30 my %out = ( 'types' => \%types );
37 my @fields = split /;/;
39 my $code = hex $fields[0];
40 my $type = $fields[$type_field];
42 while (++$last_code < $code) {
43 output(\%out, $last_code, '?');
45 output(\%out, $code, $type);
47 output(\%out, $last_code+1, '?');
51 my ($out, $code, $type) = @_;
52 my $match = ${${$out}{types}}{$type};
53 my $type_change = (not $$out{start_type} or $type ne $$out{start_type});
54 $match = not $match if $opt_n;
55 if ($match and (not $$out{in_run} or $type_change)) {
56 end_run($out, $code-1);
57 start_run($out, $code, $type);
58 } elsif (not $match and $$out{in_run}) {
59 end_run($out, $code-1);
64 my ($out, $code, $type) = @_;
65 $$out{start_code} = $code;
66 $$out{start_type} = $type;
71 my ($out, $code) = @_;
72 return if not $$out{in_run};
73 printf "\t{ 0x%04x, 0x%04x }, /* %s */\n", $$out{start_code}, $code, $$out{start_type};