DataMuseum.dk

top - download

    Length: 5571 (0x15c3)
    Types: TextFile
    Names: »B«

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

TextFile

with Object, Integer_Class, Block_Class, Boolean_Class,
     Date_Class, String_Class, Pen_Class, Turtle_Class, Bug;
package body Message is


    function Get (S : Selector) return String is
    begin
        case S is
            when Plus =>
                return "+";
            when Moins =>
                return "-";
            when Multiplier =>
                return "*";
            when Diviser =>
                return "/";
            when Inferieur =>
                return "<";
            when Superieur =>
                return ">";
            when Inferieur_Egal =>
                return "<=";
            when Superieur_Egal =>
                return ">=";
            when Egal =>
                return "=";
            when Et =>
                return "&";
            when Ou =>
                return "|";
            when others =>
                return "";
        end case;
    end Get;


    function Get (L : Message.List) return Message.Tiny_String is
        Mess : Message.Tiny_String;
    begin
        Mess := Mess_List.Value (L.Iter);
        return (Mess);
    end Get;

    procedure Next (L : in out Message.List;
                    Mess : in out Message.Tiny_String) is
    begin  
        if not Mess_List.Done (L.Iter) then
            Mess_List.Next (L.Iter);
            if not Mess_List.Done (L.Iter) then
                Mess := Mess_List.Value (L.Iter);
            else
                Bounded_String.Free (Mess);
            end if;  
        else
            Bounded_String.Free (Mess);
        end if;
    end Next;

    function Put (L : Message.List; Mess : Message.Tiny_String)
                 return Message.List is
        L1 : Message.List;
    begin
        L1.List := Mess_List.Make (X => Mess, L => L.List);
        Mess_List.Init (L1.Iter, L1.List);
        return (L1);
    end Put;

    procedure Init (L : in out Message.List) is
    begin
        Mess_List.Free (L.List);
    end Init;

    function How_Many (L : Message.List) return Natural is
    begin
        return (Mess_List.Length (L => L.List));
    end How_Many;

    function Send (To_Object : Object.Reference;
                   The_Messages : Message.List;
                   With_Arguments : Argument.List) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;  
        use Object;
    begin

        case Get_Class (To_Object) is

            when Object.Integer_Class =>
                Result := Integer_Class.Send
                             (To_Object, The_Messages, With_Arguments);

            when Object.Boolean_Class =>
                Result := Boolean_Class.Send
                             (To_Object, The_Messages, With_Arguments);

            when Object.Block_Class =>
                Result := Block_Class.Send
                             (To_Object, The_Messages, With_Arguments);

            when Object.Pen_Class =>
                Result := Pen_Class.Send
                             (To_Object, The_Messages, With_Arguments);

            when Object.Turtle_Class =>
                Result := Turtle_Class.Send
                             (To_Object, The_Messages, With_Arguments);

            when Object.String_Class | Object.Date_Class | Object.Void_Class =>
                raise Bug.Unexpected_Object;
        end case;
        return (Result);
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Selector;
                   With_Arguments : Argument.List) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;
        use Object;
    begin
        case Object.Get_Class (To_Object) is
            when Object.Integer_Class =>
                Result := Integer_Class.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.Boolean_Class =>
                Result := Boolean_Class.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.String_Class =>
                Result := String_Class.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.Block_Class | Object.Void_Class |
                 Object.Turtle_Class | Object.Pen_Class | Object.Date_Class =>
                raise Bug.Unexpected_Object;

        end case;
        return (Result);
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;
    begin
        case Object.Get_Class (To_Object) is
            when Object.Integer_Class =>
                Result := Integer_Class.Send (To_Object, The_Message);

            when Object.Boolean_Class =>
                Result := Boolean_Class.Send (To_Object, The_Message);

            when Object.String_Class =>
                Result := String_Class.Send (To_Object, The_Message);

            when Object.Block_Class =>
                Result := Block_Class.Send (To_Object, The_Message);

            when Object.Pen_Class =>
                Result := Pen_Class.Send (To_Object, The_Message);

            when Object.Turtle_Class =>
                Result := Turtle_Class.Send (To_Object, The_Message);

            when Object.Date_Class =>
                Result := Date_Class.Send (To_Object, The_Message);

            when Object.Void_Class =>
                raise Bug.Unexpected_Object;
        end case;  
        return (Result);
    end Send;

end Message;