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

⟦be9675e39⟧ TextFile

    Length: 3757 (0xead)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Object, Message, Bounded_String, Counter, String_Class,
     Integer_Class, Time_Utilities, Bug, Symbol;
package body Date_Class is

    package Bs renames Bounded_String;

    type Date_Unary_Message is (Entexte, Tonjour, Tonmois, Tonannee,
                                Tonheure, Tesminutes, Tessecondes);

    type Months is (Janvier, Fevrier, Mars, Avril, Mai, Juin, Juillet,
                    Aout, Septembre, Octobre, Novembre, Decembre);

    function Create return Object.Reference is
        Obj : Object.Reference;
    begin
        Obj := Object.Create (Object.Date_Class, 1);
        return (Obj);
    end Create;

    procedure Create_Default is
        Default_Date_Name : Message.Tiny_String;
        Default_Date : Object.Reference;
    begin
        Bounded_String.Copy (Default_Date_Name, "Date");
        Default_Date := Create;
        Symbol.Insert (Default_Date_Name, Default_Date);
    end Create_Default;

    function Get_Day return Object.Reference is
        The_Date : Time_Utilities.Time;
    begin
        The_Date := Time_Utilities.Get_Time;
        return Integer_Class.Create (Integer (The_Date.Day));
    end Get_Day;

    function Get_Month return Object.Reference is
        The_Date : Time_Utilities.Time;
        The_Month_String : Message.Tiny_String;
    begin
        The_Date := Time_Utilities.Get_Time;
        Bs.Copy (The_Month_String,
                 " " & Months'Image (Months'Val (Time_Utilities.Months'Pos
                                                    (The_Date.Month))));
        return String_Class.Create (The_Month_String);
    end Get_Month;

    function Get_Year return Object.Reference is
        The_Date : Time_Utilities.Time;
    begin
        The_Date := Time_Utilities.Get_Time;
        return Integer_Class.Create (Integer (The_Date.Year));
    end Get_Year;

    function Get_Hour return Object.Reference is
        The_Date : Time_Utilities.Time;
    begin
        The_Date := Time_Utilities.Get_Time;
        return Integer_Class.Create (Integer (The_Date.Hour));
    end Get_Hour;

    function Get_Minutes return Object.Reference is
        The_Date : Time_Utilities.Time;
    begin
        The_Date := Time_Utilities.Get_Time;
        return Integer_Class.Create (Integer (The_Date.Minute));
    end Get_Minutes;

    function Get_Secondes return Object.Reference is
        The_Date : Time_Utilities.Time;
    begin
        The_Date := Time_Utilities.Get_Time;
        return Integer_Class.Create (Integer (The_Date.Second));
    end Get_Secondes;

    procedure In_Text (The_Object : Object.Reference) is
    begin
        Object.In_Text (The_Object);
    end In_Text;

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;
        Talk : Date_Unary_Message;
    begin  
        Talk := Date_Unary_Message'Value (Bs.Image (V => The_Message));
        Counter.Increase (Object.Date_Class);
        case Talk is

            when Entexte =>
                In_Text (To_Object);
                Result := To_Object;

            when Tonjour =>  
                Result := Get_Day;

            when Tonmois =>
                Result := Get_Month;

            when Tonannee =>
                Result := Get_Year;

            when Tonheure =>
                Result := Get_Hour;

            when Tesminutes =>
                Result := Get_Minutes;

            when Tessecondes =>
                Result := Get_Secondes;
        end case;
        Counter.Stop_Time (Object.Date_Class);
        return (Result);

    exception
        when Constraint_Error =>
            raise Bug.Unknown_Date_Message;
    end Send;

end Date_Class;