DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦e757f2750⟧ TextFile

    Length: 3607 (0xe17)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Block_Class;
with Boolean_Class;  
with Bounded_String;
with Errors;
with Integer_Class;
with Pen_Class;
with String_Class;
with Turtle_Class;

package body Broker is

    function Send (To_Object : Object.Reference; Unary_Msg : Scanner.Lexeme)
                  return Object.Reference is
    begin
        case Object.Get_Class (To_Object) is
            when Object.Entier =>
                return Integer_Class.Send (To_Object, Unary_Msg);
            when Object.Booleen =>
                return Boolean_Class.Send (To_Object, Unary_Msg);
            when Object.Chaine =>
                return String_Class.Send (To_Object, Unary_Msg);
            when Object.Bloc =>  
                return Block_Class.Send (To_Object, Unary_Msg);
            when Object.Tortue =>
                return Turtle_Class.Send (To_Object, Unary_Msg);
            when Object.Stylo =>
                return Pen_Class.Send (To_Object, Unary_Msg);
            when Object.Vide =>
                if Bounded_String.Image (Unary_Msg) = "EN_TEXTE" then
                    return String_Class.Create ("objet vide !");
                else
                    raise Errors.Message_Sent_To_Empty_Object;
                end if;
        end case;
    end Send;

    function Send (To_Object : Object.Reference;
                   Binary_Msg : Scanner.Lexeme;
                   With_Object : Object.Reference) return Object.Reference is
    begin
        case Object.Get_Class (To_Object) is
            when Object.Entier =>
                return Integer_Class.Send (To_Object, Binary_Msg, With_Object);
            when Object.Booleen =>
                return Boolean_Class.Send (To_Object, Binary_Msg, With_Object);
            when Object.Chaine =>
                return String_Class.Send (To_Object, Binary_Msg, With_Object);
            when Object.Bloc =>
                raise Errors.Undefined_Message_For_Block;
            when Object.Tortue =>
                raise Errors.Undefined_Message_For_Turtle;
            when Object.Stylo =>
                raise Errors.Undefined_Message_For_Pen;
            when Object.Vide =>
                raise Errors.Message_Sent_To_Empty_Object;
        end case;
    end Send;

    procedure Send (To_Object : Object.Reference;
                    Keyword_Msg : in out Message.Selector;
                    With_Arguments : in out Parameters.List;
                    Back_Object : out Object.Reference) is
        Result_Object : Object.Reference;
    begin
        case Object.Get_Class (To_Object) is
            when Object.Entier =>
                Integer_Class.Send (To_Object, Keyword_Msg,
                                    With_Arguments, Result_Object);
            when Object.Booleen =>
                Boolean_Class.Send (To_Object, Keyword_Msg,
                                    With_Arguments, Result_Object);
            when Object.Chaine =>
                raise Errors.Undefined_Message_For_String;
            when Object.Bloc =>
                Block_Class.Send (To_Object, Keyword_Msg,
                                  With_Arguments, Result_Object);
            when Object.Tortue =>
                Turtle_Class.Send (To_Object, Keyword_Msg,
                                   With_Arguments, Result_Object);
            when Object.Stylo =>
                Pen_Class.Send (To_Object, Keyword_Msg,
                                With_Arguments, Result_Object);
            when Object.Vide =>
                raise Errors.Message_Sent_To_Empty_Object;
        end case;
        Back_Object := Result_Object;
    end Send;

end Broker;