DataMuseum.dk

top - download

    Length: 5769 (0x1689)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Block_Class;
with Bounded_String;
with Custom;
with Errors;
with String_Class;

package body Boolean_Class is

    type Unary_Message is (Nul, Inverse, En_Texte);
    type Binary_Message is (Nul, Et, Ou);
    type Keyword_Message is (Nul, Si_Vrai, Si_Faux);

    function Convert_To_Unary
                (The_Message : Scanner.Lexeme) return Unary_Message is
    begin
        if Bounded_String.Image (The_Message) = "INVERSE" then
            return Inverse;
        elsif Bounded_String.Image (The_Message) = "EN_TEXTE" then
            return En_Texte;
        else
            return Nul;
        end if;
    end Convert_To_Unary;

    function Convert_To_Binary
                (The_Message : Scanner.Lexeme) return Binary_Message is

    begin
        if Bounded_String.Image (The_Message) = "&" then
            return Et;
        elsif Bounded_String.Image (The_Message) = "|" then
            return Ou;
        else
            return Nul;
        end if;
    end Convert_To_Binary;

    function Convert_To_List (The_Message : Scanner.Lexeme)
                             return Keyword_Message is
    begin
        if Bounded_String.Image (The_Message) = "SI_VRAI:" then
            return Si_Vrai;
        elsif Bounded_String.Image (The_Message) = "SI_FAUX:" then
            return Si_Faux;
        else
            return Nul;
        end if;
    end Convert_To_List;

    function Create (Value : Boolean) return Object.Reference is
        Id : Integer;
    begin
        if Value = True then
            Id := 1;
        else
            Id := 0;
        end if;
        return (Object.Create (Object.Booleen, Id));
    end Create;

    function True return Object.Reference is
    begin
        return (Create (True));
    end True;

    function False return Object.Reference is
    begin
        return (Create (False));
    end False;

    function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
                  return Object.Reference is
        Current_Message : Unary_Message;
    begin
        Current_Message := Convert_To_Unary (The_Message);
        case Current_Message is
            when Nul =>
                raise Errors.Unknown_Message_For_Boolean;
            when Inverse =>
                if Object.Get_Id (To_Object) = 1 then
                    return False;
                else
                    return True;
                end if;
            when En_Texte =>
                if Object.Get_Id (To_Object) = 1 then
                    return String_Class.Create ("vrai");
                else
                    return String_Class.Create ("faux");
                end if;
        end case;
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Scanner.Lexeme;
                   With_Object : Object.Reference) return Object.Reference is
        Current_Message : Binary_Message;
    begin
        case Object.Get_Class (With_Object) is
            when Object.Booleen =>
                Current_Message := Convert_To_Binary (The_Message);
                case Current_Message is
                    when Nul =>
                        raise Errors.Unknown_Message_For_Boolean;
                    when Et =>
                        return Create ((Object.Get_Id (To_Object) = 1) and
                                       (Object.Get_Id (With_Object) = 1));
                    when Ou =>
                        return Create ((Object.Get_Id (To_Object) = 1) or
                                       (Object.Get_Id (With_Object) = 1));
                end case;
            when others =>
                raise Errors.Boolean_Object_Required_As_Argument;
        end case;
    end Send;

    procedure Send (To_Object : Object.Reference;
                    The_Message : in out Message.Selector;
                    With_Arguments : in out Parameters.List;
                    Back_Object : out Object.Reference) is
        Current_Message : Keyword_Message;
        Interpret_Yourself : Scanner.Lexeme :=
           Bounded_String.Value ("VALEUR", Custom.String_Max_Length);
    begin
        Message.Init (The_Message);
        Parameters.Init (With_Arguments);
        while not Message.Done (The_Message) loop
            case Object.Get_Class (Parameters.Value (With_Arguments)) is
                when Object.Bloc =>
                    Current_Message := Convert_To_List
                                          (Message.Value (The_Message));
                    case Current_Message is
                        when Nul =>
                            raise Errors.Unknown_Message_For_Boolean;
                        when Si_Vrai =>  
                            if Object.Get_Id (To_Object) = 1 then
                                Back_Object := Block_Class.Send
                                                  (Parameters.Value
                                                      (With_Arguments),
                                                   Interpret_Yourself);
                            end if;
                        when Si_Faux =>
                            if Object.Get_Id (To_Object) = 0 then
                                Back_Object := Block_Class.Send
                                                  (Parameters.Value
                                                      (With_Arguments),
                                                   Interpret_Yourself);
                            end if;
                    end case;
                    Message.Next (The_Message);
                    Parameters.Next (With_Arguments);
                when others =>
                    raise Errors.Block_Argument_Required_For_Boolean;
            end case;
        end loop;
    end Send;

end Boolean_Class;