⟦c33d138f9⟧

TextFile

with Enumeration_Value;
with Machine_Independent_Integer32;
with String_Utilities;

package body Time_Utilities is

    package Mii renames Machine_Independent_Integer32;
    subtype Integer32 is Mii.Integer32;
    function "+" (L, R : Integer32)           return Integer32 renames Mii."+";
    function "-" (L, R : Integer32)           return Integer32 renames Mii."-";
    function "*" (L : Integer32; R : Integer) return Integer32 renames Mii."*";
    function "/" (L : Integer32; R : Integer) return Integer32 renames Mii."/";
    function "=" (L, R : Integer32)           return Boolean   renames Mii."=";
    function "<" (L, R : Integer32)           return Boolean   renames Mii."<";

    Zero                 : constant Integer32 := Integer32 (0);
    Seconds_Per_Minute   : constant           := 60;
    Seconds_Per_Hour     : constant           := 60 * Seconds_Per_Minute;
    Seconds_Per_Half_Day : constant           := 12 * Seconds_Per_Hour;
    Null_Calendar_Time   : Calendar.Time;

    type Number_Array is array (Positive range <>) of Natural;

    type Character_Map is array (Character) of Boolean;
    Is_Numeric : constant Character_Map :=
       Character_Map'('0' | '1' | '2' | '3' | '4' |
                      '5' | '6' | '7' | '8' | '9' => True,
                      others                      => False);

    Is_Alphabetic : constant Character_Map :=
       Character_Map'('a' .. 'z' | 'A' .. 'Z' => True, others => False);
    Null_Time     : constant Time := Time'(Year         => Years'First,
                                           Month        => Months'First,
                                           Day          => Days'First,
                                           Hour         => Hours'First,
                                           Minute       => Minutes'First,
                                           Second       => Seconds'First,
                                           Sun_Position => Sun_Positions'First);
    Null_Interval : constant Interval :=
       Interval'(Elapsed_Days         => Day_Count'First,
                 Elapsed_Hours        => Military_Hours'First,
                 Elapsed_Minutes      => Minutes'First,
                 Elapsed_Seconds      => Seconds'First,
                 Elapsed_Milliseconds => Milliseconds'First);

    Military_Hour : constant array (Sun_Positions, Hours) of Military_Hours :=
       (Am => (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 0),
        Pm => (13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 12));

    -- used in day of week calculation
    Days_In_Month : constant array (Months) of Integer :=
       (January | March | May | July | August | October | December => 31,
        April | June | September | November => 30,
        February => 28);

    function Image (Value   : Integer;
                    Base    : Natural   := 10;
                    Width   : Natural   := 2;
                    Leading : Character := '0') return String
        renames String_Utilities.Number_To_String;

    package Interval_Value is
        -- Hack to get around RCG bug

        function Value (S : String) return Interval;
    end Interval_Value;

    procedure Unique_Prefix is new Enumeration_Value (Months);
    function Convert_Time (Date : Calendar.Time) return Time is
        Result : Time;

        C_Year   : Calendar.Year_Number;
        C_Month  : Calendar.Month_Number;
        C_Day    : Calendar.Day_Number;
        C_Second : Calendar.Day_Duration;

        Total_Seconds  : Integer32;
        Hour_Offset    : Integer32;  
        Junk, Min, Sec : Integer32;
    begin
        Calendar.Split (Date, C_Year, C_Month, C_Day, C_Second);

        Result.Year  := Years (C_Year);
        Result.Month := Months'Val (C_Month - 1);
        Result.Day   := Days (C_Day);

        Total_Seconds := Integer32 (C_Second);

        if Total_Seconds < Integer32 (Seconds_Per_Half_Day) then
            Result.Sun_Position := Am;
        else
            Result.Sun_Position := Pm;
            Total_Seconds := Total_Seconds - Integer32 (Seconds_Per_Half_Day);
        end if;

        Hour_Offset := Total_Seconds / Seconds_Per_Hour;

        if Hour_Offset = Zero then
            Result.Hour         := 12;
            Result.Sun_Position := Pm;

        else
            Result.Hour := Hours (Hour_Offset);
        end if;

---        Total_Seconds := Total_Seconds rem Seconds_Per_Hour;  --tjl was MOD
        Mii.Div_Rem (Total_Seconds, Seconds_Per_Hour, Junk, Total_Seconds);

        Mii.Div_Rem (Total_Seconds, Seconds_Per_Minute, Min, Sec);
        Result.Minute := Minutes (Min);
        Result.Second := Seconds (Sec);
---        Result.Minute := Minutes (Total_Seconds / Seconds_Per_Minute);
---        Result.Second := Seconds (Total_Seconds rem Seconds_Per_Minute);--tjl

        return Result;
    end Convert_Time;

    function Convert_Time (Date : Time) return Calendar.Time is
        C_Year  : Calendar.Year_Number;
        C_Month : Calendar.Month_Number;
        C_Day   : Calendar.Day_Number;

        Total_Seconds : Integer32;
    begin
        C_Year  := Calendar.Year_Number (Date.Year);
        C_Month := Calendar.Month_Number (Months'Pos (Date.Month) + 1);
        C_Day   := Calendar.Day_Number (Date.Day);

        Total_Seconds := Integer32 (Date.Second) +
                            Integer32 (Date.Minute) * Seconds_Per_Minute;

        if Date.Hour /= 12 then
            Total_Seconds := Total_Seconds +
                                Integer32 (Date.Hour) * Seconds_Per_Hour;
        end if;

        if Date.Sun_Position = Pm then
            Total_Seconds := Total_Seconds + Integer32 (Seconds_Per_Half_Day);
        end if;

        return Calendar.Time_Of (C_Year, C_Month, C_Day,
                                 Duration (Total_Seconds));
    exception
        when Calendar.Time_Error =>
            return Calendar.Clock;
    end Convert_Time;

    function Get_Time return Time is
    begin
        return Convert_Time (Calendar.Clock);
    end Get_Time;

    function Image (Month : Months; Full_Width : Boolean := True)
                   return String is
        Name : constant String := Months'Image (Month);
    begin
        if Full_Width then
            return String_Utilities.Capitalize (Name);
        else
            return Name (Name'First .. Name'First + 2);
        end if;
    end Image;

    function Time_Image (Date : Time; Time_Style : Time_Format) return String is
        Sep  : Character := ':';
        Hour : Integer   := Integer (Military_Hour
                                        (Date.Sun_Position, Date.Hour));
    begin
        case Time_Style is
            when Expanded =>
                return Image (Integer (Date.Hour), Width => 0) &
                          Sep & Image (Integer (Date.Minute)) & Sep &
                          Image (Integer (Date.Second)) & ' ' &
                          Sun_Positions'Image (Date.Sun_Position);
            when Military | Ada =>
                if Time_Style = Ada then
                    Sep := '_';
                end if;

                return Image (Hour) & Sep & Image (Integer (Date.Minute)) &
                          Sep & Image (Integer (Date.Second));
            when Short =>
                return Image (Hour) & Sep & Image (Integer (Date.Minute));
        end case;
    end Time_Image;

    function Date_Image (Date : Time; Date_Style : Date_Format) return String is
        Sep : Character := '/';

        Year  : Integer := Integer (Date.Year) mod 100;
        Month : Integer := Months'Pos (Date.Month) + 1;
    begin
        case Date_Style is
            when Expanded =>
                return Image (Date.Month) & ' ' &
                          Image (Integer (Date.Day), Width => 0) & ',' &
                          Image (Integer (Date.Year),
                                 Leading => ' ',
                                 Width   => 5);

            when Month_Day_Year =>
                return Image (Month, Leading => ' ') & Sep &
                          Image (Integer (Date.Day)) & Sep & Image (Year);

            when Day_Month_Year =>
                Sep := '-';
                return Image (Integer (Date.Day), Leading => ' ') & Sep &
                          Image (Date.Month, Full_Width => False) &
                          Sep & Image (Year);

            when Year_Month_Day | Ada =>
                if Date_Style = Ada then
                    Sep := '_';
                end if;

                return Image (Year) & Sep & Image (Month) &
                          Sep & Image (Integer (Date.Day));
        end case;
    end Date_Image;

    function Separator (Date_Style : Date_Format; Time_Style : Time_Format)
                       return String is
    begin
        if Date_Style = Ada and then Time_Style = Ada then
            return "_at_";
        elsif Date_Style = Expanded then
            return " at ";
        else
            return " ";
        end if;
    end Separator;

    function Image (Date       : Time;
                    Date_Style : Date_Format    := Expanded;
                    Time_Style : Time_Format    := Expanded;
                    Contents   : Image_Contents := Both) return String is
    begin
        case Contents is
            when Both =>
                return Date_Image (Date, Date_Style) &
                          Separator (Date_Style, Time_Style) &
                          Time_Image (Date, Time_Style);
            when Date_Only =>
                return Date_Image (Date, Date_Style);
            when Time_Only =>
                return Time_Image (Date, Time_Style);
        end case;
    end Image;

    function Time_Stamp_Image
                (Date : Time := Get_Time; Style : Time_Format := Military)
                return String is
    begin
        if Style = Short then
            return Image (Integer (Date.Minute)) & ':' &
                      Image (Integer (Date.Second));
        else
            return Time_Image (Date, Style);
        end if;
    end Time_Stamp_Image;



    function Convert (I : Interval) return Duration is
        Seconds : Duration := Duration (I.Elapsed_Milliseconds) / 1000;
    begin
        Seconds := Duration (I.Elapsed_Seconds) + Seconds;
        Seconds := Duration (Duration (I.Elapsed_Minutes) * Minute) + Seconds;
        Seconds := Duration (Duration (I.Elapsed_Hours) * Hour) + Seconds;
        Seconds := Duration (Duration (I.Elapsed_Days) * Day) + Seconds;
        return Seconds;
    end Convert;


    function Convert (D : Duration) return Interval is
        I : Interval;

        Milliseconds_Per_Second : constant := 1000;
        Milliseconds_Per_Minute : constant := 60 * Milliseconds_Per_Second;
        Milliseconds_Per_Hour   : constant := 60 * Milliseconds_Per_Minute;
        Milliseconds_Per_Day    : constant := 24 * Milliseconds_Per_Hour;

        Rest : Integer32 := Integer32 (D) * Milliseconds_Per_Second


           ;
    begin
        if D < 0.0 then
            return Null_Interval;
        end if;

        I.Elapsed_Days := Day_Count (Rest / Milliseconds_Per_Day);
        Rest := Rest - (Integer32 (I.Elapsed_Days) * Milliseconds_Per_Day);

        I.Elapsed_Hours := Military_Hours (Rest / Milliseconds_Per_Hour);
        Rest := Rest - (Integer32 (I.Elapsed_Hours) * Milliseconds_Per_Hour);

        I.Elapsed_Minutes := Minutes (Rest / Milliseconds_Per_Minute);
        Rest              := Rest - (Integer32 (I.Elapsed_Minutes) *
                                     Milliseconds_Per_Minute);

        I.Elapsed_Seconds := Seconds (Rest / Milliseconds_Per_Second);
        Rest              := Rest - (Integer32 (I.Elapsed_Seconds) *
                                     Milliseconds_Per_Second);

        I.Elapsed_Milliseconds := Milliseconds (Rest);

        return I;
    end Convert;


    package body Interval_Value is separate;
    function Value (S : String) return Interval is
    begin
        return Interval_Value.Value (S);
    end Value;


    function Time_Value (S : String) return Time is separate;

    function Value (S : String) return Time is
    begin
        return Time_Value (S);
    end Value;

    function Image (D : Duration) return String is
    begin
        return Image (Convert (D));
    end Image;


    function Image (I : Interval) return String is
    begin
        if I.Elapsed_Days > 99999 then
            return Image (Natural (I.Elapsed_Days), Width => 0) & 'D';

        elsif I.Elapsed_Days > 99 then
            return Image
                      (Natural (I.Elapsed_Days), Width => 5, Leading => ' ') &
                   '/' & Image (Natural (I.Elapsed_Hours));

        elsif I.Elapsed_Days > 0 then
            return Image (Natural (I.Elapsed_Days), Leading => ' ') &
                      '/' & Image (Natural (I.Elapsed_Hours)) &
                      ':' & Image (Natural (I.Elapsed_Minutes));

        elsif I.Elapsed_Hours > 0 then
            return Image (Natural (I.Elapsed_Hours), Leading => ' ') &
                      ':' & Image (Natural (I.Elapsed_Minutes)) &
                      ':' & Image (Natural (I.Elapsed_Seconds));

        elsif I.Elapsed_Minutes > 0 then
            return Image (Natural (I.Elapsed_Minutes), Leading => ' ') &
                      ':' & Image (Natural (I.Elapsed_Seconds)) & '.' &
                      Image (Natural (I.Elapsed_Milliseconds), Width => 3);
        else
            return Image (Natural (I.Elapsed_Seconds), Leading => ' ') & '.' &
                      Image (Natural (I.Elapsed_Milliseconds), Width => 3);

        end if;
    end Image;


    function Nil return Time is
    begin
        return Null_Time;
    end Nil;

    function Is_Nil (Date : Time) return Boolean is
    begin
        return Date = Nil;
    end Is_Nil;

    function Nil return Calendar.Time is
    begin
        return Null_Calendar_Time;
    end Nil;

    function Is_Nil (Date : Calendar.Time) return Boolean is

    begin
        return Calendar."=" (Date, Nil);
    end Is_Nil;

    function Image (D : Weekday) return String is
    begin
        case D is
            when 1 =>
                return "Monday";
            when 2 =>
                return "Tuesday";
            when 3 =>
                return "Wednesday";
            when 4 =>
                return "Thursday";
            when 5 =>
                return "Friday";
            when 6 =>
                return "Saturday";
            when 7 =>
                return "Sunday";
        end case;
    end Image;

    function Make_Weekday (D : Integer) return Weekday is
        Day : Integer := D mod 7;
    begin
        if Day = 0 then
            return 7;
        else
            return Weekday (Day);
        end if;
    end Make_Weekday;

    pragma Inline (Make_Weekday);

    function Day_Of_Week (T : Time := Get_Time) return Weekday is
        -- Uses Zeller's congruence to compute the day of week of given date.
        -- See "Problems for Computer Solutions", Gruenberger & Jaffray, Wiley,
        -- 1965, p. 255ff.
        Zyear, Zmonth, Zcentury, Zyy : Integer;
    begin
        -- Remap month# so Mar=1 & Jan, Feb=11, 12 of PRECEDING year
        if Months'Pos (T.Month) >= 3 then
            Zyear  := Integer (T.Year);  
            Zmonth := Months'Pos (T.Month) - 1;
        else  -- Jan or Feb
            Zyear  := Integer (T.Year) - 1;
            Zmonth := Months'Pos (T.Month) + 11;
        end if;  
        Zcentury := Zyear / 100;
        Zyy      := Zyear rem 100;
        return Make_Weekday (((26 * Zmonth - 2) / 10) + Integer (T.Day) +
                             Zyy + (Zyy / 4) + (Zcentury / 4) - 2 * Zcentury);
    end Day_Of_Week;

    function Day_Of_Week (T : Calendar.Time) return Weekday is
    begin
        return Day_Of_Week (Convert_Time (T));
    end Day_Of_Week;

    function "+" (D : Weekday; I : Integer) return Weekday is
    begin
        return Make_Weekday (Integer (D) + I);
    end "+";

    function "-" (D : Weekday; I : Integer) return Weekday is
    begin
        return Make_Weekday (Integer (D) - I);
    end "-";

    function Duration_Until (T : Calendar.Time) return Duration is
    begin
        return Calendar."-" (T, Calendar.Clock);
    end Duration_Until;

    function Duration_Until (T : Time) return Duration is
    begin
        return Duration_Until (Convert_Time (T));
    end Duration_Until;

    function Duration_Until_Next
                (H : Military_Hours; M : Minutes := 0; S : Seconds := 0)
                return Duration is
        T  : Time    := Get_Time;
        D  : Duration;
        Hr : Natural := Natural (H);
    begin
        T.Minute := M;
        T.Second := S;
        if Hr >= 12 then
            T.Sun_Position := Pm;
            Hr             := Hr - 12;
        else
            T.Sun_Position := Am;
        end if;
        if Hr = 0 then
            T.Hour := 12;
        else
            T.Hour := Hours (Hr);
        end if;
        D := Duration_Until (T);
        if D < 0.0 then
            D := Day + D;
        end if;
        return D;
    end Duration_Until_Next;

begin
    Null_Calendar_Time := Convert_Time (Null_Time);
end Time_Utilities;
DataMuseum.dk

Rational R1000/400 Tapes

⟦c33d138f9⟧ TextFile

Derivation

TextFile
