contrib/putty/CHARSET/SBCSGEN.PL

   1 #!/usr/bin/env perl -w\r
   2 \r
   3 # This script generates sbcsdat.c (the data for all the SBCSes) from its\r
   4 # source form sbcs.dat.\r
   5 \r
   6 $infile = "sbcs.dat";\r
   7 $outfile = "sbcsdat.c";\r
   8 \r
   9 open FOO, $infile;\r
  10 open BAR, ">$outfile";\r
  11 select BAR;\r
  12 \r
  13 print "/*\n";\r
  14 print " * sbcsdat.c - data definitions for single-byte character sets.\n";\r
  15 print " *\n";\r
  16 print " * Generated by sbcsgen.pl from sbcs.dat.\n";\r
  17 print " * You should edit those files rather than editing this one.\n";\r
  18 print " */\n";\r
  19 print "\n";\r
  20 print "#ifndef ENUM_CHARSETS\n";\r
  21 print "\n";\r
  22 print "#include \"charset.h\"\n";\r
  23 print "#include \"internal.h\"\n";\r
  24 print "\n";\r
  25 \r
  26 my $charsetname = undef;\r
  27 my @vals = ();\r
  28 \r
  29 my @charsetnames = ();\r
  30 my @sortpriority = ();\r
  31 \r
  32 while (<FOO>) {\r
  33     chomp;\r
  34     if (/^charset (.*)$/) {\r
  35         $charsetname = $1;\r
  36         @vals = ();\r
  37         @sortpriority = map { 0 } 0..255;\r
  38     } elsif (/^sortpriority ([^-]*)-([^-]*) (.*)$/) {\r
  39         for ($i = hex $1; $i <= hex $2; $i++) {\r
  40             $sortpriority[$i] += $3;\r
  41         }\r
  42     } elsif (/^[0-9a-fA-FX]/) {\r
  43         push @vals, map { $_ eq "XXXX" ? -1 : hex $_ } split / +/, $_;\r
  44         if (scalar @vals > 256) {\r
  45             die "$infile:$.: charset $charsetname has more than 256 values\n";\r
  46         } elsif (scalar @vals == 256) {\r
  47             &outcharset($charsetname, \@vals, \@sortpriority);\r
  48             push @charsetnames, $charsetname;\r
  49             $charsetname = undef;\r
  50             @vals = ();\r
  51             @sortpriority = map { 0 } 0..255;\r
  52         }\r
  53     }\r
  54 }\r
  55 \r
  56 print "#else /* ENUM_CHARSETS */\n";\r
  57 print "\n";\r
  58 \r
  59 foreach $i (@charsetnames) {\r
  60     print "ENUM_CHARSET($i)\n";\r
  61 }\r
  62 \r
  63 print "\n";\r
  64 print "#endif /* ENUM_CHARSETS */\n";\r
  65 \r
  66 sub outcharset($$$) {\r
  67     my ($name, $vals, $sortpriority) = @_;\r
  68     my ($prefix, $i, @sorted);\r
  69 \r
  70     print "static const sbcs_data data_$name = {\n";\r
  71     print "    {\n";\r
  72     $prefix = "    ";\r
  73     @sorted = ();\r
  74     for ($i = 0; $i < 256; $i++) {\r
  75         if ($vals->[$i] < 0) {\r
  76             printf "%sERROR ", $prefix;\r
  77         } else {\r
  78             printf "%s0x%04x", $prefix, $vals->[$i];\r
  79             die "ooh? $i\n" unless defined $sortpriority->[$i];\r
  80             push @sorted, [$i, $vals->[$i], 0+$sortpriority->[$i]];\r
  81         }\r
  82         if ($i % 8 == 7) {\r
  83             $prefix = ",\n    ";\r
  84         } else {\r
  85             $prefix = ", ";\r
  86         }\r
  87     }\r
  88     print "\n    },\n    {\n";\r
  89     @sorted = sort { ($a->[1] == $b->[1] ?\r
  90                       $b->[2] <=> $a->[2] :\r
  91                       $a->[1] <=> $b->[1]) ||\r
  92                      $a->[0] <=> $b->[0] } @sorted;\r
  93     $prefix = "    ";\r
  94     $uval = -1;\r
  95     for ($i = $j = 0; $i < scalar @sorted; $i++) {\r
  96         next if ($uval == $sorted[$i]->[1]); # low-priority alternative\r
  97         $uval = $sorted[$i]->[1];\r
  98         printf "%s0x%02x", $prefix, $sorted[$i]->[0];\r
  99         if ($j % 8 == 7) {\r
 100             $prefix = ",\n    ";\r
 101         } else {\r
 102             $prefix = ", ";\r
 103         }\r
 104         $j++;\r
 105     }\r
 106     printf "\n    },\n    %d\n", $j;\r
 107     print "};\n";\r
 108     print "const charset_spec charset_$name = {\n" .\r
 109           "    $name, read_sbcs, write_sbcs, &data_$name\n};\n\n";\r
 110 }\r