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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations) (download)
Wed Oct 16 10:39:35 2002 UTC (23 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.4: +9 -4 lines
2002-10-16  Nanashi-san

	* Charset/: New directory.
	* Charset.pm ($C->{option}->{final_to_set}): New option.
	(Committed by Wakaba <w@suika.fam.cx>.)

1 wakaba 1.1
2     =head1 NAME
3    
4     Encode::Charset --- Coded Character Sets objects,
5     used by Encode::ISO2022, Encode::SJIS, and other modules.
6    
7     =cut
8    
9     package Encode::Charset;
10     use strict;
11     use vars qw(%CHARSET %CODING_SYSTEM $VERSION);
12 wakaba 1.5 $VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13 wakaba 1.1
14     ## --- Make initial charset definitions
15     &_make_initial_charsets;
16     sub _make_initial_charsets () {
17     for my $f (0x30..0x7E) {
18     my $F = pack 'C', $f;
19     for ('', '!', '"', '#') {
20     $CHARSET{G94}->{ $_.$F }->{dimension} = 1;
21     $CHARSET{G94}->{ $_.$F }->{chars} = 94;
22     $CHARSET{G94}->{ $_.$F }->{ucs} =
23     {'' => 0xE90940, '!' => 0xE944A0, '"' => 0xE98000, '#' => 0xE9BB60}->{ $_ }
24     + 94 * ($f-0x30);
25    
26     $CHARSET{G96}->{ $_.$F }->{dimension} = 1;
27     $CHARSET{G96}->{ $_.$F }->{chars} = 96;
28     $CHARSET{G96}->{ $_.$F }->{ucs} =
29     {'' => 0xE926A0, '!' => 0xE96200, '"' => 0xE99D60, '#' => 0xE9D8C0}->{ $_ }
30     + 96 * ($f-0x30);
31    
32     $CHARSET{C0}->{ $_.$F }->{dimension} = 1;
33     $CHARSET{C0}->{ $_.$F }->{chars} = 32;
34     $CHARSET{C0}->{ $_.$F }->{ucs} =
35     {'' => 0x70000000, '!' => 0x70001400,
36     '"' => 0x70002800, '#' => 0x70003C00}->{ $_ } + 32 * ($f-0x30);
37    
38     $CHARSET{C1}->{ $_.$F }->{dimension} = 1;
39     $CHARSET{C1}->{ $_.$F }->{chars} = 32;
40     $CHARSET{C1}->{ $_.$F }->{ucs} =
41     {'' => 0x70000A00, '!' => 0x70001E00,
42     '"' => 0x70003200, '#' => 0x70004600}->{ $_ } + 32 * ($f-0x30);
43    
44     $CHARSET{G94}->{ ' '.$_.$F }->{dimension} = 1; ## DRCS
45     $CHARSET{G94}->{ ' '.$_.$F }->{chars} = 94;
46     $CHARSET{G94}->{ ' '.$_.$F }->{ucs} =
47     {'' => 0x70090940, '!' => 0x700944A0,
48     '"' => 0x70098000, '#' => 0x7009BB60}->{ $_ } + 94 * ($f-0x30);
49    
50     $CHARSET{G96}->{ ' '.$_.$F }->{dimension} = 1; ## DRCS
51     $CHARSET{G96}->{ ' '.$_.$F }->{chars} = 96;
52     $CHARSET{G96}->{ ' '.$_.$F }->{ucs} =
53     {'' => 0x700926A0, '!' => 0x70096200,
54     '"' => 0x70099D60, '#' => 0x7009D8C0}->{ $_ } + 96 * ($f-0x30);
55     }
56     }
57     for my $f (0x30..0x5F, 0x7E) {
58     my $F = pack 'C', $f;
59     for ('', '!', '"', '#', ' ') {
60     $CHARSET{G94n}->{ $_.$F }->{dimension} = 2;
61     $CHARSET{G94n}->{ $_.$F }->{chars} = 94;
62     $CHARSET{G94n}->{ $_.$F }->{ucs} =
63     ({'' => 0xE9F6C0}->{ $_ }||0) + 94*94 * ($f-0x30);
64     ## BUG: 94^n sets with I byte have no mapping area
65    
66     $CHARSET{G96n}->{ $_.$F }->{dimension} = 2;
67     $CHARSET{G96n}->{ $_.$F }->{chars} = 96;
68     $CHARSET{G96n}->{ $_.$F }->{ucs} =
69     ({'' => 0xF4C000}->{ $_ }||0) + 96*96 * ($f-0x30);
70 wakaba 1.4 ## BUG: 96^n DRCSes with I byte have no mapping area
71 wakaba 1.1 }
72     }
73 wakaba 1.4 $CHARSET{G94n}->{"\x20\x40"}->{ucs} = 0x70460000; ## DRCS 94^2 04/00
74 wakaba 1.5 $CHARSET{G94n}->{P4_0} = $CHARSET{G94n}->{"\x20\x40"};
75 wakaba 1.4
76 wakaba 1.1 for (0x60..0x6F) {
77     my $F = pack 'C', $_;
78     ## BUG: 9x^3 sets have no mapping area
79     for ('', '!', '"', '#', ' ') {
80     $CHARSET{G94n}->{ $_.$F }->{dimension} = 3;
81     $CHARSET{G94n}->{ $_.$F }->{chars} = 94;
82    
83     $CHARSET{G96n}->{ $_.$F }->{dimension} = 3;
84     $CHARSET{G96n}->{ $_.$F }->{chars} = 96;
85     }
86     }
87     for (0x70..0x7D) {
88     my $F = pack 'C', $_;
89     ## BUG: 9x^4 sets have no mapping area
90     for ('', '!', '"', '#', ' ') {
91     $CHARSET{G94n}->{ $_.$F }->{dimension} = 4;
92     $CHARSET{G94n}->{ $_.$F }->{chars} = 94;
93    
94     $CHARSET{G96n}->{ $_.$F }->{dimension} = 4;
95     $CHARSET{G96n}->{ $_.$F }->{chars} = 96;
96     }
97     }
98     for my $f (0x40..0x4E) {
99     my $F = pack 'C', $f;
100     $CHARSET{G96n}->{ ' '.$F }->{dimension} = 2;
101     $CHARSET{G96n}->{ ' '.$F }->{chars} = 96;
102     $CHARSET{G96n}->{ ' '.$F }->{ucs} = 0xF0000 + 96*96*($f-0x40);
103     ## U+F0000-U+10F7FF (private) -> ESC 02/04 02/00 <I> (04/00-04/14) (DRCS)
104     }
105    
106     $CHARSET{G94}->{B}->{ucs} = 0x21; ## ASCII
107     $CHARSET{G96}->{A}->{ucs} = 0xA0; ## ISO 8859-1
108    
109     $CHARSET{G94n}->{'B@'}->{dimension} = 2; ## JIS X 0208-1990
110     $CHARSET{G94n}->{'B@'}->{chars} = 94;
111     $CHARSET{G94n}->{'B@'}->{ucs} = 0xE9F6C0 + 94*94*79;
112 wakaba 1.3
113     ## SJIS G3 mapping (JIS X 0213:2000 plane 2)
114     $CHARSET{G94n}->{"\x50"}->{Csjis_kuE} = { # ku - 1
115     0xF0 => 7, 0xF1 => 3, 0xF2 => 11, 0xF3 => 13, 0xF4 => 77,
116     0xF5 => 79, 0xF6 => 81, 0xF7 => 83, 0xF8 => 85, 0xF9 => 87,
117     0xFA => 89, 0xFB => 91, 0xFC => 93,
118     };
119     $CHARSET{G94n}->{"\x50"}->{Csjis_kuO} = { # ku - 1
120  <