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

⟦64645176c⟧ TextFile

    Length: 8162 (0x1fe2)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Object, String_Utilities, Bounded_String, Scanner,
     Msg_Report, Integer_Class, Boolean_Class;
package body String_Class is


    function Bs_Image (A_String : Scanner.B_String) return String
        renames Bounded_String.Image;

    procedure Bs_Init (A_String : in out Scanner.B_String)
        renames Bounded_String.Free;

    procedure Bs_Copy (A_String : in out Scanner.B_String; A_Value : String)
        renames Bounded_String.Copy;

    procedure Bs_Cat (Target : in out Scanner.B_String;
                      Source : Scanner.B_String) renames Bounded_String.Append;

    function Bs_Length (A_String : Scanner.B_String) return Natural
        renames Bounded_String.Length;



    function Su_Lower (A_String : String) return String
        renames String_Utilities.Lower_Case;

    function Su_Upper (A_String : String) return String
        renames String_Utilities.Upper_Case;

    function Su_Capitalize (A_String : String) return String
        renames String_Utilities.Capitalize;


    Max : constant := 100;

    Instance_Table : array (1 .. Max) of Struct_Table;


    function Create (Value : String) return Object.Reference is
        Pos : Natural;  
        A_String : Scanner.B_String;
        The_Class : Object.Class := Object.C_String;

    begin  
        Bs_Init (A_String);
        Bs_Copy (A_String, Value);

        Pos := First_Free;
        Instance_Table (Pos).Indic := Used;
        Instance_Table (Pos).Value := A_String;  
        return Object.Create (The_Class, Pos);  
    end Create;



    function First_Free return Natural is
        Pos : Natural;

    begin
        for I in Instance_Table'Range loop
            if Instance_Table (I).Indic = Unused then
                Pos := I;
                exit;
            end if;
        end loop;  
        return Pos;

    exception

        when others =>
            raise Instance_Table_Full;

    end First_Free;


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

        type Unary_Msg is (Capitalise, Tataille, Enmajuscule, Enminuscule);

        type Binary_Msg is (Plus, Equal);

        Result, Object1, Object2 : Object.Reference;

        Args : Arguments.List;

        Msg : Message.Selector := Message.Void_Selector;

        An_Unary_Msg : Unary_Msg;
        A_Binary_Msg : Binary_Msg;

    begin

        Object1 := To_Object;

        Args := With_Arguments;

        case Arguments.How_Many (Args) is

            when 0 =>

                An_Unary_Msg := Unary_Msg'Value (Message.Image (The_Message));

                case An_Unary_Msg is

                    when Capitalise =>
                        Msg_Report.Information ("message is Capitalise ");
                        Result := Capitalize (Object1);

                    when Tataille =>
                        Msg_Report.Information ("message is tataille ");
                        Result := Integer_Class.Create
                                     (Integer (Size (Object1)));

                    when Enmajuscule =>
                        Msg_Report.Information ("message is enmajuscule ");
                        Result := Upper_Case (Object1);

                    when Enminuscule =>
                        Msg_Report.Information ("message is enminuscule ");
                        Result := Lower_Case (Object1);

                    when others =>
                        Msg_Report.Interpret_Error
                           ("Incorrect unary method " &
                            Message.Image (The_Message) &
                            " for object " & In_Text (Object1));

                        raise Incorrect_Method;
                end case;

            when 1 =>

                Arguments.First (Args);
                Arguments.Read (Args, Object2);

                if Message.Image (The_Message) = "+" then

                    Msg_Report.Information ("Message is +");  
                    A_Binary_Msg := Plus;

                elsif Message.Image (The_Message) = "=" then

                    Msg_Report.Information ("Message is =");  
                    A_Binary_Msg := Equal;

                end if;


                case A_Binary_Msg is

                    when Plus =>  
                        Result := Object1 + Object2;

                    when Equal =>  
                        Result := Is_Equal (Object1, Object2);

                    when others =>
                        Msg_Report.Interpret_Error
                           ("Incorrect binary method " &
                            Message.Image (The_Message) &
                            " for object " & In_Text (Object1));
                        raise Incorrect_Method;

                end case;

            when others =>

                Msg_Report.Interpret_Error
                   ("Incorrect nb of arguments for method " &
                    Message.Image (The_Message) &
                    " to object " & In_Text (Object1));
                raise Incorrect_Nb_Args;

        end case;

        return Result;
    end Send;


    function Delete (The_String : Object.Reference) return Object.Reference is  
    begin  
        Instance_Table (Object.Identificator (The_String)).Indic := Unused;
        return Object.Void_Reference;
    end Delete;


    function Size (The_String : Object.Reference) return Natural is  
    begin
        return Bs_Length
                  (Instance_Table (Object.Identificator (The_String)).Value);
    end Size;


    function In_Text (The_String : Object.Reference) return String is  
    begin
        return Bs_Image
                  (Instance_Table (Object.Identificator (The_String)).Value);
    end In_Text;


    function Lower_Case (The_String : Object.Reference)
                        return Object.Reference is
        Result : Object.Reference;

    begin  
        Result := Delete (The_String);
        Result :=
           Create (Su_Lower
                      (Bs_Image
                          (Instance_Table (Object.Identificator (The_String)).
                           Value)));
        return Result;
    end Lower_Case;


    function Upper_Case (The_String : Object.Reference)
                        return Object.Reference is
        Result : Object.Reference;
    begin  
        Result := Delete (The_String);
        Result :=
           Create (Su_Upper
                      (Bs_Image
                          (Instance_Table (Object.Identificator (The_String)).
                           Value)));
        return Result;  
    end Upper_Case;


    function Capitalize (The_String : Object.Reference)
                        return Object.Reference is
        Result : Object.Reference;
    begin  
        Result := Delete (The_String);
        Result :=
           Create (Su_Capitalize
                      (Bs_Image
                          (Instance_Table (Object.Identificator (The_String)).
                           Value)));
        return Result;
    end Capitalize;



    function "+" (First_String : Object.Reference;
                  Second_String : Object.Reference) return Object.Reference is  
        Source, Target : Scanner.B_String;
        Result : Object.Reference;

    begin  
        Source := Instance_Table (Object.Identificator (Second_String)).Value;
        Target := Instance_Table (Object.Identificator (First_String)).Value;

        Bs_Cat (Target, Source);
        Result := Delete (First_String);
        Result := Create (Bs_Image (Target));
        return Result;
    end "+";


    function Is_Equal (First_String : Object.Reference;
                       Second_String : Object.Reference)
                      return Object.Reference is  
    begin  
        return Boolean_Class.Create
                  (Bs_Image
                      (Instance_Table (Object.Identificator (First_String)).
                       Value) =
                   Bs_Image
                      (Instance_Table (Object.Identificator (Second_String)).
                       Value));  
    end Is_Equal;
end String_Class;