⟦ed6664967⟧

TextFile

with Enumeration_Value;
with String_Utilities;

package body Time_Utilities is

    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;


    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 : Integer;
        Hour_Offset : Integer;
        Junk, Min, Sec : Integer;
    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 := Integer (C_Second);

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

        Hour_Offset := Total_Seconds / Seconds_Per_Hour;

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

        Total_Seconds := Total_Seconds rem Seconds_Per_Hour;
        Result.Minute := Minutes (Total_Seconds / Seconds_Per_Minute);
        Result.Second := Seconds (Total_Seconds rem Seconds_Per_Minute);

        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 : Integer;
    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 := Integer (Date.Second) +
                            Integer (Date.Minute) * Seconds_Per_Minute;

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

        if Date.Sun_Position = Pm then
            Total_Seconds := Total_Seconds + 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 : Integer := Integer (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 - (Integer (I.Elapsed_Days) * Milliseconds_Per_Day);

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

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

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

        I.Elapsed_Milliseconds := Milliseconds (Rest);

        return I;
    end Convert;


    function Interval_Value (S : String) return Interval is separate;


    function Value (S : String) return Interval is
    begin
        return Interval_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

⟦ed6664967⟧ TextFile

Derivation

TextFile
