with Interfaces; use Interfaces;
with System.WCh_Con; use System.WCh_Con;
with System.WCh_JIS; use System.WCh_JIS;
package body System.WCh_StW is
function String_To_Wide_String
(S : String;
EM : WC_Encoding_Method)
return Wide_String
is
R : Wide_String (1 .. S'Length);
RP : Natural;
SP : Natural;
U1 : Unsigned_16;
U2 : Unsigned_16;
U3 : Unsigned_16;
U : Unsigned_16;
Last : constant Natural := S'Last;
function Get_Hex (C : Character) return Unsigned_16;
procedure Get_Hex_4;
function Get_Hex (C : Character) return Unsigned_16 is
begin
if C in '0' .. '9' then
return Character'Pos (C) - Character'Pos ('0');
elsif C in 'A' .. 'F' then
return Character'Pos (C) - Character'Pos ('A') + 10;
else
return Character'Pos (C) - Character'Pos ('a') + 10;
end if;
end Get_Hex;
procedure Get_Hex_4 is
begin
R (RP) := Wide_Character'Val (
Get_Hex (S (SP + 3)) + 16 *
(Get_Hex (S (SP + 2)) + 16 *
(Get_Hex (S (SP + 1)) + 16 *
(Get_Hex (S (SP + 0))))));
end Get_Hex_4;
begin
SP := S'First;
RP := 0;
case EM is
when WCEM_Hex =>
while SP <= Last - 4 loop
RP := RP + 1;
if S (SP) = ASCII.ESC then
SP := SP + 1;
Get_Hex_4;
SP := SP + 4;
else
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end if;
end loop;
when WCEM_Upper =>
while SP < Last loop
RP := RP + 1;
if S (SP) >= Character'Val (16#80#) then
U1 := Character'Pos (S (SP));
U2 := Character'Pos (S (SP + 1));
R (RP) := Wide_Character'Val (256 * U1 + U2);
SP := SP + 2;
else
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end if;
end loop;
when WCEM_Shift_JIS =>
while SP < Last loop
RP := RP + 1;
if S (SP) >= Character'Val (16#80#) then
R (RP) := Shift_JIS_To_JIS (S (SP), S (SP + 1));
SP := SP + 2;
else
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end if;
end loop;
when WCEM_EUC =>
while SP < Last loop
RP := RP + 1;
if S (SP) >= Character'Val (16#80#) then
R (RP) := EUC_To_JIS (S (SP), S (SP + 1));
SP := SP + 2;
else
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end if;
end loop;
when WCEM_UTF8 =>
while SP < Last loop
RP := RP + 1;
if S (SP) >= Character'Val (16#80#) then
U1 := Character'Pos (S (SP));
U2 := Character'Pos (S (SP + 1));
U := Shift_Left (U1 and 2#00011111#, 6) +
(U2 and 2#00111111#);
SP := SP + 2;
if U1 >= 2#11100000# then
U3 := Character'Pos (S (SP));
U := Shift_Left (U, 6) + (U3 and 2#00111111#);
SP := SP + 1;
end if;
R (RP) := Wide_Character'Val (U);
else
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end if;
end loop;
when WCEM_Brackets =>
while SP <= Last - 7 loop
RP := RP + 1;
if S (SP) = '['
and then S (SP + 1) = '"'
and then S (SP + 2) /= '"'
then
SP := SP + 2;
Get_Hex_4;
SP := SP + 6;
else
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end if;
end loop;
end case;
while SP <= Last loop
RP := RP + 1;
R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
SP := SP + 1;
end loop;
return R (1 .. RP);
end String_To_Wide_String;
end System.WCh_StW;