DataMuseum.dk

top - download

    Length: 7463 (0x1d27)
    Types: TextFile
    Names: »B«

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

TextFile

with Table;
with Boolean_Classe;  
with Integer_Classe;
with String_Utilities;
with Bounded_String;
with Message;
with Tiny_Error;
with Text_Io;

package body String_Classe is

    Max_Table_String : constant := 100;  
    subtype Table_Index is Positive range 1 .. Max_Table_String;
    String_Table : array (Table_Index) of Message.Tiny_String;
    Empty_String : Message.Tiny_String;


    function The_Table_Index (From_Object : Object.Reference) return Positive is
        The_Index : Integer;
    begin
        The_Index := Object.Get_Value (From_Object);
        if (The_Index > Max_Table_String) or (The_Index < 1) then
            raise Id_String_Overflow;
        else
            return The_Index;
        end if;
    end The_Table_Index;

    function Get_String (From_Object : Object.Reference)
                        return Message.Tiny_String is
    begin  
        return String_Table (The_Table_Index (From_Object));
    end Get_String;


    function Create (Name : Message.Tiny_String) return Object.Reference is
        Index : Positive := 1;
        New_Object : Object.Reference := Object.Void_Reference;
        Found : Boolean := False;
    begin

        while not Found and (Index <= Max_Table_String) loop
            if (Bounded_String.Length (String_Table (Index)) =
                Bounded_String.Length (Empty_String)) then
                Found := True;
            else
                Index := Index + 1;
            end if;
        end loop;
        if Found then
            String_Table (Index) := Name;
            New_Object := Object.Create (Object.String_Classe, Index);
        else  
            raise String_Class_Full;
        end if;
        return New_Object;  
    end Create;

    procedure Remove (The_Object : Object.Reference) is
    begin
        Bounded_String.Free (String_Table (The_Table_Index (The_Object)));
    end Remove;

    function "&" (Left, Right : Object.Reference) return Object.Reference is
        New_String : Message.Tiny_String;
    begin  
        if (Bounded_String.Length (Get_String (Left)) +
            Bounded_String.Length (Get_String (Right)) >
            Bounded_String.Max_Length (New_String)) then
            raise String_Large_Overflow;
        else
            Bounded_String.Append (New_String, Get_String (Left));
            Bounded_String.Append (New_String, Get_String (Right));
        end if;
        return Create (New_String);
    end "&";

    function Equal (Left, Right : Object.Reference) return Object.Reference is
        Result : Boolean;
    begin
        Result := (Bounded_String.Image (Get_String (Left)) =
                   Bounded_String.Image (Get_String (Right)));
        return Boolean_Classe.Create (Result);

    end Equal;

    function "<" (Left, Right : Object.Reference) return Object.Reference is
        Result : Boolean;
    begin  
        Result := (Bounded_String.Image (Get_String (Left)) <
                   Bounded_String.Image (Get_String (Right)));
        return Boolean_Classe.Create (Result);
    end "<";

    function ">" (Left, Right : Object.Reference) return Object.Reference is
        Result : Boolean;
    begin
        Result := (Bounded_String.Image (Get_String (Left)) >
                   Bounded_String.Image (Get_String (Right)));
        return Boolean_Classe.Create (Result);

    end ">";

    function ">=" (Left, Right : Object.Reference) return Object.Reference is
        Result : Boolean;
    begin
        Result := (Bounded_String.Image (Get_String (Left)) >=
                   Bounded_String.Image (Get_String (Right)));
        return Boolean_Classe.Create (Result);
    end ">=";

    function "<=" (Left, Right : Object.Reference) return Object.Reference is
        Result : Boolean;
    begin
        Result := (Bounded_String.Image (Get_String (Left)) <=
                   Bounded_String.Image (Get_String (Right)));
        return Boolean_Classe.Create (Result);
    end "<=";

    function To_Upper (The_Object : Object.Reference) return Object.Reference is
        The_String : Message.Tiny_String;
    begin
        The_String := Bounded_String.Value
                         (String_Utilities.Upper_Case
                             (Bounded_String.Image (Get_String (The_Object))));
        return Create (The_String);

    end To_Upper;

    function To_Lower (The_Object : Object.Reference) return Object.Reference is
        The_String : Message.Tiny_String;
    begin
        The_String := Bounded_String.Value
                         (String_Utilities.Lower_Case
                             (Bounded_String.Image (Get_String (The_Object))));
        return Create (The_String);
    end To_Lower;

    function Long (The_Object : Object.Reference) return Object.Reference is
        The_String : Message.Tiny_String;
    begin
        The_String := Get_String (The_Object);
        return Integer_Classe.Create (Bounded_String.Length (The_String));
    end Long;

    function In_Text (The_Object : Object.Reference) return Object.Reference is
    begin
        Text_Io.Put_Line (Bounded_String.Image (Get_String (The_Object)));  
        return The_Object;
    end In_Text;


    function Send (To_Object : Object.Reference;
                   The_Message : Message.Selector;
                   With_Arguments : Argument.List) return Object.Reference is

        The_Object, Arg1, Arg2 : Object.Reference := Object.Void_Reference;
        Args : Argument.List;
    begin
        Args := With_Arguments;
        case The_Message is

            when Message.Et =>
                Arg1 := Argument.Get (Args);
                The_Object := To_Object & Arg1;

            when Message.Inferieur =>
                Arg1 := Argument.Get (Args);
                The_Object := To_Object < Arg1;

            when Message.Superieur =>
                Arg1 := Argument.Get (Args);
                The_Object := To_Object > Arg1;

            when Message.Inferieur_Egal =>
                Arg1 := Argument.Get (Args);
                The_Object := To_Object <= Arg1;

            when Message.Superieur_Egal =>
                Arg1 := Argument.Get (Args);
                The_Object := To_Object >= Arg1;

            when Message.Egal =>
                Arg1 := Argument.Get (Args);
                The_Object := Equal (The_Object, Arg1);
            when others =>
                The_Object := Object.Void_Reference;
        end case;
        return The_Object;
    end Send;


    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String) return Object.Reference is
        The_Object : Object.Reference := Object.Void_Reference;
    begin
        if Bounded_String.Image (The_Message) = "EnMajuscule" then
            The_Object := To_Upper (To_Object);
        end if;
        if Bounded_String.Image (The_Message) = "EnMinuscule" then
            The_Object := To_Lower (To_Object);
        end if;  
        if Bounded_String.Image (The_Message) = "TaLongeur" then
            The_Object := Long (To_Object);
        end if;
        if Bounded_String.Image (The_Message) = "EnTexte" then
            The_Object := In_Text (To_Object);
        end if;

        return (The_Object);
    end Send;

begin
    Bounded_String.Free (Empty_String);
exception
    when Id_String_Overflow | String_Class_Full =>
        Tiny_Error.String_Class_Full;
    when String_Large_Overflow =>
        Tiny_Error.String_Large_Overflow;
end String_Classe;