with Interfaces; use Interfaces;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_JIS; use System.WCh_JIS;
package body System.WCh_Cnv is
function Char_Sequence_To_Wide_Char
(C : Character;
EM : WC_Encoding_Method)
return Wide_Character
is
B1 : Integer;
C1 : Character;
U : Unsigned_16;
W : Unsigned_16;
procedure Get_Hex (N : Character);
procedure Get_Hex (N : Character) is
B2 : constant Integer := Character'Pos (N);
begin
if B2 in Character'Pos ('0') .. Character'Pos ('9') then
B1 := B1 * 16 + B2 - Character'Pos ('0');
elsif B2 in Character'Pos ('A') .. Character'Pos ('F') then
B1 := B1 * 16 + B2 - (Character'Pos ('A') - 10);
elsif B2 in Character'Pos ('a') .. Character'Pos ('f') then
B1 := B1 * 16 + B2 - (Character'Pos ('a') - 10);
else
raise Constraint_Error;
end if;
end Get_Hex;
begin
case EM is
when WCEM_Hex =>
if C /= ASCII.ESC then
return Wide_Character'Val (Character'Pos (C));
else
B1 := 0;
Get_Hex (In_Char);
Get_Hex (In_Char);
Get_Hex (In_Char);
Get_Hex (In_Char);
return Wide_Character'Val (B1);
end if;
when WCEM_Upper =>
if C > ASCII.DEL then
return
Wide_Character'Val
(Integer (256 * Character'Pos (C)) +
Character'Pos (In_Char));
else
return Wide_Character'Val (Character'Pos (C));
end if;
when WCEM_Shift_JIS =>
if C > ASCII.DEL then
return Shift_JIS_To_JIS (C, In_Char);
else
return Wide_Character'Val (Character'Pos (C));
end if;
when WCEM_EUC =>
if C > ASCII.DEL then
return EUC_To_JIS (C, In_Char);
else
return Wide_Character'Val (Character'Pos (C));
end if;
when WCEM_UTF8 =>
if C > ASCII.DEL then
U := Unsigned_16 (Character'Pos (C));
if (U and 2#11100000#) = 2#11000000# then
W := Shift_Left (U and 2#00011111#, 6);
U := Unsigned_16 (Character'Pos (In_Char));
if (U and 2#11000000#) /= 2#10000000# then
raise Constraint_Error;
end if;
W := W or (U and 2#00111111#);
elsif (U and 2#11110000#) = 2#11100000# then
W := Shift_Left (U and 2#00001111#, 12);
U := Unsigned_16 (Character'Pos (In_Char));
if (U and 2#11000000#) /= 2#10000000# then
raise Constraint_Error;
end if;
W := W or Shift_Left (U and 2#00111111#, 6);
U := Unsigned_16 (Character'Pos (In_Char));
if (U and 2#11000000#) /= 2#10000000# then
raise Constraint_Error;
end if;
W := W or (U and 2#00111111#);
else
raise Constraint_Error;
end if;
return Wide_Character'Val (W);
else
return Wide_Character'Val (Character'Pos (C));
end if;
when WCEM_Brackets =>
if C /= '[' then
return Wide_Character'Val (Character'Pos (C));
end if;
if In_Char /= '"' then
raise Constraint_Error;
end if;
B1 := 0;
Get_Hex (In_Char);
Get_Hex (In_Char);
C1 := In_Char;
if C1 /= '"' then
Get_Hex (C1);
Get_Hex (In_Char);
C1 := In_Char;
if C1 /= '"' then
raise Constraint_Error;
end if;
end if;
if In_Char /= ']' then
raise Constraint_Error;
end if;
return Wide_Character'Val (B1);
end case;
end Char_Sequence_To_Wide_Char;
procedure Wide_Char_To_Char_Sequence
(WC : Wide_Character;
EM : WC_Encoding_Method)
is
Val : constant Natural := Wide_Character'Pos (WC);
Hexc : constant array (0 .. 15) of Character := "0123456789ABCDEF";
C1, C2 : Character;
U : Unsigned_16;
begin
case EM is
when WCEM_Hex =>
if Val < 256 then
Out_Char (Character'Val (Val));
else
Out_Char (ASCII.ESC);
Out_Char (Hexc (Val / (16**3)));
Out_Char (Hexc ((Val / (16**2)) mod 16));
Out_Char (Hexc ((Val / 16) mod 16));
Out_Char (Hexc (Val mod 16));
end if;
when WCEM_Upper =>
if Val < 128 then
Out_Char (Character'Val (Val));
elsif Val < 16#8000# then
raise Constraint_Error;
else
Out_Char (Character'Val (Val / 256));
Out_Char (Character'Val (Val mod 256));
end if;
when WCEM_Shift_JIS =>
if Val < 128 then
Out_Char (Character'Val (Val));
else
JIS_To_Shift_JIS (WC, C1, C2);
Out_Char (C1);
Out_Char (C2);
end if;
when WCEM_EUC =>
if Val < 128 then
Out_Char (Character'Val (Val));
else
JIS_To_EUC (WC, C1, C2);
Out_Char (C1);
Out_Char (C2);
end if;
when WCEM_UTF8 =>
U := Unsigned_16 (Val);
if U < 16#80# then
Out_Char (Character'Val (U));
elsif U < 16#0800# then
Out_Char (Character'Val (2#11000000# or Shift_Right (U, 6)));
Out_Char (Character'Val (2#10000000# or (U and 2#00111111#)));
else
Out_Char (Character'Val (2#11100000# or Shift_Right (U, 12)));
Out_Char (Character'Val (2#10000000# or (Shift_Right (U, 6)
and 2#00111111#)));
Out_Char (Character'Val (2#10000000# or (U and 2#00111111#)));
end if;
when WCEM_Brackets =>
if Val < 256 then
Out_Char (Character'Val (Val));
else
Out_Char ('[');
Out_Char ('"');
Out_Char (Hexc (Val / (16**3)));
Out_Char (Hexc ((Val / (16**2)) mod 16));
Out_Char (Hexc ((Val / 16) mod 16));
Out_Char (Hexc (Val mod 16));
Out_Char ('"');
Out_Char (']');
end if;
end case;
end Wide_Char_To_Char_Sequence;
end System.WCh_Cnv;