52 |
$f -= $f < 0xA0 ? 0x81 : 0xC1; $s -= 0x40 + ($s > 0x7F); |
$f -= $f < 0xA0 ? 0x81 : 0xC1; $s -= 0x40 + ($s > 0x7F); |
53 |
chr ($C->{G1}->{ucs} + $f * 188 + $s); |
chr ($C->{G1}->{ucs} + $f * 188 + $s); |
54 |
} else { ## [\xF0-\xFC]. |
} else { ## [\xF0-\xFC]. |
55 |
my ($f, $s) = unpack ('CC', $c2); |
my ($f, $s) = (ord substr ($c2, 0, 1), ord substr ($c2, 1, 1)); |
56 |
if ($C->{G3}->{Csjis_kuE}) { |
if ($C->{G3}->{Csjis_kuE}) { ## 94^2 set with first-byte->ku mapping |
57 |
$f = $s > 0x9E ? $C->{G3}->{Csjis_kuE}->{ $f }: |
my $F = $s > 0x9E ? $C->{G3}->{Csjis_kuE}->{ $f }: ## ku of even number |
58 |
$C->{G3}->{Csjis_kuO}->{ $f }; |
$C->{G3}->{Csjis_kuO}->{ $f }; ## ku of odd number |
59 |
$s -= ($s > 0x9E ? 0x9F : $s > 0x7F ? 0x41 : 0x40); |
if (defined $F) { |
60 |
chr ($C->{G3}->{ucs} + $f * 94 + $s); |
$s -= ($s > 0x9E ? 0x9F : $s > 0x7F ? 0x41 : 0x40); |
61 |
} else { |
chr ($C->{G3}->{ucs} + $F * 94 + $s); |
62 |
|
} else { ## Mapping is not defined |
63 |
|
$f -= 0xF0; $s -= 0x40 + ($s > 0x7F); |
64 |
|
chr ($Encode::Charset::CHARSET{G94n}->{"\x20\x40"}->{ucs} + $f * 188 + $s); |
65 |
|
} |
66 |
|
} elsif ($C->{G3}->{Csjis_ku}) { ## n^2 set with first-byte->ku mapping |
67 |
|
if (defined $C->{G3}->{Csjis_ku}->{ $f }) { |
68 |
|
$f = $C->{G3}->{Csjis_ku}->{ $f }; |
69 |
|
$s -= ($s > 0x9E ? 0x9F : $s > 0x7F ? 0x41 : 0x40); |
70 |
|
chr ($C->{G3}->{ucs} + $f * $C->{G3}->{chars} + $s); |
71 |
|
} else { ## Mapping is not defined |
72 |
|
$f -= 0xF0; $s -= 0x40 + ($s > 0x7F); |
73 |
|
chr ($Encode::Charset::CHARSET{G94n}->{"\x20\x40"}->{ucs} + $f * 188 + $s); |
74 |
|
} |
75 |
|
} else { ## 94^2 set without special mapping information |
76 |
$f -= 0xF0; $s -= 0x40 + ($s > 0x7F); |
$f -= 0xF0; $s -= 0x40 + ($s > 0x7F); |
77 |
chr ($C->{G3}->{ucs} + $f * 188 + $s); |
chr ($C->{G3}->{ucs} + $f * 188 + $s); |
78 |
} |
} |
164 |
if ($c / 188) + 0xF0 < 0xFD; |
if ($c / 188) + 0xF0 < 0xFD; |
165 |
} |
} |
166 |
} |
} |
167 |
|
## Non-ISO/IEC 2022 Coded Character Sets Mapping Area |
168 |
|
} elsif (0x71000000 <= $cc && $cc <= 0x71FFFFFF) { |
169 |
|
if ($C->{G3}->{ucs} <= $cc) { |
170 |
|
my $c = $cc - $C->{G3}->{ucs}; |
171 |
|
my $f = $C->{G3}->{Csjis_first}->{$c / $C->{G3}->{chars}}; |
172 |
|
if ($f) { |
173 |
|
my $s = $c % $C->{G3}->{chars}; |
174 |
|
$t = pack ('CC', $f, 0x40 + $s + ($s > 62)); |
175 |
|
} |
176 |
|
} |
177 |
## Other character sets are not supported now (and there is no plan to implement them). |
## Other character sets are not supported now (and there is no plan to implement them). |
178 |
} |
} |
179 |
|
|
193 |
## |
## |
194 |
} else { |
} else { |
195 |
## Try to output with fallback escape sequence (if specified) |
## Try to output with fallback escape sequence (if specified) |
196 |
my $t = Encode::Charset::fallback_escape ($C, $c); |
my $t = Encode::Charset->fallback_escape ($C, $c); |
197 |
if (defined $t) { |
if (defined $t) { |
198 |
my %D = (fallback => $C->{option}->{fallback_from_ucs}, reset => $C->{option}->{reset}); |
my %D = (fallback => $C->{option}->{fallback_from_ucs}, reset => $C->{option}->{reset}); |
199 |
$C->{option}->{fallback_from_ucs} = 'croak'; |
$C->{option}->{fallback_from_ucs} = 'croak'; |
|
$C->{option}->{reset} = {Gdesignation => 0, Ginvoke => 0}; |
|
200 |
eval q{$t = $C->{_encoder}->_encode_internal ($t, $C)} or undef $t; |
eval q{$t = $C->{_encoder}->_encode_internal ($t, $C)} or undef $t; |
201 |
$C->{option}->{fallback_from_ucs} = $D{fallback}; |
$C->{option}->{fallback_from_ucs} = $D{fallback}; |
|
$C->{option}->{reset} = $D{reset}; |
|
202 |
} |
} |
203 |
if (defined $t) { |
if (defined $t) { |
204 |
$r .= $t; |
$r .= $t; |
210 |
$r; |
$r; |
211 |
} |
} |
212 |
|
|
213 |
|
sub page_to_internal ($$) { |
214 |
|
my ($C, $s) = @_; |
215 |
|
$s = pack ('U*', unpack ('C*', $s)); |
216 |
|
$s =~ s(\x1B\x24([EFGOPQ])([\x21-\x7E]+)\x0F)( |
217 |
|
my $page = {qw/E 1 F 2 G 3 O 4 P 5 Q 6/}->{$1}; |
218 |
|
my $r = ''; |
219 |
|
for my $c (split //, $2) { |
220 |
|
$r .= chr ($Encode::Charset::CHARSET{G94}->{'CSpictogram_page_'.$page}->{ucs} + ord ($c) - 0x21); |
221 |
|
} |
222 |
|
$r; |
223 |
|
)gex; |
224 |
|
$s; |
225 |
|
} |
226 |
|
|
227 |
|
sub _internal_to_page ($$$%) { |
228 |
|
my ($yourself, $C, $c, $option) = @_; |
229 |
|
my $cc = ord $c; |
230 |
|
for my $page (1..6) { |
231 |
|
my $cs = $Encode::Charset::CHARSET{G94}->{'CSpictogram_page_'.$page}; |
232 |
|
if ($cs->{ucs} <= $cc && $cc < $cs->{ucs} + $cs->{chars} * $cs->{dimension}) { |
233 |
|
return "\x1B\x24" . ([qw/_ E F G O P Q/]->[$page]) |
234 |
|
.pack ('C', 0x21 + $cc - $cs->{ucs}) . "\x0F"; |
235 |
|
} |
236 |
|
} |
237 |
|
## $c is not a pictogram |
238 |
|
$option->{fallback_from_ucs} = $C->{option}->{fallback_from_ucs_2}; |
239 |
|
$yourself->fallback_escape ($C, $c, %$option); |
240 |
|
} |
241 |
|
|
242 |
=back |
=back |
243 |
|
|
244 |
=head1 SEE ALSO |
=head1 SEE ALSO |