/[suikacvs]/perl/lib/Encode/Charset.pm
Suika

Diff of /perl/lib/Encode/Charset.pm

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

revision 1.3 by wakaba, Sat Oct 12 07:27:01 2002 UTC revision 1.8 by wakaba, Wed Dec 18 12:57:40 2002 UTC
# Line 67  for my $f (0x30..0x5F, 0x7E) { Line 67  for my $f (0x30..0x5F, 0x7E) {
67      $CHARSET{G96n}->{ $_.$F }->{chars} = 96;      $CHARSET{G96n}->{ $_.$F }->{chars} = 96;
68      $CHARSET{G96n}->{ $_.$F }->{ucs} =      $CHARSET{G96n}->{ $_.$F }->{ucs} =
69        ({'' => 0xF4C000}->{ $_ }||0) + 96*96 * ($f-0x30);        ({'' => 0xF4C000}->{ $_ }||0) + 96*96 * ($f-0x30);
70        ## BUG: 94^n DRCSes with I byte have no mapping area        ## BUG: 96^n DRCSes with I byte have no mapping area
71    }    }
72  }  }
73      $CHARSET{G94n}->{"\x20\x40"}->{ucs} = 0x70460000;     ## DRCS 94^2 04/00
74      $CHARSET{G94n}->{P4_0} = $CHARSET{G94n}->{"\x20\x40"};
75      
76  for (0x60..0x6F) {  for (0x60..0x6F) {
77    my $F = pack 'C', $_;    my $F = pack 'C', $_;
78    ## BUG: 9x^3 sets have no mapping area    ## BUG: 9x^3 sets have no mapping area
# Line 213  sub new_object { Line 216  sub new_object {
216    $C{option} = {    $C{option} = {
217          C1invoke_to_right       => 0,   ## C1 invoked to: (0: ESC Fe, 1: CR)          C1invoke_to_right       => 0,   ## C1 invoked to: (0: ESC Fe, 1: CR)
218          G94n_designate_long     => 0,   ## (1: ESC 02/04 02/08 04/00..02)          G94n_designate_long     => 0,   ## (1: ESC 02/04 02/08 04/00..02)
219          designate_to    => {    ## Designated G buffer (-1: not be outputed)          designate_to    => {    ## Designated G buffer (-1: not to be outputed)
220                  C0      => {                  C0      => {
221                          default => 0,                          default => 0,
222                  },                  },
# Line 237  sub new_object { Line 240  sub new_object {
240                          default => -1,                          default => -1,
241                  },                  },
242          },          },
243            fallback_from_ucs       => 'replacement',
244                    ## 'replacement' / 'perl' / 'sgml' / 'sgml-hex' / 'x-u-escaped' / 'code'
245                    ## / 'quiet' / 'quiet+back' / 'quiet+warn' / 'quiet+back+warn' / 'croak'
246                    ## / code
247            final_to_set    => {
248                    C0 => {}, C1 => {}, G94 => {}, G94n => {},
249                    G96 => {}, G96n => {}, coding_system => {},
250            },
251          Ginvoke_by_single_shift => [0,0,0,0],   ## Invoked by SS          Ginvoke_by_single_shift => [0,0,0,0],   ## Invoked by SS
252          Ginvoke_to_left => [1,1,1,1],   ## Which invoked to? (1: L, 0: R)          Ginvoke_to_left => [1,1,1,1],   ## Which invoked to? (1: L, 0: R)
253          private_set     => {    ## Private set vs Final byte          private_set     => {    ## Private set vs Final byte
254                  C0      => [],                  C0      => [],
255                  C1      => [],                  C1      => [],
256                  G94     => [],                  G94     => [],
257                  G94n    => [[],[],[],[],[]],                  G94n    => [[],[],[],[],["\x20\x40"]],
258                  G96     => [],                  G96     => [],
259                  #G96n   => [],  ## (not implemented)                  #G96n   => [],  ## (not implemented)
260                  U96n    => [],  ## mule-unicode sets                  U96n    => [],  ## mule-unicode sets
# Line 255  sub new_object { Line 266  sub new_object {
266                  Gdesignation    => "\x42",      ## F of designation or 0                  Gdesignation    => "\x42",      ## F of designation or 0
267                  Ginvoke => 1,                  Ginvoke => 1,
268          },          },
269            reset_at_end => {},     ## Default: same as 'reset''s value
270          undef_char      => ["\x3F", {type => 'G94', charset => 'B'}],          undef_char      => ["\x3F", {type => 'G94', charset => 'B'}],
271          use_revision    => 1,   ## Output IRR          use_revision    => 1,   ## Output IRR
272    };    };
   ## Special code area (such as 0xFD-0xFF of sjis'es)  
   $C{Gsmap} = {"\xA0" => "\x{F8F0}", "\xFD" => "\x{F8F1}", "\xFE" => "\x{F8F2}", "\xFF" => "\x{F8F3}"};  
   $C{GsmapR} = {};      ## Reversed table  
273    \%C;    \%C;
274  }  }
275    
276  sub new_object_sjis {  sub new_object_sjis {
277    my $C = new_object;    my $C = &new_object;
278    $C->{coding_system} = $CODING_SYSTEM{Csjis};    $C->{coding_system} = $CODING_SYSTEM{Csjis};
279    $C->{CR} = undef;    $C->{CR} = undef;
280    $C->{GR} = 'G2';      ## 0xA1-0xDF    $C->{GR} = 'G2';      ## 0xA1-0xDF
281    #$C->{G0} = $CHARSET{G94}->{J};       ## JIS X 0201:1997 Latin    $C->{G0} = $CHARSET{G94}->{J};        ## JIS X 0201:1997 Latin
282    $C->{G1} = $CHARSET{G94n}->{'B@'};    ## JIS X 0208:1997    $C->{G1} = $CHARSET{G94n}->{"\x4F"};  ## JIS X 0213:2000
283    $C->{G2} = $CHARSET{G94}->{I};        ## JIS X 0201:1997 Katakana    $C->{G2} = $CHARSET{G94}->{I};        ## JIS X 0201:1997 Katakana
284    $C->{G3} = $CHARSET{G94n}->{"\x50"};  ## JIS X 0213:2000 plane 2    $C->{G3} = $CHARSET{G94n}->{"\x50"};  ## JIS X 0213:2000 plane 2
285      ## Special code area (0xFD-0xFF)
286      $C->{Gsmap} = {"\xA0" => "\x{F8F0}", "\xFD" => "\x{F8F1}", "\xFE" => "\x{F8F2}", "\xFF" => "\x{F8F3}"};
287      $C->{GsmapR} = {};    ## Reversed table
288      $C->{option}->{undef_char_sjis} = "\x81\xAC";
289    $C;    $C;
290  }  }
291    
292  1;  our %FallbackFromUCS = (
293  __END__          perl    => sub { my $c = $_[2]; sprintf '\x{%04X}', ord $c },
294            sgml    => sub { my $c = $_[2]; sprintf '&#%d;', ord $c },
295            'sgml-hex'      => sub { my $c = $_[2]; sprintf '&#x%04X;', ord $c },
296            'x-u-escaped'   => sub { my $c = $_[2]; my $C = ord $c; sprintf $C > 0xFFFF ? '\U%08X' : '\u%04X', $C },
297    );
298    
299    sub fallback_escape ($$$;%) {
300      my (undef, $C, $c, %option) = @_;
301      my $f = $option{fallback_from_ucs} ?
302                (ref ($option{fallback_from_ucs}) eq 'CODE' ? $option{fallback_from_ucs} :
303                 $FallbackFromUCS{$option{fallback_from_ucs}}):
304                (ref ($C->{option}->{fallback_from_ucs}) eq 'CODE' ? $C->{option}->{fallback_from_ucs} :
305                 $FallbackFromUCS{$C->{option}->{fallback_from_ucs}});
306      if (ref $f) {
307        return undef if $option{_recursive} <= -10;  $option{_recursive}--; ## To avoid loop
308        my $self = bless {}, __PACKAGE__;
309        Encode::_utf8_on ($c);
310        return &$f ($self, $C, $c, \%option);
311      }
312      undef;
313    }
314    
315  =head1 AUTHORS  =head1 AUTHORS
316    
317  Nanashi-san  Nanashi-san <nanashi-san@nanashi.invalid>
318    
319  Wakaba <w@suika.fam.cx>  Wakaba <w@suika.fam.cx>
320    
321  =head1 LICENSE  =head1 LICENSE
322    
323  Copyright 2002 AUTHORS  Copyright 2002 AUTHORS, all rights reserved.
324    
325  This library is free software; you can redistribute it  This library is free software; you can redistribute it
326  and/or modify it under the same terms as Perl itself.  and/or modify it under the same terms as Perl itself.
327    
328  =cut  =cut
329    
330  # $Date$  1; # $Date$
 ### Charset.pm ends here  
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.8
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24