DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

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 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦72cb4ae6e⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Date, seg_04cc7e, seg_04cd67

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with String_Utilities;
with Time_Utilities;

package body Date is

    package Su renames String_Utilities;
    package Tu renames Time_Utilities;

    function Set (At_Day : Jour; At_Hour : Heure; At_Minute : Minute)
                 return Object is

    begin
        return Object'(Day => At_Day,
                       Hour_Minute => Set (At_Hour => At_Hour,
                                           At_Minute => At_Minute));  
    end Set;

    function System_Date return Object is

        Date_Systeme : Tu.Time;
        Heure : Date.Heure;
        Jour : Date.Jour;

    begin
        Date_Systeme := Tu.Get_Time;
        Jour := Date.Jour (Tu.Day_Of_Week (Date_Systeme));
        Heure := Date.Heure (Date_Systeme.Hour);

        declare
            use Tu;
        begin
            if (Date_Systeme.Sun_Position = Time_Utilities.Pm) then
                Heure := (Heure mod 12) + 12;
            end if;
        end;

        return Set (At_Day => Jour,
                    At_Hour => Heure,
                    At_Minute => Date.Minute (Date_Systeme.Minute));

    end System_Date;

    function Set (At_Hour : Heure; At_Minute : Minute) return Horaire is
    begin
        return Horaire'(Hours => At_Hour, Minutes => At_Minute);
    end Set;


    function Image (The_Date : in Object) return Mt.Bs_Access is
    begin
        return (new Mt.Byte_String'
                       (The_Date.Hour_Minute.Hours,
                        The_Date.Hour_Minute.Minutes, The_Date.Day));
    end Image;

    function Value (The_Byte_String : in Mt.Byte_String) return Object is
    begin
        return Object'(Day => The_Byte_String (3),
                       Hour_Minute => Value (The_Byte_String (1 .. 2)));

    exception
        when Constraint_Error =>
            return Zero;
    end Value;

    function Value (The_Byte_String : in Mt.Byte_String) return Horaire is
    begin
        return Horaire'(Hours => The_Byte_String (1),
                        Minutes => The_Byte_String (2));

    exception
        when Constraint_Error =>
            return Zero;

    end Value;

    function Image (The_Day : in Jour) return String is
    begin
        return (Nom_De_Jour'Image (Nom_De_Jour'Val (The_Day)));
    end Image;

    function Image (The_Date : in Object) return String is
    begin
        return (Image (The_Date.Day)) & " " & Image (The_Date.Hour_Minute);
    end Image;

    function Image (L_Horaire : in Horaire) return Mt.Byte_String is
    begin
        return Mt.Byte_String'(1 => L_Horaire.Hours, 2 => L_Horaire.Minutes);
    end Image;

    function Image (L_Horaire : in Horaire) return String is
    begin

        return (Su.Number_To_String (Value => L_Horaire.Hours,
                                     Base => 10,
                                     Width => 2,
                                     Leading => '0') &
                ":" & String_Utilities.Number_To_String
                         (Value => L_Horaire.Minutes,
                          Base => 10,
                          Width => 2,
                          Leading => '0'));
    end Image;

    function Zero return Horaire is
    begin
        return Horaire'(Hours => 0, Minutes => 0);
    end Zero;

    function Zero return Object is
    begin
        return Object'(Day => 0, Hour_Minute => Zero);
    end Zero;

end Date;

    nblk1=4
    nid=0
    hdr6=8
        [0x00] rec0=26 rec1=00 rec2=01 rec3=012
        [0x01] rec0=1f rec1=00 rec2=02 rec3=008
        [0x02] rec0=1e rec1=00 rec2=03 rec3=05e
        [0x03] rec0=14 rec1=00 rec2=04 rec3=000
    tail 0x217540c86874f6e2ce619 0x42a00088462060003