DataMuseum.dk

top - download

    Length: 6409 (0x1909)
    Types: TextFile
    Names: »B«

└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Object, Integer_Classe, Text_Io,
     Bloc_Classe, Boolean_Classe, String_Classe;
package body Message is



    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 Is_In (This_List : Message.List; The_Message : String)
                   return Boolean is  
        L : Message.List := This_List;
    begin  
        Mess_List.Init (L.Iter, L.List);
        while not Mess_List.Done (L.Iter) loop
            if The_Message = Bounded_String.Image
                                (Mess_List.Value (L.Iter)) then
                return (True);
            else
                Mess_List.Next (L.Iter);
            end if;
        end loop;
        return (False);
    end Is_In;

    function Is_In (This_List : Message.List; The_Message : Message.Tiny_String)
                   return Boolean is
        L : Message.List := This_List;
    begin
        Mess_List.Init (L.Iter, L.List);
        while not Mess_List.Done (L.Iter) loop
            if Bounded_String.Image (The_Message) =
               Bounded_String.Image (Mess_List.Value (L.Iter)) then
                return (True);
            else
                Mess_List.Next (L.Iter);
            end if;
        end loop;  
        return (False);
    end Is_In;

    function Send (To_Object : Object.Reference;
                   The_Messages : Message.List;
                   With_Arguments : Argument.List) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;  
        Mess : Tiny_String;
        use Object;
    begin
        case Get_Classe (To_Object) is
            when Void_Classe =>
                null;
-- ERROR;
            when Object.Integer_Classe =>
                Mess := Get (The_Messages);
                Text_Io.Put_Line ("message.send send message " &
                                  Bounded_String.Image (Mess) &
                                  " to integer_classe");
                Result := Integer_Classe.Send (To_Object, Mess, With_Arguments);

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

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

            when Object.String_Classe =>
                null;  
            when others =>
                null;
        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_Classe (To_Object) is
            when Void_Classe =>
                null;
-- ERROR;
            when Object.Integer_Classe =>
                Result := Integer_Classe.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.Boolean_Classe =>
                Result := Boolean_Classe.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.String_Classe =>
                Result := String_Classe.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.Bloc_Classe =>
                null;
            when others =>
                null;

        end case;
        return (Result);
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String;
                   With_Arguments : Argument.List) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;
        use Object;
    begin
        case Object.Get_Classe (To_Object) is
            when Void_Classe =>
                null;
-- ERROR;
            when Object.Integer_Classe =>
                Result := Integer_Classe.Send
                             (To_Object, The_Message, With_Arguments);
            when Object.Boolean_Classe =>
                null;
--                Result := Boolean_Classe.Send
--                             (To_Object, The_Message, With_Arguments);
            when Object.Bloc_Classe =>
                null;
            when others =>
                null;

        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_Classe (To_Object) is
            when Object.Void_Classe =>
                null;
-- ERROR;
            when Object.Integer_Classe =>
                Result := Integer_Classe.Send (To_Object, The_Message);
            when Object.Boolean_Classe =>
                Result := Boolean_Classe.Send (To_Object, The_Message);  
            when Object.String_Classe =>
                Result := String_Classe.Send (To_Object, The_Message);
            when Object.Bloc_Classe =>
                Result := Bloc_Classe.Send (To_Object, The_Message);
            when others =>
                null;
        end case;  
        return (Result);
    end Send;

end Message;