⟦99b7474d5⟧

E3 Source Code



with Text_Io, Bounded_String, Lex_Player;

package body Player_Entries is


    Max_Player_Entry : constant Positive := 3;
    subtype Iterator is Integer range 1 .. Max_Player_Entry + 1;

    type Error_List is (No_Error, Caractere_Invalide,
                        Trop_De_Parametres, Commande_Erronee,
                        Commande_Inconnue, Saisie_Trop_Longue);


    subtype Preposition is Token range Start_Prep .. End_Prep;
    subtype Commande is Token range Start_Com .. End_Com;

    type Entry_Element is
        record
            A_Token : Token;
            A_String : Bounded_String.Variable_String
                          (Lex_Player.Max_Player_String);
        end record;
    Entry_Table : array (1 .. Max_Player_Entry) of Entry_Element;
    Entry_Error : Bounded_String.Variable_String (256);

    The_Index : Iterator;

    function Is_Keyword (The_String : in String) return Boolean is
        T : Token;
    begin
        T := Token'Value (The_String);
        return True;
    exception
        when Constraint_Error =>
            return False;
    end Is_Keyword;



    function Keyword_To_Token (Word : in String) return Token is
    begin
        if Is_Keyword (Word) then
            return Token'Value (Word);
        else
            return Id;
        end if;
    end Keyword_To_Token;


    procedure Init_Entry_Table is
    begin
        for I in Entry_Table'Range loop
            Entry_Table (I).A_Token := End_Entry;
            Bounded_String.Free (Entry_Table (I).A_String);
        end loop;
    end Init_Entry_Table;


    procedure Print_Player_Entry is
    begin
        Print_Loop:
            for I in Entry_Table'Range loop
                if not (Entry_Table (I).A_Token = End_Entry) then

                    Text_Io.Put_Line (Token'Image (Entry_Table (I).A_Token) &
                                      " -> " & Bounded_String.Image
                                                  (Entry_Table (I).A_String));
                else
                    Text_Io.Put_Line (Token'Image (Entry_Table (I).A_Token));

                    exit Print_Loop;
                end if;
            end loop Print_Loop;
    end Print_Player_Entry;

    procedure Insert_Player_Token
                 (Table_Index : in Positive; Token_Found : in Token) is
    begin
        Entry_Table (Table_Index).A_Token := Token_Found;
    end Insert_Player_Token;

    procedure Insert_Player_Entry
                 (Table_Index : in Positive; Str_Found : in String) is
    begin  
        Bounded_String.Free (Entry_Table (Table_Index).A_String);
        Bounded_String.Copy (Entry_Table (Table_Index).A_String, Str_Found);
    end Insert_Player_Entry;


    function Analyse_Player_Entry return Error_List is
        The_Index : Positive := Entry_Table'First;

        T1 : Lex_Player.Token;
        T2 : Token;

    begin
        Lex_Player.Get_Player ("Commande >>");
        Lex_Player.Init;


        Analyse:
            while not (Lex_Player.At_End) loop
                Lex_Player.Next;
                T1 := Lex_Player.Get_Token;

                case T1 is
                    when Lex_Player.Lexend =>
                        exit Analyse;
                    when Lex_Player.Unk =>
                        Insert_Player_Token (Entry_Table'First, End_Entry);
                        return (Caractere_Invalide);
                    when Lex_Player.Toolong =>
                        Insert_Player_Token (Entry_Table'First, End_Entry);
                        return (Saisie_Trop_Longue);
                    when Lex_Player.Id =>
                        T2 := Keyword_To_Token (Lex_Player.Get_Value);  
                        if (The_Index > Max_Player_Entry) then
                            Insert_Player_Token (Entry_Table'First, End_Entry);
                            return (Trop_De_Parametres);
                        elsif (T2 not in Preposition) then
                            Insert_Player_Token (The_Index, Id);
                            Insert_Player_Entry (The_Index,
                                                 Lex_Player.Get_Value);
                            The_Index := The_Index + 1;
                        end if;
                    when Lex_Player.Command =>
                        T2 := Keyword_To_Token (Lex_Player.Get_Value);
                        if (The_Index /= Entry_Table'First) then
                            Insert_Player_Token (Entry_Table'First, End_Entry);
                            return (Commande_Erronee);
                        elsif (T2 not in Commande) then
                            Insert_Player_Token (Entry_Table'First, End_Entry);
                            return (Commande_Inconnue);
                        else
                            Insert_Player_Token (The_Index, T2);
                            Insert_Player_Entry (The_Index,
                                                 Lex_Player.Get_Value);
                            The_Index := The_Index + 1;
                        end if;
                end case;
            end loop Analyse;
        return No_Error;
    end Analyse_Player_Entry;

    function Is_Command return Boolean is
        T : Token;
    begin
        T := Entry_Table (Iterator'First).A_Token;
        if T in Commande then
            return True;
        else
            return False;  
        end if;  
    end Is_Command;

    function Get_Command return Token is
    begin
        if Is_Command then
            return Entry_Table (Iterator'First).A_Token;
        else
            return Id;
        end if;
    end Get_Command;

    function Get_Player_Entry return Boolean is
        Error_Id : Error_List;
    begin
        Bounded_String.Free (Entry_Error);
        Init_Entry_Table;
        Error_Id := Player_Entries.Analyse_Player_Entry;
        if (Error_Id /= No_Error) then
            Bounded_String.Copy (Entry_Error,
                                 Ascii.Bel & "Erreur : " &
                                    Error_List'Image (Error_Id) & " !!!");
            return False;
        else
            return True;
        end if;
    end Get_Player_Entry;

    function Get_Player_Error return String is
    begin
        return Bounded_String.Image (Entry_Error);
    end Get_Player_Error;

    procedure Open_Index is
    begin
        The_Index := Iterator'First;
    end Open_Index;

    procedure Next_Index is
    begin
        if The_Index < Iterator'Last then
            The_Index := The_Index + 1;
        else
            raise Error_Range_Player_Entries;
        end if;
    end Next_Index;

    function Get_Indexed_Token return Token is
    begin
        return (Entry_Table (The_Index).A_Token);
    end Get_Indexed_Token;

    function Get_Indexed_Entry return String is
    begin
        return Bounded_String.Image (Entry_Table (The_Index).A_String);
    end Get_Indexed_Entry;


    function Index_At_End return Boolean is
        The_End : Boolean;
    begin
        if (The_Index >= Iterator'Last) then
            return True;
        elsif (Entry_Table (The_Index).A_Token = End_Entry) then
            return True;
        else
            return False;
        end if;
    end Index_At_End;


end Player_Entries;
DataMuseum.dk

Rational R1000/400

⟦99b7474d5⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
