with CharAK;
     with ErroAK; use ErroAK;
     with ConsAK;
     with Text_IO;
     with TypeAK; use TypeAK;

     package body StriAK is
     ---------------------------------------------------------------------------
     ---------------------------------------------------------------------------
     -- Copyright (C) 1994 David Wallace Croft.  All rights reserved.
     -- String manipulation.
     -- Use InStr'last instead of Length(InStr).
     ---------------------------------------------------------------------------
     ---------------------------------------------------------------------------

     procedure Copy (
		 New_Str: out string;
		 Copied_Str: in string;
		 Start: in positive;
		 Stop: in natural := 0) is
     ---------------------------------------------------------------------------
     -- If New_Str <= Copied_Str, New_Str will be a copy of Copied_Str
     -- starting at character Start of Copied_Str and stopping at Stop;
     -- and uncopied character slots in New_Str will be filled with nuls.
     --
     -- If New_Str > Copied_Str, Copied_Str will be copied onto New_Str
     -- at character Start of New_Str and stop at character Stop;
     -- uncopied character slots in New_Str will be left as is.
     --
     -- Note:  Start refers to Copied_Str in the first case and New_Str
     -- in the second case.
     --
     -- If Stop is zero, Stop will be set to Copied_Str'last.
     -- If Stop < Start, New_Str is all Nuls.
     ---------------------------------------------------------------------------
       Temp_Stop: natural := Stop;
     begin
       if Temp_Stop = 0 then
	 Temp_Stop := Copied_Str'last;
       end if;
       if Temp_Stop < Start then
	 New_Str := (others => ASCII.Nul);
	 return;
       end if;
       if New_Str'last <= Copied_Str'last then
	 for index in 1..(Temp_Stop - Start + 1) loop
	   New_Str(index) := Copied_Str(index - 1 + Start);
	 end loop;
	 for index in (Temp_Stop - Start + 2)..New_Str'last loop
	   New_Str(index) := ASCII.Nul;
	 end loop;
       else
	 for index in Copied_Str'range loop
	   New_Str(Start + index - 1) := Copied_Str(index);
	 end loop;
       end if;
     exception
       when others =>
	 ErroAK.Notify("StriAK.Copy");
	 raise;
     end Copy;

     Procedure Define_Valid_Characters(
		 Valid_Characters: out Valid_Characters_Type;
		 Definition_Str: in string := "") is
     ---------------------------------------------------------------------------
     -- Takes in Definition_Str and parses to determine what characters are
     -- allowed for every slot in the answer string.
     --
     -- Valid_Characters must be constrained to the number of characters in
     -- the answer.
     --
     -- ""  == Accepts anything.
     -- " " == Ignored.
     -- "," == Delimits one character from another.  If there are not enough
     --        commas, subsequent character answers will be have the same
     --        limit as the preceding one.  If there are too many commas,
     --        the limits will be ignored.
     -- "-" == All characters accepted between the last character and the next
     --        character (except for space, comma, and dash).
     --
     -- Example:
     --   IN:   Definition_Str is ", ,  ,,,,,,,,A-DFI,-M,YNyn"
     --         and Valid_Characters is contrained to a range of 1..30
     --   OUT:  Valid_Characters(1..10) will accept anything.  Spaces ignored.
     --         Valid_Characters(11) will only accept A,B,C,D, F, or I.
     --         Valid_Characters(12) will accept ASCII.Nul to M.
     --         Valid_Characters(13) will only accept Y, N, y, or n.
     --         Valid_Characters(14..30) will only accept Y, N, y, or n.
     ---------------------------------------------------------------------------
       All_Characters_Valid: constant Character_Is_Valid_Type
	 := (others => true);
       All_Characters_Invalid: constant Character_Is_Valid_Type
	 := (others => false);
       All_Nuls: constant string(Definition_Str'range) := (others => ASCII.Nul);
       Answer_Index: positive range 1..(Valid_Characters'last + 1) := 1;
       Def_Str: string(Definition_Str'range);
       Last_Character: character := ASCII.Nul;
       type Operation_Type is (Not_Set, Ranged);
       Operation: Operation_Type := Not_Set;
       VC: Valid_Characters_Type ( Valid_Characters'range )
	 := ( others => All_Characters_Invalid );
     begin
       if ( Definition_Str = "" ) or ( Definition_Str = All_Nuls ) then
	 Valid_Characters := ( others => All_Characters_Valid );
	   return;
       end if;
       Def_Str := Strip_White_Space ( Definition_Str );
       for index in Def_Str'range loop
	 exit when Answer_Index = VC'last + 1;
	 if Def_Str ( index ) = ',' then
	   if Last_Character = ASCII.Nul then
	     VC ( Answer_Index ) := All_Characters_Valid;
	   end if;
	   Answer_Index := Answer_Index + 1;
	   Last_Character := ASCII.Nul;
	   Operation := Not_Set;
	 elsif Def_Str ( index ) = '-' and then not ( Operation = Ranged ) then
	   Operation := Ranged;
	 else
	   case Operation is
	     when Not_Set =>
	       VC ( Answer_Index ) ( Def_Str ( index ) ) := true;
	     when Ranged =>
	       for Ranged_Index in Last_Character..Def_Str ( index ) loop
		 VC ( Answer_Index ) ( Ranged_Index ) := true;
	       end loop;
	   end case;
	   Last_Character := Def_Str ( index );
	 end if;
       end loop;
       for index in (Answer_Index + 1)..VC'last loop
	 VC(index) := VC(Answer_Index);
       end loop;
       Valid_Characters := VC;
     exception
       when others => ErroAK.Notify("StriAK.Define_Valid_Answers");
		      raise;
     end Define_Valid_Characters;

     function  Filtered (
		 In_Str: in string;
		 Filter_Str: in string ) return string is
     ---------------------------------------------------------------------------
       In_Filter_Str : boolean;
       Position      : integer := In_Str'first;
       Temp          : string ( In_Str'range );
     begin
       for index in In_Str'range loop
	 In_Filter_Str := false;
	 for index2 in Filter_Str'range loop
	   if In_Str ( index ) = Filter_Str ( index2 ) then
	     In_Filter_Str := true;
	     exit;
	   end if;
	 end loop;
	 if not In_Filter_Str then
	   Temp ( Position ) := In_Str ( index );
	   Position := Position + 1;
	 end if;
       end loop;
       for index in Position .. In_Str'last loop
	 Temp ( index ) := ASCII.NUL;
       end loop;
       return Temp;
     end Filtered;

     function  Image
		 ( Item   : in integer;
		   Width  : in Text_IO.Field := integer'width;
		   Base   : in Text_IO.Number_Base := 10;
		   Signed : in boolean   := true;
		   Zeroed : in boolean   := false
		 ) return string is
     ----------------------------------------------------------------------
     begin
       return Image ( long_integer ( Item ), Width, Base, Signed, Zeroed );
     end Image;

     function  Image (
       Item   : in long_integer;
       Width  : in Text_IO.Field := long_integer'width;
       Base   : in Text_IO.Number_Base := 10;
       Signed : in boolean   := true;
       Zeroed : in boolean   := false )
       return string is
     ----------------------------------------------------------------------
       W       : positive := long_integer'image ( Item )'last;
       Largest : positive := Width;
     begin
       if W > Width then
	 Largest := W;
       end if;
       declare
	 Temp : string ( 1..Largest ) := ( others => ' ' );
       begin
	 if Signed then
	   Temp ( ( Temp'last - W + 1 )..Temp'last )
	     := long_integer'image ( Item );
	   if Item >= 0 then
	     Temp ( 1 ) := '+';
	   else
	     Temp ( Temp'last - W + 1 ) := ' ';
	     Temp ( 1 ) := '-';
	   end if;
	 else
	   Temp ( ( Temp'last - W + 2 )..Temp'last )
	     := long_integer'image ( Item ) ( 2..W );
	 end if;
	 if Zeroed then
	   for index in Temp'range loop
	     if Temp ( index ) = ' ' then
	       Temp ( index ) := '0';
	     end if;
	   end loop;
	 end if;
	 if Largest > Width then
	   return Temp ( ( Temp'last - Width + 1 )..Temp'last );
	 else
	   return Temp;
	 end if;
       end;
     exception
       when others =>
	 ErroAK.Notify ( "StriAK.Image ( long_integer )" );
	 raise;
     end Image;

     function Is_Long_Integer (
       Pos_Str  : in string;
       Min      : in long_integer := long_integer'first;
       Max      : in long_integer := long_integer'last )
       return boolean is
     ----------------------------------------------------------------------
     -- change Pos_Str to Long_Int_Str.
     ----------------------------------------------------------------------
       Temp : boolean := true;
       Test : long_integer;
     begin
       begin
	 Test := long_integer'value ( Pos_Str );
	 Temp := ( Min <= Test ) and ( Test <= Max );
	 for index in Pos_Str'range loop
	   Temp := Temp and
	     ( Locate ( Pos_Str ( index ), "+-0123456789" ) /= 0 );
	 end loop;
       exception
	 when others =>
	   Temp := false;
       end;
       return Temp;
     end Is_Long_Integer;

     function Locate (
       Search_Char    : in character;
       Search_Str     : in string;
       Start_Position : in positive := 1 )
       return natural is
     ----------------------------------------------------------------------
     -- Returns 0 if not found from Start_Pos to last.
     ----------------------------------------------------------------------
       Char_Found : boolean := false;
       Str_Index  : natural;
     begin
       for index in Start_Position..Search_Str'last loop
	 Str_Index := index;
	 Char_Found := Search_Str ( Str_Index ) = Search_Char;
	 exit when Char_Found;
       end loop;
       if Char_Found then
	 return Str_Index;
       else
	 return 0;
       end if;
     exception
       when others => ErroAK.Notify("StriAK.Locate ( Search_Char )");
		      raise;
     end Locate;

     function  Locate (
       Hunted_Str     : in string;
       Search_Str     : in string;
       Start_Position : in positive := 1 ) return positive is
     ---------------------------------------------------------------------------
     -- Returns ( Search_Str'last + 1 ) if not found from Start_Position to end.
     ---------------------------------------------------------------------------
       Str_Found: boolean := false;
       Str_Index: positive;
     begin
       for index in Start_Position..Search_Str'last loop
	 Str_Index := index;
	 Str_Found := Search_Str ( index..( index - 1 + Hunted_Str'length ) )
	   = Hunted_Str;
	 exit when Str_Found;
       end loop;
       if Str_Found then
	 return Str_Index;
       else
	 return Search_Str'last + 1;
       end if;
     exception
       when others =>
	 ErroAK.Notify ( "StriAK.Locate ( Hunted_Str )" );
	 raise;
     end Locate;

     function  Merge (
       Dominant  : in string;
       Recessive : in string )
       return string is
     ---------------------------------------------------------------------------
       Min,
       Max : natural;
     begin
       if Recessive'first < Dominant'first then
	 Min := Recessive'first;
       else
	 Min := Dominant'first;
       end if;
       if Recessive'last > Dominant'last then
	 Max := Recessive'last;
       else
	 Max := Dominant'last;
       end if;
       declare
	 Temp : string ( Min..Max );
       begin
	 Temp ( Recessive'range ) := Recessive;
	 for Char in Dominant'range loop
	   if Dominant ( Char ) /= ASCII.Nul then
	     Temp ( Char ) := Dominant ( Char );
	   end if;
	 end loop;
	 return Temp;
       end;
     exception
       when others =>
	 Notify ( "StriAK.Merge" );
	 raise;
     end Merge;

     procedure MultiChar(InChar: in character; InStr: in out string) is
     ---------------------------------------------------------------------------
     begin
       for index in InStr'range loop
	 InStr(index) := InChar;
       end loop;
     end MultiChar;

     procedure Parse_Between(
		 Parsed_Str: out string;
		 Char: in character;
		 After_Char_Num: in natural;
		 In_Str: in string) is
     ---------------------------------------------------------------------------
       Start_Copy: positive;
       Stop_Copy: natural := 0;
     begin
       for index in 0..After_Char_Num loop
	 Start_Copy := Stop_Copy + 1;
	 Stop_Copy := Locate( Char, In_Str, Start_Position => Start_Copy);
	 if Stop_Copy = 0 then
	   Stop_Copy := In_Str'last + 1;
	 end if;
       end loop;
       Copy( Parsed_Str, In_Str, Start_Copy, Stop_Copy - 1);
     exception
       when others =>
	 ErroAK.Notify("StriAK.Parse_Between");
	 raise;
     end Parse_Between;

     procedure Parse_Range(
		 InStr: in string;
		 Position: in positive;
		 Lo_Num: out natural;
		 Hi_Num: out natural;
		 New_Position: out positive) is
     ---------------------------------------------------------------------------
     -- Hi_Num will always be >= Lo_Num.
     ---------------------------------------------------------------------------
       On_Lo_Num: boolean := false;
       On_Hi_Num: boolean := false;
       Temp_Lo_Num: natural := 0;
       Temp_Num: natural := 0;
     begin
       Temp_Lo_Num := 0;
       Hi_Num := 0;
       for index in Position..InStr'last loop
	 New_Position := index;
	 if CharAK.Is_Natural(InStr(index)) then
	   Temp_Num := Temp_Num*10
	     + natural'value(CharAK.Char_To_Strg(InStr(index)));
	   if not(On_Lo_Num) and not(On_Hi_Num) then
	     On_Lo_Num := true;
	   end if;
	 else
	   if On_Hi_Num then
	     if Temp_Num < Temp_Lo_Num then
	       Hi_Num := Temp_Lo_Num;
	     else
	       Hi_Num := Temp_Num;
	     end if;
	     exit;
	   end if;
	   if On_Lo_Num then
	     Temp_Lo_Num := Temp_Num;
	     Temp_Num := 0;
	     On_Lo_Num := false;
	     On_Hi_Num := true;
	   end if;
	 end if;
       end loop;
       Lo_Num := Temp_Lo_Num;
     end Parse_Range;

     function Shift (
       Shifted : string;
       Left    : integer := 1 )
       return string is
     ----------------------------------------------------------------------
       Temp : string ( Shifted'range );
     begin
       for Char in Shifted'range loop
	 if ( Char + Left ) in Shifted'range then
	   Temp ( Char ) := Shifted ( Char + Left );
	 else
	   Temp ( Char ) := ASCII.Nul;
	 end if;
       end loop;
       return Temp;
     end Shift;

     procedure Show_Valid_Characters(
		 Valid_Characters: in Valid_Characters_Type) is
     ---------------------------------------------------------------------------
       Index2: character range character'first..character'last;
     begin
       for index in Valid_Characters'range loop
	 Text_IO.Put_Line ( "Answer " & positive'image ( index ) );
	 for Index2 in character'first..character'last loop
	   Text_IO.Put_Line ( "  " & Index2
	     & boolean'image ( Valid_Characters ( index ) ( index2 ) ) );
	 end loop;
       end loop;
     end Show_Valid_Characters;

     procedure Split(
		 Left_Side,
		 Right_Side: out string;
		 Split_Str: in string;
		 Position: in natural) is
     ----------------------------------------------------------------------
     begin
       if Position = 0 then
	 Left_Side := (others => ASCII.Nul);
	 Right_Side := Split_Str;
	 return;
       end if;
       Copy( Left_Side, Split_Str, 1, Position - 1);
       Copy( Right_Side, Split_Str, Position + 1);
     exception
       when others =>
	 ErroAK.Notify("StriAK.Split(natural)");
	 raise;
     end Split;

     procedure Split(
		 Left_Side,
		 Right_Side: out string;
		 Split_Str: in string;
		 Split_Char: in character;
		 On_Count: in positive := 1) is
     ---------------------------------------------------------------------------
       Position: natural := 0;
     begin
       for index in 1..On_Count loop
	 Position := Locate( Split_Char, Split_Str, Position + 1);
       end loop;
       if Position = 0 then
	 Position := Split_Str'last + 1;
       end if;
       Split( Left_Side, Right_Side, Split_Str, Position);
     exception
       when others =>
	 ErroAK.Notify("StriAK.Split(character)");
	 raise;
     end Split;

     function Strip_White_Space (
       InStr: in string ) return string is
     ----------------------------------------------------------------------
     -- Strips out spaces, tabs, and ASCII.Nul.
     ----------------------------------------------------------------------
       TempIndex: positive := 1;
       TempStr: string(InStr'range);
     begin
       for index in InStr'range loop
	 if Locate ( InStr ( index ), ' ' & ASCII.HT & ASCII.Nul ) = 0 then
	   TempStr ( TempIndex ) := InStr ( Index );
	   TempIndex := TempIndex + 1;
	 end if;
       end loop;
       for index in TempIndex..InStr'last loop
	 TempStr(index) := ' ';
       end loop;
       return TempStr;
     end Strip_White_Space;

     function Trim_White_Space (
       Str : in string )
       return string is
     ----------------------------------------------------------------------
     -- Trims off space, ASCII.HT, ASCII.Nul from the right of the string.
     -- The returned string will have a shorter length.
     ----------------------------------------------------------------------
     begin
       for Last_Char in reverse Str'range loop
	 case Str ( Last_Char ) is
	   when ' '| ASCII.Nul | ASCII.HT => null;
	   when others => return Str ( Str'first..Last_Char );
	 end case;
       end loop;
       return ""; -- in case everything was stripped
     end Trim_White_Space;

     function Upcase(InStr: in string) return string is
     ---------------------------------------------------------------------------
       OutStr: string(InStr'range) := InStr;
     begin
       for index in InStr'range loop
	 OutStr(index) := CharAK.Upcase(InStr(index));
       end loop;
       return OutStr;
     end Upcase;

     procedure Value (
		 Status    :    out Status_Type;
		 Value_Int :    out integer;
		 Str_In    : in     string ) is
     ---------------------------------------------------------------------------
     begin
       Status := OK;
       Value_Int := integer'value ( Str_In );
     exception
       when Constraint_Error => Status := Error_Constraint;
       when others =>
	 raise;
     end Value;

     function Value (
       Str_Float : string )
       return float is
     ----------------------------------------------------------------------
       Temp : float;
       Last : natural;
       package Float_IO is new Text_IO.Float_IO ( float );
       use Float_IO;
     begin
       Get ( Str_Float, Temp, Last );
       return Temp;
     end Value;

--   function Value (
--     Str_Float : string )
--     return float is
--   ----------------------------------------------------------------------
--   -- Description :  Converts a string to a float.
--   --                Limited to 4 digits after the decimal point.
--   --                "1.0000" ==> 1.0; "1.00000" ==> Error
--   ----------------------------------------------------------------------
--     Exponent     : integer := 0;
--     Is_Integer   : boolean := false;
--     Is_Positive  : boolean := true;
--     Place        : integer := 0;
--     Position     : integer range 1..Str_Float'length := 2;
--     Status_Value : Status_Type;
--     Temp_Float   : float   := 0.0;
--     Temp_Str     : string ( 1..Trim ( Filter ( Str_Float, "_,"
--                      & White_Space_Default ) )'last )
--                    := Trim ( Filter ( Str_Float, "_,"
--                      & White_Space_Default ) );
--   begin
--     if Temp_Str ( 1 ) = '-' then
--       Is_Positive := false;
--     elsif Temp_Str ( 1 ) = '+' then
--       Is_Positive := true;
--     else
--       Is_Positive := true;
--       Position := 1;
--     end if;
--     for index in Position..Temp_Str'last loop
--       Position := index;
--       exit when Temp_Str ( index ) = '.';
--       if Temp_Str ( index ) not in ( '0'..'9' ) then
--         raise Constraint_Error;
--       end if;
--       Temp_Float := Temp_Float * 10.0
--         + float ( integer'value ( Temp_Str ( index..index ) ) );
--     end loop;
--     for index in ( Position + 1 ).. Temp_Str'last loop
--       Position := index;
--       Place := Place + 1;
--       exit when ( Temp_Str ( index ) = 'E' ) or ( Temp_Str ( index ) = 'e' );
--       exit when ( Temp_Str ( index ) = ASCII.NUL )
--         or ( Temp_Str ( index ) = ' ' );
--       if Temp_Str ( index ) not in ( '0'..'9' ) then
--         raise Constraint_Error;
--       end if;
--       -- Here is where the 4-digits after the decimal limitation is.
--       -- 10 ** 5 = 100,000 > 32k max integer
--       -- Cannot change ( 10 ** Place ) to long_integer as long_integers
--       -- cannot be converted to float.
--       Temp_Float := Temp_Float
--         + float ( integer'value ( Temp_Str ( index..index ) ) )
--           / float ( 10 ** Place );
--     end loop;
--     if Temp_Str ( Position ) = 'E' or Temp_Str ( Position ) = 'e' then
--       Value ( Status_Value, Exponent,
--         Temp_Str ( Position + 1 .. Temp_Str'last ) );
--       if Status_Value /= OK then
--         raise Constraint_Error;
--       end if;
--       Temp_Float := Temp_Float * ( 10.0 ** Exponent );
--     end if;
--     if Is_Positive then
--       return +Temp_Float;
--     else
--       return -Temp_Float;
--     end if;
--   end Value;

     ---------------------------------------------------------------------------
     ---------------------------------------------------------------------------
     end StriAK;