DataMuseum.dk

top - download

    Length: 4833 (0x12e1)
    Types: TextFile
    Names: »B«

└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »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 (This_Message) /= 0 then
            begin
                Token := Message'Value (Bs.Image (This_Message));
                case Token is  
                    when En_Texte =>
                        Text_Io.Put (Bs.Image (Table (Object.Get (To))));
                    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
            begin
                Token := Message'Value (Bs.Image (Object.Get (This_Message)));
                case Token is
                    when Prendre =>
                        null;
                    when Plus =>
                        null;
                    when Sup =>
                        null;
                    when Inf =>
                        null;
                    when Sup_Egal =>
                        null;
                    when Inf_Egal =>
                        if Bs.Image (Object.Get (This_Message)) <=
                           Bs.Image (Table (Object.Get (To))) 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 (Object.Get (This_Message)) =
                           Bs.Image (Table (Object.Get (To))) 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;