DataMuseum.dk

top - download

    Length: 7136 (0x1be0)
    Types: TextFile
    Names: »B«

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

TextFile

with Bounded_String;
with String_Utilities;
with Text_Io;

package body Class_String is

    function Send (This_Message : Object.Unary; To : Object.Reference)
                  return Object.Reference is
        type Message is (En_Texte, En_Majuscules, En_Minuscules,
                         Avec_Capitales, Ta_Longueur);
        Token : Message;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

    begin
        if Bs.Length (Object.Get (This_Message)) /= 0 then
            begin
                Token := Message'Value (Bs.Image (Object.Get (This_Message)));
                case Token is  
                    when En_Texte =>
                        Text_Io.Put ("Objet String (");
                        Text_Io.New_Line;

                        Text_Io.Put ("    Classe =>");
                        Text_Io.Put (Object.E_Class'Image (Object.Get (To)));
                        Text_Io.New_Line;

                        Text_Io.Put ("    Objet =>");
                        Text_Io.Put (Bs.Image (Table (Object.Get (To))));
                        Text_Io.New_Line;

                        Text_Io.Put (" )");
                        Text_Io.New_Line (2);
                    when En_Majuscules =>
                        Table (Object.Get (To)) :=
                           Bs.Value (Su.Upper_Case
                                        (Bs.Image (Table (Object.Get (To)))));
                        return To;
                    when En_Minuscules =>
                        Table (Object.Get (To)) :=
                           Bs.Value (Su.Lower_Case
                                        (Bs.Image (Table (Object.Get (To)))));
                        return To;
                    when Avec_Capitales =>
                        Table (Object.Get (To)) :=
                           Bs.Value (Su.Capitalize
                                        (Bs.Image (Table (Object.Get (To)))));

                        return To;
                    when Ta_Longueur =>
                        return Object.Create
                                  (Class => Object.Integer_Class,
                                   Object => Object.Index
                                                (Bs.Length
                                                    (Table (Object.Get (To)))));
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end if;
    end Send;

    function Send (This_Message : Object.Binary; To : Object.Reference)
                  return Object.Reference is
        type Message is (Prendre, Plus, Sup, Inf, Sup_Egal, Inf_Egal, Egal);

        Token : Message;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

    begin
        if Bs.Length (Object.Get (This_Message)) /= 0 then
            declare
                An_Object : Object.Reference := To;  
                Chaine : Object.Tiny_String;
            begin
                Token := Message'Value (Bs.Image (Object.Get (This_Message)));
                case Token is
                    when Prendre =>
                        Table (Object.Get (To)) := Object.Get (This_Message);
                        return An_Object;
                    when Plus =>
                        Bs.Copy (Chaine, Bs.Image (Table (Object.Get (To))));
                        Bs.Append (Chaine, Bs.Image
                                              (Object.Get (This_Message)));  
                        return Class_String.Create (Chaine);
                    when Sup =>
                        if Bs.Image (Table (Object.Get (To))) >
                           Bs.Image (Object.Get (This_Message)) then
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 1);
                        else
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 0);
                        end if;
                    when Inf =>
                        if Bs.Image (Table (Object.Get (To))) <
                           Bs.Image (Object.Get (This_Message)) then
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 1);
                        else
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 0);
                        end if;
                    when Sup_Egal =>
                        if Bs.Image (Table (Object.Get (To))) >=
                           Bs.Image (Object.Get (This_Message)) then
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 1);
                        else
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 0);
                        end if;
                    when Inf_Egal =>
                        if Bs.Image (Table (Object.Get (To))) <=
                           Bs.Image (Object.Get (This_Message)) then
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 1);
                        else
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 0);
                        end if;
                    when Egal =>
                        if Bs.Image (Table (Object.Get (To))) =
                           Bs.Image (Object.Get (This_Message)) then
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 1);
                        else
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 0);
                        end if;
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end if;

    end Send;


    function Send (This_Message : Object.Keyword; To : Object.Reference)
                  return Object.Reference is
    begin
        return Object.Void_Reference;
    end Send;


    function Create return Object.Reference is
        use Object;
    begin  
        Last := Last + 1;
        return Object.Create (Class => Object.String_Class, Object => Last);
    end Create;


    function Create (Str : Object.Tiny_String) return Object.Reference is
        use Object;
    begin
        Last := Last + 1;
        Table (Last) := Str;
        return Object.Create (Class => Object.String_Class, Object => Last);
    end Create;


    function How_Many return Object.Index is
    begin
        return Last;
    end How_Many;

end Class_String;