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.2 |
$VERSION=do{my @r=(q$Revision: 1.1 $=~/\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 |
|
|
## BUG: 94^n DRCSes with I byte have no mapping area |
71 |
|
|
} |
72 |
|
|
} |
73 |
|
|
for (0x60..0x6F) { |
74 |
|
|
my $F = pack 'C', $_; |
75 |
|
|
## BUG: 9x^3 sets have no mapping area |
76 |
|
|
for ('', '!', '"', '#', ' ') { |
77 |
|
|
$CHARSET{G94n}->{ $_.$F }->{dimension} = 3; |
78 |
|
|
$CHARSET{G94n}->{ $_.$F }->{chars} = 94; |
79 |
|
|
|
80 |
|
|
$CHARSET{G96n}->{ $_.$F }->{dimension} = 3; |
81 |
|
|
$CHARSET{G96n}->{ $_.$F }->{chars} = 96; |
82 |
|
|
} |
83 |
|
|
} |
84 |
|
|
for (0x70..0x7D) { |
85 |
|
|
my $F = pack 'C', $_; |
86 |
|
|
## BUG: 9x^4 sets have no mapping area |
87 |
|
|
for ('', '!', '"', '#', ' ') { |
88 |
|
|
$CHARSET{G94n}->{ $_.$F }->{dimension} = 4; |
89 |
|
|
$CHARSET{G94n}->{ $_.$F }->{chars} = 94; |
90 |
|
|
|
91 |
|
|
$CHARSET{G96n}->{ $_.$F }->{dimension} = 4; |
92 |
|
|
$CHARSET{G96n}->{ $_.$F }->{chars} = 96; |
93 |
|
|
} |
94 |
|
|
} |
95 |
|
|
for my $f (0x40..0x4E) { |
96 |
|
|
my $F = pack 'C', $f; |
97 |
|
|
$CHARSET{G96n}->{ ' '.$F }->{dimension} = 2; |
98 |
|
|
$CHARSET{G96n}->{ ' '.$F }->{chars} = 96; |
99 |
|
|
$CHARSET{G96n}->{ ' '.$F }->{ucs} = 0xF0000 + 96*96*($f-0x40); |
100 |
|
|
## U+F0000-U+10F7FF (private) -> ESC 02/04 02/00 <I> (04/00-04/14) (DRCS) |
101 |
|
|
} |
102 |
|
|
|
103 |
|
|
$CHARSET{G94}->{B}->{ucs} = 0x21; ## ASCII |
104 |
|
|
$CHARSET{G96}->{A}->{ucs} = 0xA0; ## ISO 8859-1 |
105 |
|
|
|
106 |
|
|
$CHARSET{G94n}->{'B@'}->{dimension} = 2; ## JIS X 0208-1990 |
107 |
|
|
$CHARSET{G94n}->{'B@'}->{chars} = 94; |
108 |
|
|
$CHARSET{G94n}->{'B@'}->{ucs} = 0xE9F6C0 + 94*94*79; |
109 |
|
|
|
110 |
|
|
## -- Control character sets |
111 |
|
|
$CHARSET{C0}->{'@'}->{ucs} = 0x00; ## ISO/IEC 6429 C0 |
112 |
|
|
for ("\x40", "\x43", "\x44", "\x45", "\x46", "\x49", "\x4A", "\x4B", "\x4C") { |
113 |
|
|
$CHARSET{C0}->{$_}->{C_LS0} = "\x0F"; |
114 |
|
|
$CHARSET{C0}->{$_}->{C_LS1} = "\x0E"; |
115 |
|
|
$CHARSET{C0}->{$_}->{r_LS0} = '\x0F'; |
116 |
|
|
$CHARSET{C0}->{$_}->{r_LS1} = '\x0E'; |
117 |
|
|
} |
118 |
|
|
for ("\x40", "\x44", "\x45", "\x46", "\x48", "\x4C") { |
119 |
|
|
$CHARSET{C0}->{$_}->{reset_all} = {"\x0A" => 1, "\x0B" => 1, |
120 |
|
|
"\x0C" => 1, "\x0D" => 1}; |
121 |
|
|
} |
122 |
|
|
$CHARSET{C0}->{"\x43"}->{reset_all} = {"\x0A" => 1}; |
123 |
|
|
$CHARSET{C0}->{"\x44"}->{C_SS2} = "\x1C"; |
124 |
|
|
$CHARSET{C0}->{"\x44"}->{r_SS2} = '\x1C'; |
125 |
|
|
for ("\x45", "\x49", "\x4A", "\x4B") { |
126 |
|
|
$CHARSET{C0}->{$_}->{C_SS2} = "\x19"; |
127 |
|
|
$CHARSET{C0}->{$_}->{C_SS3} = "\x1D"; |
128 |
|
|
$CHARSET{C0}->{$_}->{r_SS2} = '\x19'; |
129 |
|
|
$CHARSET{C0}->{$_}->{r_SS3} = '\x1D'; |
130 |
|
|
} |
131 |
|
|
$CHARSET{C0}->{"\x4C"}->{C_SS2} = "\x19"; |
132 |
|
|
$CHARSET{C0}->{"\x4C"}->{r_SS2} = '\x19'; |
133 |
|
|
|
134 |
|
|
$CHARSET{C1}->{'64291991C1'}->{dimension} = 1; ## ISO/IEC 6429:1991 C1 |
135 |
|
|
$CHARSET{C1}->{'64291991C1'}->{chars} = 32; |
136 |
|
|
$CHARSET{C1}->{'64291991C1'}->{ucs} = 0x80; |
137 |
|
|
for ("\x43", "\x45", "\x47", '64291991C1') { |
138 |
|
|
$CHARSET{C1}->{$_}->{C_SS2} = "\x8E"; |
139 |
|
|
$CHARSET{C1}->{$_}->{C_SS3} = "\x8F"; |
140 |
|
|
$CHARSET{C1}->{$_}->{r_SS2} = '\x8E'; |
141 |
|
|
$CHARSET{C1}->{$_}->{r_SS3} = '\x8F'; |
142 |
|
|
$CHARSET{C1}->{$_}->{r_SS2_ESC} = '\x1B\x4E'; |
143 |
|
|
$CHARSET{C1}->{$_}->{r_SS3_ESC} = '\x1B\x4F'; |
144 |
|
|
} |
145 |
|
|
for ("\x43", '64291991C1') { |
146 |
|
|
$CHARSET{C1}->{$_}->{r_CSI} = '\x9B'; |
147 |
|
|
$CHARSET{C1}->{$_}->{r_CSI_ESC} = '\x1B\x5B'; |
148 |
|
|
$CHARSET{C1}->{$_}->{r_DCS} = '\x90'; |
149 |
|
|
$CHARSET{C1}->{$_}->{r_ST} = '\x9C'; |
150 |
|
|
$CHARSET{C1}->{$_}->{r_OSC} = '\x9D'; |
151 |
|
|
$CHARSET{C1}->{$_}->{r_PM} = '\x9E'; |
152 |
|
|
$CHARSET{C1}->{$_}->{r_APC} = '\x9F'; |
153 |
|
|
$CHARSET{C1}->{$_}->{reset_all} = {"\x85"=>1, "\x90"=>1, |
154 |
|
|
"\x9C"=>1, "\x9D"=>1, "\x9E"=>1, "\x9F"=>1}; |
155 |
|
|
} |
156 |
|
|
$CHARSET{C1}->{'64291991C1'}->{r_SCI} = '\x9A'; |
157 |
|
|
|
158 |
|
|
$CHARSET{single_control}->{Fs} ={ucs => 0x70005000, chars => 32, dimension => 1}; |
159 |
|
|
$CHARSET{single_control}->{'3F'} ={ucs => 0x70005020, chars => 80, dimension => 1}; |
160 |
|
|
$CHARSET{single_control}->{'3F!'}={ucs => 0x70005070, chars => 80, dimension => 1}; |
161 |
|
|
$CHARSET{single_control}->{'3F"'}={ucs => 0x700050C0, chars => 80, dimension => 1}; |
162 |
|
|
$CHARSET{single_control}->{'3F#'}={ucs => 0x70005110, chars => 80, dimension => 1}; |
163 |
|
|
} |
164 |
|
|
|
165 |
|
|
&make_initial_coding_system; |
166 |
|
|
sub make_initial_coding_system { |
167 |
|
|
for (0x30..0x7E) { |
168 |
|
|
my $F = chr $_; |
169 |
|
|
$CODING_SYSTEM{$F} = {}; |
170 |
|
|
$CODING_SYSTEM{"\x2F".$F} = {reset_state => 1}; |
171 |
|
|
} |
172 |
wakaba |
1.2 |
$CODING_SYSTEM{Csjis} = {perl_name => 'shiftjis'}; |
173 |
wakaba |
1.1 |
} |
174 |
|
|
|
175 |
|
|
sub make_charset (%) { |
176 |
|
|
my %set = @_; |
177 |
|
|
my $setid = qq($set{I}$set{F}$set{revision}); |
178 |
|
|
my $settype = $set{type} || 'G94'; |
179 |
|
|
delete $set{type}, $set{I}, $set{F}, $set{revision}; |
180 |
|
|
$CHARSET{ $settype }->{ $setid } = \%set; |
181 |
|
|
} |
182 |
|
|
|
183 |
wakaba |
1.2 |
## Make a new ISO/IEC 2022-buffers object with default status |
184 |
|
|
sub new_object { |
185 |
|
|
my %C; |
186 |
|
|
$C{bit} = 8; |
187 |
|
|
$C{CL} = 'C0'; $C{CR} = 'C1'; $C{ESC_Fe} = 'C1'; |
188 |
|
|
$C{C0} = $CHARSET{C0}->{"\x40"}; ## ISO/IEC 6429:1991 C0 |
189 |
|
|
$C{C1} = $CHARSET{C1}->{'64291991C1'}; ## ISO/IEC 6429:1991 C1 |
190 |
|
|
$C{GL} = 'G0'; $C{GR} = 'G1'; |
191 |
|
|
$C{G0} = $CHARSET{G94}->{"\x42"}; ## ISO/IEC 646:1991 IRV |
192 |
|
|
#$C{G1} = $CHARSET{G96}->{"\x41"}; ## ISO/IEC 8859-1 GR |
193 |
|
|
$C{G1} = $CHARSET{G94}->{"\x7E"}; ## empty set |
194 |
|
|
$C{G2} = $CHARSET{G94}->{"\x7E"}; ## empty set |
195 |
|
|
$C{G3} = $CHARSET{G94}->{"\x7E"}; ## empty set |
196 |
|
|
$C{coding_system} = $CODING_SYSTEM{"\x40"}; ## ISO/IEC 2022 |
197 |
|
|
$C{option} = { |
198 |
|
|
C1invoke_to_right => 0, ## C1 invoked to: (0: ESC Fe, 1: CR) |
199 |
|
|
G94n_designate_long => 0, ## (1: ESC 02/04 02/08 04/00..02) |
200 |
|
|
designate_to => { ## Designated G buffer (-1: not be outputed) |
201 |
|
|
C0 => { |
202 |
|
|
default => 0, |
203 |
|
|
}, |
204 |
|
|
C1 => { |
205 |
|
|
default => 1, |
206 |
|
|
}, |
207 |
|
|
G94 => { |
208 |
|
|
"\x42" => 0, |
209 |
|
|
default => 0, |
210 |
|
|
}, |
211 |
|
|
G96 => { |
212 |
|
|
default => 1, |
213 |
|
|
}, |
214 |
|
|
G94n => { |
215 |
|
|
default => 0, |
216 |
|
|
}, |
217 |
|
|
G96n => { |
218 |
|
|
default => 1, |
219 |
|
|
}, |
220 |
|
|
coding_system => { |
221 |
|
|
default => -1, |
222 |
|
|
}, |
223 |
|
|
}, |
224 |
|
|
Ginvoke_by_single_shift => [0,0,0,0], ## Invoked by SS |
225 |
|
|
Ginvoke_to_left => [1,1,1,1], ## Which invoked to? (1: L, 0: R) |
226 |
|
|
private_set => { ## Private set vs Final byte |
227 |
|
|
C0 => [], |
228 |
|
|
C1 => [], |
229 |
|
|
G94 => [], |
230 |
|
|
G94n => [[],[],[],[],[]], |
231 |
|
|
G96 => [], |
232 |
|
|
#G96n => [], ## (not implemented) |
233 |
|
|
U96n => [], ## mule-unicode sets |
234 |
|
|
XC1 => { |
235 |
|
|
'64291991C1' => undef, ## ISO/IEC 6429:1991 C1 |
236 |
|
|
}, |
237 |
|
|
}, |
238 |
|
|
reset => { ## Reset status at top of line |
239 |
|
|
Gdesignation => "\x42", ## F of designation or 0 |
240 |
|
|
Ginvoke => 1, |
241 |
|
|
}, |
242 |
|
|
undef_char => ["\x3F", {type => 'G94', charset => 'B'}], |
243 |
|
|
use_revision => 1, ## Output IRR |
244 |
|
|
}; |
245 |
|
|
\%C; |
246 |
|
|
} |
247 |
|
|
|
248 |
wakaba |
1.1 |
1; |
249 |
|
|
__END__ |
250 |
|
|
|
251 |
|
|
=head1 AUTHORS |
252 |
|
|
|
253 |
|
|
Nanashi-san |
254 |
|
|
|
255 |
|
|
Wakaba <w@suika.fam.cx> |
256 |
|
|
|
257 |
|
|
=head1 LICENSE |
258 |
|
|
|
259 |
|
|
Copyright 2002 AUTHORS |
260 |
|
|
|
261 |
|
|
This library is free software; you can redistribute it |
262 |
|
|
and/or modify it under the same terms as Perl itself. |
263 |
|
|
|
264 |
|
|
=cut |
265 |
|
|
|
266 |
wakaba |
1.2 |
# $Date: 2002/09/20 14:01:45 $ |
267 |
wakaba |
1.1 |
### Charset.pm ends here |