48 |
*CHARSET = \%Encode::Charset::CHARSET; |
*CHARSET = \%Encode::Charset::CHARSET; |
49 |
*CODING_SYSTEM = \%Encode::Charset::CODING_SYSTEM; |
*CODING_SYSTEM = \%Encode::Charset::CODING_SYSTEM; |
50 |
|
|
|
### --- Intialization |
|
|
|
|
|
my %_CHARS_to_RANGE = ( |
|
|
l94 => q/[\x21-\x7E]/, |
|
|
l96 => q/[\x20-\x7F]/, |
|
|
l128 => q/[\x00-\x7F]/, |
|
|
l256 => q/[\x00-\xFF]/, |
|
|
r94 => q/[\xA1-\xFE]/, |
|
|
r96 => q/[\xA0-\xFF]/, |
|
|
r128 => q/[\x80-\xFF]/, |
|
|
r256 => q/[\x80-\xFF]/, |
|
|
b94 => q/[\x21-\x7E\xA1-\xFE]/, |
|
|
b96 => q/[\x20-\x7F\xA0-\xFF]/, |
|
|
b128 => q/[\x00-\xFF]/, |
|
|
b256 => q/[\x00-\xFF]/, |
|
|
); |
|
|
|
|
51 |
### --- Perl Encode module common functions |
### --- Perl Encode module common functions |
52 |
|
|
53 |
sub encode ($$;$) { |
sub encode ($$;$) { |
66 |
### --- Encode::ISO2022 unique functions |
### --- Encode::ISO2022 unique functions |
67 |
*new_object = \&Encode::Charset::new_object; |
*new_object = \&Encode::Charset::new_object; |
68 |
|
|
69 |
sub iso2022_to_internal ($;\%) { |
sub iso2022_to_internal ($;%) { |
70 |
my ($s, $C) = @_; |
my ($s, $C) = @_; |
71 |
$C ||= &new_object; |
$C ||= &new_object; |
72 |
my $t = ''; |
my $t = ''; |
73 |
$s =~ s{ |
$s =~ s{^((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*)}{ |
|
^((?:(?!\x1B\x25\x2F?[\x30-\x7E]).)*) |
|
|
}{ |
|
74 |
my $i2 = $1; |
my $i2 = $1; |
75 |
$t = _iso2022_to_internal ($i2, $C); |
$t = _iso2022_to_internal ($i2, $C); |
76 |
''; |
''; |
77 |
}gesx; |
}es; |
78 |
my $pad = ''; |
my $pad = ''; |
79 |
use re 'eval'; |
use re 'eval'; |
80 |
$s =~ s{ |
$s =~ s{ |
123 |
$t . $s; |
$t . $s; |
124 |
} |
} |
125 |
|
|
126 |
sub _iso2022_to_internal ($;\%) { |
# this is very very trickey. my perl 5.8.0 does not process |
127 |
|
# regex with eval except the first time (i think it's a bug |
128 |
|
# of perl), so we redefine this function whenever being called! |
129 |
|
# when this unexpected behavior is fixed or someone finds |
130 |
|
# better way to avoid it, we will rewrite this code. |
131 |
|
&_iso2022_to_internal (undef); |
132 |
|
sub _iso2022_to_internal ($;%) { |
133 |
|
eval q{ sub __iso2022_to_internal ($;%) { 0 } }; |
134 |
|
eval q{ |
135 |
|
sub __iso2022_to_internal ($;%) { |
136 |
|
use re 'eval'; |
137 |
my ($s, $C) = @_; |
my ($s, $C) = @_; |
138 |
my %_GB_to_GN = ( |
my %_GB_to_GN = ( |
139 |
"\x28"=>'G0',"\x29"=>'G1',"\x2A"=>'G2',"\x2B"=>'G3', |
"\x28"=>'G0',"\x29"=>'G1',"\x2A"=>'G2',"\x2B"=>'G3', |
140 |
"\x2C"=>'G0',"\x2D"=>'G1',"\x2E"=>'G2',"\x2F"=>'G3', |
"\x2C"=>'G0',"\x2D"=>'G1',"\x2E"=>'G2',"\x2F"=>'G3', |
141 |
); |
); |
142 |
|
my %_CHARS_to_RANGE = ( |
143 |
|
l94 => q/[\x21-\x7E]/, l96 => q/[\x20-\x7F]/, |
144 |
|
l128 => q/[\x00-\x7F]/, l256 => q/[\x00-\xFF]/, |
145 |
|
r94 => q/[\xA1-\xFE]/, r96 => q/[\xA0-\xFF]/, |
146 |
|
r128 => q/[\x80-\xFF]/, r256 => q/[\x80-\xFF]/, |
147 |
|
b94 => q/[\x21-\x7E\xA1-\xFE]/, b96 => q/[\x20-\x7F\xA0-\xFF]/, |
148 |
|
b128 => q/[\x00-\xFF]/, b256 => q/[\x00-\xFF]/, |
149 |
|
); |
150 |
|
|
|
use re 'eval'; |
|
151 |
$s =~ s{ |
$s =~ s{ |
152 |
((??{ $_CHARS_to_RANGE{'l'.$C->{$C->{GL}}->{chars}} |
((??{ $_CHARS_to_RANGE{'l'.$C->{$C->{GL}}->{chars}} |
153 |
. qq/{$C->{$C->{GL}}->{dimension},$C->{$C->{GL}}->{dimension}}/ })) |
. qq/{$C->{$C->{GL}}->{dimension},$C->{$C->{GL}}->{dimension}}/ })) |
154 |
|((??{ $_CHARS_to_RANGE{'r'.$C->{$C->{GR}}->{chars}} |
|((??{ $_CHARS_to_RANGE{'r'.$C->{$C->{GR}}->{chars}} |
155 |
. qq/{$C->{$C->{GR}}->{dimension},$C->{$C->{GR}}->{dimension}}/ })) |
. qq/{$C->{$C->{GR}}->{dimension},$C->{$C->{GR}}->{dimension}}/ })) |
156 |
| (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS2} || '(?!)') |
| (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS2} || '(?!)') |
157 |
. ($C->{$C->{ESC_Fe}}->{r_SS2_ESC} ? |
. ($C->{$C->{ESC_Fe}}->{r_SS2_ESC} ? |
158 |
qq/|$C->{$C->{ESC_Fe}}->{r_SS2_ESC}/ : '') |
qq/|$C->{$C->{ESC_Fe}}->{r_SS2_ESC}/ : '') |
162 |
qq/[$C->{$C->{CL}}->{r_LS0}$C->{$C->{CL}}->{r_LS1}]*/:'') |
qq/[$C->{$C->{CL}}->{r_LS0}$C->{$C->{CL}}->{r_LS1}]*/:'') |
163 |
}) |
}) |
164 |
((??{ $_CHARS_to_RANGE{'b'.$C->{G2}->{chars}} |
((??{ $_CHARS_to_RANGE{'b'.$C->{G2}->{chars}} |
165 |
. qq/{$C->{G2}->{dimension},$C->{G2}->{dimension}}/ })) |
. qq/{$C->{G2}->{dimension},$C->{G2}->{dimension}}/ })) |
166 |
| (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS3} || '(?!)') |
| (??{ q/(?:/ . ($C->{$C->{CR}}->{r_SS3} || '(?!)') |
167 |
. ($C->{$C->{ESC_Fe}}->{r_SS3_ESC} ? |
. ($C->{$C->{ESC_Fe}}->{r_SS3_ESC} ? |
168 |
qq/|$C->{$C->{ESC_Fe}}->{r_SS3_ESC}/ : '') |
qq/|$C->{$C->{ESC_Fe}}->{r_SS3_ESC}/ : '') |
206 |
$c = $c * $C->{$C->{GL}}->{chars} + unpack ('C', $_) - $m; |
$c = $c * $C->{$C->{GL}}->{chars} + unpack ('C', $_) - $m; |
207 |
} |
} |
208 |
chr ($C->{$C->{GL}}->{ucs} + $c); |
chr ($C->{$C->{GL}}->{ucs} + $c); |
|
## Control, SP, or broken data |
|
|
## TODO: support control sets other than ISO/IEC 6429's |
|
|
} elsif (defined $misc) { |
|
|
$misc; |
|
209 |
## GR graphic character |
## GR graphic character |
210 |
} elsif ($gr) { |
} elsif ($gr) { |
211 |
my $c = 0; |
my $c = 0; |
214 |
$c = $c * $C->{$C->{GR}}->{chars} + unpack ('C', $_) - $m; |
$c = $c * $C->{$C->{GR}}->{chars} + unpack ('C', $_) - $m; |
215 |
} |
} |
216 |
chr ($C->{$C->{GR}}->{ucs} + $c); |
chr ($C->{$C->{GR}}->{ucs} + $c); |
217 |
|
## Control, SP, or broken data |
218 |
|
## TODO: support control sets other than ISO/IEC 6429's |
219 |
|
} elsif (defined $misc) { |
220 |
|
$misc; |
221 |
## Graphic character with SS2 |
## Graphic character with SS2 |
222 |
} elsif ($ss2) { |
} elsif ($ss2) { |
223 |
$ss2 =~ tr/\x80-\xFF/\x00-\x7F/; |
$ss2 =~ tr/\x80-\xFF/\x00-\x7F/; |
236 |
chr ($C->{G3}->{ucs} + $c); |
chr ($C->{G3}->{ucs} + $c); |
237 |
## Escape sequence |
## Escape sequence |
238 |
} elsif ($esc) { |
} elsif ($esc) { |
239 |
## IRR (revision number) |
if ($esc =~ /\x1B\x26([\x40-\x7E])/) { ## 6F (IRR) = ESC 02/06 Ft |
|
if ($esc =~ /\x1B\x26([\x40-\x7E])/) { |
|
240 |
$C->{_irr} = $1; $esc = ''; |
$C->{_irr} = $1; $esc = ''; |
241 |
} else { |
} else { |
242 |
$esc =~ s{ |
$esc =~ s{ |
260 |
$CZD, $C1D, $Fs, $sI, $sF,$ACS) |
$CZD, $C1D, $Fs, $sI, $sF,$ACS) |
261 |
= ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13,$14,$15); |
= ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13,$14,$15); |
262 |
my $rev = $C->{_irr} || ''; |
my $rev = $C->{_irr} || ''; |
263 |
if ($g94_g) { |
my $f2s = $C->{option}->{final_to_set}; |
264 |
$C->{ $_GB_to_GN{ $g94_g } } = $CHARSET{G94}->{ $g94_f.$rev } |
if ($g94_g) { ## ESC 02/08 [I] F |
265 |
|| $CHARSET{G94}->{ $g94_f } |
$C->{ $_GB_to_GN{ $g94_g } } |
266 |
|| $CHARSET{G94}->{ "\x7E" }; ''; |
= $CHARSET{G94}->{ $f2s->{G94}->{$g94_f.$rev} || $g94_f.$rev } |
267 |
} elsif (defined $g94n_f) { |
|| $CHARSET{G94}->{ $f2s->{G94}->{$g94_f} || $g94_f } |
268 |
$C->{ $_GB_to_GN{ $g94n_g } || 'G0' } = $CHARSET{G94n}->{ $g94n_f.$rev } |
|| $CHARSET{G94}->{ "\x7E" }; ''; |
269 |
|| $CHARSET{G94n}->{ $g94n_f } |
} elsif (defined $g94n_f) { ## ESC 02/04 [02/08..11] [I] F |
270 |
|| $CHARSET{G94n}->{ "\x7E" }; ''; |
$C->{ $_GB_to_GN{ $g94n_g } || 'G0' } |
271 |
} elsif ($g96_g) { |
= $CHARSET{G94n}->{ $f2s->{G94n}->{$g94n_f.$rev} || $g94n_f.$rev } |
272 |
$C->{ $_GB_to_GN{ $g96_g } } = $CHARSET{G96}->{ $g96_f.$rev } |
|| $CHARSET{G94n}->{ $f2s->{G94n}->{$g94n_f} || $g94n_f } |
273 |
|| $CHARSET{G96}->{ $g96_f } |
|| $CHARSET{G94n}->{ "\x7E" }; ''; |
274 |
|| $CHARSET{G96}->{ "\x7E" }; ''; |
} elsif ($g96_g) { ## ESC 02/12..15 [I] F |
275 |
} elsif (defined $g96n_f) { |
$C->{ $_GB_to_GN{ $g96_g } } |
276 |
$C->{ $_GB_to_GN{ $g96n_g } } = $CHARSET{G96n}->{ $g96n_f.$rev } |
= $CHARSET{G96}->{ $f2s->{G96}->{$g96_f.$rev} || $g96_f.$rev } |
277 |
|| $CHARSET{G96n}->{ $g96n_f } |
|| $CHARSET{G96}->{ $f2s->{G96}->{$g96_f} || $g96_f } |
278 |
|| $CHARSET{G96n}->{ "\x7E" }; ''; |
|| $CHARSET{G96}->{ "\x7E" }; ''; |
279 |
} elsif ($Fe) { ## ESC Fe => C1 |
} elsif ($g96n_g) { ## ESC 02/04 02/12..15 [I] F |
280 |
|
$C->{ $_GB_to_GN{ $g96n_g } } |
281 |
|
= $CHARSET{G96n}->{ $f2s->{G96n}->{$g96n_f.$rev} || $g96n_f.$rev } |
282 |
|
|| $CHARSET{G96n}->{ $f2s->{G96n}->{$g96n_f} || $g96n_f } |
283 |
|
|| $CHARSET{G96n}->{ "\x7E" }; ''; |
284 |
|
} elsif ($Fe) { ## ESC Fe = C1 |
285 |
chr ($C->{ $C->{ESC_Fe} }->{ucs} + (ord ($Fe) - 0x40)); |
chr ($C->{ $C->{ESC_Fe} }->{ucs} + (ord ($Fe) - 0x40)); |
286 |
} elsif ($CZD) { |
} elsif (defined $Fs) { ## ESC Fs |
|
$C->{C0} = $CHARSET{C0}->{ $CZD.$rev } |
|
|
|| $CHARSET{C0}->{ $CZD } || $CHARSET{C0}->{ "\x7E" }; ''; |
|
|
} elsif ($C1D) { |
|
|
$C->{C1} = $CHARSET{C1}->{ $C1D.$rev } |
|
|
|| $CHARSET{C1}->{ $C1D } || $CHARSET{C1}->{ "\x7E" }; ''; |
|
|
} elsif ($Fs) { |
|
287 |
if ($Fs eq "\x6E") { ## LS2 |
if ($Fs eq "\x6E") { ## LS2 |
288 |
$C->{GL} = 'G2'; ''; |
$C->{GL} = 'G2'; ''; |
289 |
} elsif ($Fs eq "\x6F") { ## LS3 |
} elsif ($Fs eq "\x6F") { ## LS3 |
297 |
} else { |
} else { |
298 |
chr ($CHARSET{single_control}->{Fs}->{ucs} + (ord ($Fs) - 0x60)); |
chr ($CHARSET{single_control}->{Fs}->{ucs} + (ord ($Fs) - 0x60)); |
299 |
} |
} |
300 |
} elsif ($sI) { |
} elsif (defined $CZD) { ## 1F (CZD) = ESC 02/01 [I] F |
301 |
|
$C->{C0} = $CHARSET{C0}->{ $f2s->{C0}->{$CZD.$rev} || $CZD.$rev } |
302 |
|
|| $CHARSET{C0}->{ $f2s->{C0}->{$CZD} || $CZD } |
303 |
|
|| $CHARSET{C0}->{ "\x7E" }; ''; |
304 |
|
} elsif (defined $C1D) { ## 2F (C1D) = ESC 02/02 [I] F |
305 |
|
$C->{C1} = $CHARSET{C1}->{ $f2s->{C1}->{$C1D.$rev} || $C1D.$rev } |
306 |
|
|| $CHARSET{C1}->{ $f2s->{C1}->{$C1D} || $C1D } |
307 |
|
|| $CHARSET{C1}->{ "\x7E" }; ''; |
308 |
|
} elsif ($sI) { ## 3F = ESC 02/03 [I] F |
309 |
chr ($CHARSET{single_control}->{'3F'.$sI}->{ucs} + (ord ($sF) - 0x30)); |
chr ($CHARSET{single_control}->{'3F'.$sI}->{ucs} + (ord ($sF) - 0x30)); |
310 |
} elsif ($ACS) { ## Announcer |
} elsif ($ACS) { ## 0F (Announcer) = ESC 02/00 F |
311 |
if ($ACS eq "\x4A") { $C->{bit} = 7 } |
if ($ACS eq "\x4A") { $C->{bit} = 7 } |
312 |
elsif ($ACS eq "\x4B") { $C->{bit} = 8 } |
elsif ($ACS eq "\x4B") { $C->{bit} = 8 } |
313 |
''; |
''; |
316 |
$C->{_irr} = undef; |
$C->{_irr} = undef; |
317 |
} |
} |
318 |
$esc; |
$esc; |
319 |
## Locking shifts |
} elsif ($ls) { ## Locking shifts = LS0 / LS1 |
|
} elsif ($ls) { |
|
320 |
if ($ls eq $C->{$C->{CL}}->{LS0}) { |
if ($ls eq $C->{$C->{CL}}->{LS0}) { |
321 |
$C->{GL} = 'G0'; ''; |
$C->{GL} = 'G0'; ''; |
322 |
} elsif ($ls eq $C->{$C->{CL}}->{LS1}) { |
} elsif ($ls eq $C->{$C->{CL}}->{LS1}) { |
323 |
$C->{GL} = 'G1'; ''; |
$C->{GL} = 'G1'; ''; |
324 |
} |
} |
325 |
## Control sequence |
} elsif ($csi) { ## Control sequence = CSI [P..] [I] F |
|
} elsif ($csi) { |
|
326 |
$csi =~ tr/\xA0-\xFF/\x20-\x7F/d; |
$csi =~ tr/\xA0-\xFF/\x20-\x7F/d; |
327 |
$csi =~ s/$C->{$C->{CL}}->{LS0}//g if $C->{$C->{CL}}->{LS0}; |
$csi =~ s/$C->{$C->{CL}}->{LS0}//g if $C->{$C->{CL}}->{LS0}; |
328 |
$csi =~ s/$C->{$C->{CL}}->{LS1}//g if $C->{$C->{CL}}->{LS1}; |
$csi =~ s/$C->{$C->{CL}}->{LS1}//g if $C->{$C->{CL}}->{LS1}; |
329 |
"\x9B".$csi; |
"\x9B".$csi; |
330 |
} |
} |
331 |
}gex; |
}gesx; |
332 |
$s; |
$s; |
333 |
} |
} # __iso2022_to_internal |
334 |
|
|
335 |
|
}; |
336 |
|
&__iso2022_to_internal (@_) if defined $_[0]; |
337 |
|
|
338 |
|
} # _iso2022_to_internal |
339 |
|
|
340 |
sub internal_to_iso2022 ($\%) { |
sub internal_to_iso2022 ($;%) { |
341 |
my ($s, $C) = @_; |
my ($s, $C) = @_; |
342 |
$C ||= &new_object; |
$C ||= &new_object; |
343 |
|
|
344 |
my $r = ''; |
my $r = ''; |
345 |
for my $c (split //, $s) { |
for my $c (split //, $s) { |
346 |
my $cc = ord $c; |
my $cc = ord $c; Encode::_utf8_off ($c); |
347 |
my $t; |
my $t; |
348 |
if ($cc <= 0x1F) { |
if ($cc <= 0x1F) { |
349 |
$t = _i2c ($c, $C, type => 'C0', charset => '@'); |
$t = _i2c ($c, $C, type => 'C0', charset => '@'); |
352 |
} elsif ($cc < 0x7F) { |
} elsif ($cc < 0x7F) { |
353 |
$t = _i2g ($c, $C, type => 'G94', charset => 'B'); |
$t = _i2g ($c, $C, type => 'G94', charset => 'B'); |
354 |
} elsif ($cc <= 0x9F) { |
} elsif ($cc <= 0x9F) { |
355 |
$t = _i2c ($c, $C, type => 'C1', charset_id => '64291991C1', |
$t = _i2c (pack ('C', $cc), $C, type => 'C1', charset_id => '64291991C1', |
356 |
charset => $C->{private_set}->{XC1}->{'64291991C1'}); |
charset => $C->{option}->{private_set}->{XC1}->{'64291991C1'}); |
357 |
} elsif ($cc <= 0xFF) { |
} elsif ($cc <= 0xFF) { |
358 |
$t = _i2g (chr($cc-0x80), $C, type => 'G96', charset => 'A'); |
$t = _i2g (pack ('C', $cc-0x80), $C, type => 'G96', charset => 'A'); |
359 |
} elsif ($cc <= 0x24FF) { |
} elsif ($cc <= 0x24FF) { |
360 |
my $c = $cc - 0x100; |
my $c = $cc - 0x100; |
361 |
my $final = $C->{private_set}->{U96n}->[0]; |
my $final = $C->{option}->{private_set}->{U96n}->[0]; |
362 |
if (length $final) { |
if (length $final) { |
363 |
$t = _i2g (chr(($c / 96)+0x20).chr(($c % 96)+0x20), $C, |
$t = _i2g (chr(($c / 96)+0x20).chr(($c % 96)+0x20), $C, |
364 |
type => 'G96n', charset => $final); |
type => 'G96n', charset => $final); |
365 |
} |
} |
366 |
} elsif ($cc <= 0x33FF) { |
} elsif ($cc <= 0x33FF) { |
367 |
my $c = $cc - 0x2500; |
my $c = $cc - 0x2500; |
368 |
my $final = $C->{private_set}->{U96n}->[1]; |
my $final = $C->{option}->{private_set}->{U96n}->[1]; |
369 |
if (length $final) { |
if (length $final) { |
370 |
$t = _i2g (chr(($c / 96)+0x20).chr(($c % 96)+0x20), $C, |
$t = _i2g (chr(($c / 96)+0x20).chr(($c % 96)+0x20), $C, |
371 |
type => 'G96n', charset => $final); |
type => 'G96n', charset => $final); |
372 |
} |
} |
373 |
} elsif (0xE000 <= $cc && $cc <= 0xFFFF) { |
} elsif (0xE000 <= $cc && $cc <= 0xFFFF) { |
374 |
my $c = $cc - 0xE000; |
my $c = $cc - 0xE000; |
375 |
my $final = $C->{private_set}->{U96n}->[2]; |
my $final = $C->{option}->{private_set}->{U96n}->[2]; |
376 |
if (length $final) { |
if (length $final) { |
377 |
$t = _i2g (chr(($c / 96)+0x20).chr(($c % 96)+0x20), $C, |
$t = _i2g (chr(($c / 96)+0x20).chr(($c % 96)+0x20), $C, |
378 |
type => 'G96n', charset => $final); |
type => 'G96n', charset => $final); |
438 |
} elsif (0x70400000 <= $cc && $cc <= 0x7040FFED) { |
} elsif (0x70400000 <= $cc && $cc <= 0x7040FFED) { |
439 |
my $c = $cc - 0x70400000; |
my $c = $cc - 0x70400000; |
440 |
$t = _i2g (chr(($c % 94)+0x21), $C, charset_id => 'P'.int ($c / 94), |
$t = _i2g (chr(($c % 94)+0x21), $C, charset_id => 'P'.int ($c / 94), |
441 |
type => 'G94', charset => $C->{private_set}->{G94}->[ $c / 94 ]); |
type => 'G94', charset => $C->{option}->{private_set}->{G94}->[ $c / 94 ]); |
442 |
} elsif (0x70410000 <= $cc && $cc <= 0x7041FFBF) { |
} elsif (0x70410000 <= $cc && $cc <= 0x7041FFBF) { |
443 |
my $c = $cc - 0x70410000; |
my $c = $cc - 0x70410000; |
444 |
$t = _i2g (chr(($c % 96)+0x20), $C, charset_id => 'P'.int ($c / 96), |
$t = _i2g (chr(($c % 96)+0x20), $C, charset_id => 'P'.int ($c / 96), |
445 |
type => 'G96', charset => $C->{private_set}->{G96}->[ $c / 96 ]); |
type => 'G96', charset => $C->{option}->{private_set}->{G96}->[ $c / 96 ]); |
446 |
} elsif (0x70420000 <= $cc && $cc <= 0x7046F19B) { |
} elsif (0x70420000 <= $cc && $cc <= 0x7046F19B) { |
447 |
my $c = $cc % 0x10000; |
my $c = $cc % 0x10000; |
448 |
$t = _i2g (chr((($c % 8836) / 94)+0x21).chr(($c % 94)+0x21), $C, |
$t = _i2g (chr((($c % 8836) / 94)+0x21).chr(($c % 94)+0x21), $C, |
449 |
type => 'G94n', |
type => 'G94n', |
450 |
charset_id => 'P'.int(($cc / 0x10000) - 0x7042).'_'.int($c / 8836), |
charset_id => 'P'.int(($cc / 0x10000) - 0x7042).'_'.int($c / 8836), |
451 |
charset => $C->{private_set}->{G94n}->[ ($cc / 0x10000) - 0x7042 ] |
charset => $C->{option}->{private_set}->{G94n} |
452 |
->[ $c / 8836 ]); |
->[ ($cc / 0x10000) - 0x7042 ]->[ $c / 8836 ]); |
453 |
} |
} |
454 |
if (defined $t) { |
if (defined $t) { |
455 |
$t = _i2o ($t, $C, cs_F => "\x40") |
$t = _i2o ($t, $C, cs_F => "\x40") |
524 |
} |
} |
525 |
$r .= _back2ascii ($C, reset_all => $C->{C1}->{reset_all}->{$s}); |
$r .= _back2ascii ($C, reset_all => $C->{C1}->{reset_all}->{$s}); |
526 |
unless ($C->{option}->{C1invoke_to_right}) { ## ESC Fe |
unless ($C->{option}->{C1invoke_to_right}) { ## ESC Fe |
527 |
$s =~ s/([\x80-\x9F])/"\x1B" . chr (ord ($1) - 0x40)/ge; |
$s =~ s/([\x80-\x9F])/"\x1B" . pack ('C', ord ($1) - 0x40)/ge; |
528 |
} |
} |
529 |
return $r . $s; |
return $r . $s; |
530 |
} |
} |
641 |
if ($CS ne $C->{coding_system}) { |
if ($CS ne $C->{coding_system}) { |
642 |
my $e = ''; |
my $e = ''; |
643 |
$e .= "\x1B\x25"; |
$e .= "\x1B\x25"; |
644 |
$e .= $O{cs_F} || $C->{private_set}->{coding_system}->{ $O{cs_id} } |
$e .= $O{cs_F} || $C->{option}->{private_set}->{coding_system}->{ $O{cs_id} } |
645 |
|| return undef; |
|| return undef; |
646 |
if ($C->{coding_system} eq $CODING_SYSTEM{"\x2F\x40"} |
if ($C->{coding_system} eq $CODING_SYSTEM{"\x2F\x40"} |
647 |
|| $C->{coding_system} eq $CODING_SYSTEM{"\x2F\x43"} |
|| $C->{coding_system} eq $CODING_SYSTEM{"\x2F\x43"} |