Re: Calendar Time & Date images

["Joachim Schr�er" <joachim.schroeer@web.de>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 29304 bytes --]

Hello,

some time ago someone asked for the above.
Here is an Ada95 version of the calendar_utilities package
from "Booch: Software Components with Ada".
Image functions are included.

Best regards
    J. Schr�er


-- -*- Mode: Ada -*-

-- Filename : portable.ads

-- Description : Root package of all packages that support portablility

-- and isolate platform dependencies

-- Author : J. Schroeer

-- Created On : Wed Jul 2 15:10:03 1997

-- Last Modified By:

-- Last Modified On: Wed Jul 2 15:11:59 1997

-- Update Count : 1

-- Status :

package Portable is


pragma Pure(Portable);

end Portable;

-- -*- Mode: Ada -*-

-- Filename : portable-standard.ads

-- Description : Declare portable numeric scalar types

-- Author : J. Schr�er

-- Created On : Thu Mar 27 09:30:18 1997

-- Last Modified By:

-- Last Modified On: Thu Mar 27 11:02:39 1997

-- Update Count : 2

-- Status :

----------------------------------------------------------------------------
---

-- Purpose: Define own numeric types (integer and real) corresponding to the

-- ones of package standard. The package is used to enhance

-- portability.

--

-- Remarks: For all own software, these types shall be used instead of the

-- ones from package standard.

--

-- Direct visibility of types and operations:

-- ------------------------------------------

-- The predefined package standard is directly visible by the implicit

-- "with standard; use standard;" context clause in front of each

-- compilation unit.

--

-- The following operators are implicitly declared for each

-- numeric type (predefined types in package standard or 'own' types,

-- see Ada95 LRM, chapter A.1, page 260 ff.)

--

-- integer types (integer_8, integer_16, integer_32, see below)

--

-- relational: =, /=, <, <=, >, >=,

-- unary : +, -, abs

-- binary : +, -, *, /, rem, mod, **

--

-- floating point types (float_32, float_64, see below)

--

-- relational: =, /=, <, <=, >, >=,

-- unary : +, -, abs

-- binary : +, -, *, /, ** (float ** integer)

--

-- To gain direct visibility of these operations for the 'own'

-- types declared in this package in order to use them in

-- infix operator notation as

--

-- 'a+b'

--

-- rather than in function call notation as

--

-- 'portable.standard."+"(a, b)'

--

-- in Ada83

-- --------

-- a with- and a use clause may be written in each

-- compilation unit, that uses one of the types.

--

-- "with portable.standard; use portable.standard;"

--

-- in Ada95

-- --------

-- a 'with clause' shall be written as a context clause and a

-- 'use type clause' shall be written for each type, operators

-- shall be made direcly visible for in order to use them in infix

-- notation, e.g.

--

-- with portable.standard;

-- package body models.controllers is

--

-- procedure calculate(the_model : in out simulink.model) is

-- use type portable.standard.float_64;

-- begin

-- the_model.t := the_model.t + the_model.delta_t;

--

-- the_model.t and the_model.delta_t are of type

-- portable.standard.float_64

--

-- Effects:

-- None

package Portable.Standard is

pragma Pure(Portable.Standard);

type Integer_8 is range - 2 ** 7 .. 2 ** 7 - 1;

for Integer_8'Size use 8;

type Integer_16 is range - 2 ** 15 .. 2 ** 15 - 1;

for Integer_16'Size use 16;

type Integer_32 is range - 2 ** 31 .. 2 ** 31 - 1;

for Integer_32'Size use 32;

subtype Natural_8 is Integer_8 range 0 .. Integer_8'Last;

subtype Positive_8 is Integer_8 range 1 .. Integer_8'Last;

subtype Natural_16 is Integer_16 range 0 .. Integer_16'Last;

subtype Positive_16 is Integer_16 range 1 .. Integer_16'Last;

subtype Natural_32 is Integer_32 range 0 .. Integer_32'Last;

subtype Positive_32 is Integer_32 range 1 .. Integer_32'Last;


type Float_32 is digits 6;

for Float_32'Size use 32;

type Float_64 is digits 15;

for Float_64'Size use 64;


type Byte is mod 2 ** 8;

for Byte'Size use 8;

type Word is mod 2 ** 16;

for Word'Size use 16;

end Portable.Standard;

-- -*- Mode: Ada -*-

-- Filename : utilities-calendar_utilities.ads

-- Description : Taken from "Software components with Ada" by Grady Booch

-- Author : J. Schroeer

-- Created On : Wed Mar 26 16:55:03 1997

-- Last Modified By:

-- Last Modified On: Wed Jul 2 13:37:09 1997

-- Update Count : 3

-- Status :

with Portable.Standard; use Portable.Standard;

with Ada.Calendar;

package Utilities.Calendar_Utilities is

subtype Year is Ada.Calendar.Year_Number;

subtype Month is Positive range 1 .. 12;

subtype Day is Positive range 1 .. 31;

subtype Hour is Natural range 0 .. 23;

subtype Minute is Natural range 0 .. 59;

subtype Second is Natural range 0 .. 59;

subtype Millisecond is Natural range 0 .. 999;

type Month_Name is (January, February, March,

April, May, June,

July, August, September,

October, November, December);

type Day_Name is (Monday, Tuesday, Wednesday,

Thursday, Friday, Saturday, Sunday);

type Time is

record

The_Weekday : Day_Name := Day_Name'First;

The_Year : Year := Year'First;

The_Month : Month := Month'First;

The_Day : Day := Day'First;

The_Hour : Hour := Hour'First;

The_Minute : Minute := Minute'First;

The_Second : Second := Second'First;

The_Millisecond : Millisecond := Millisecond'First;

end record;

type Interval is

record

Elapsed_Days : Natural := 0;

Elapsed_Hours : Hour := Hour'First;

Elapsed_Minutes : Minute := Minute'First;

Elapsed_Seconds : Second := Second'First;

Elapsed_Milliseconds : Millisecond := Millisecond'First;

end record;

subtype Year_Day is Positive range 1 .. 366;

type Date_Format is (Full, -- june 30, 1988

Month_Day_Year); -- 06/30/88

function Is_Leap_Year (The_Year : in Year) return Boolean;

function Days_In (The_Year : in Year) return Year_Day;

function Days_In (The_Month : in Month;

The_Year : in Year) return Day;

function Year_Day_Of (The_Day : in Day;

The_Month : in Month;

The_Year : in Year) return Year_Day;


function Month_Of (The_Month : in Month) return Month_Name;

function Month_Of (The_Month : in Month_Name) return Month;

function Day_Of (The_Year : in Year;

The_Day : in Year_Day) return Day_Name;

function Day_Of (The_Time : in Time) return Year_Day;

function Time_Of (The_Year : in Year;

The_Day : in Year_Day) return Time;

function Time_Of (The_Time : in Time) return Ada.Calendar.Time;

function Time_Of (The_Time : in Ada.Calendar.Time) return Time;

function Time_Image_Of (The_Time : in Time;

Hundreds : in Boolean := True) return String;

function Time_Image_Of (The_Time : in Ada.Calendar.Time;

Hundreds : in Boolean := True) return String;


-- The time image of a variable of type time delivers a string with the

-- constant number of 11 characters of the following format.

-- 12345678901

-- Hundreds = true

-- hh:mm:ss:hh

-- 16:13:08:00

-- Hundreds = false

-- hh:mm:ss

-- 16:13:08

function Date_Image_Of (The_Time : in Time;

Date_Form : in Date_Format := Full) return String;

-- Date_Format = full:

-- The time image of a variable of type time delivers a string with the

-- constant number of 38 characters of the following format.

-- 1234567890123456789012345678

-- wwwwwwwww mmmmmmmmm dd, yyyy

-- FRIDAY JUNE 23, 1995

-- Date_Format = Month_Day_Year:

-- The time image of a variable of type time delivers a string with the

-- constant number of 38 characters of the following format.

-- 12345678

-- mm/dd/yy

-- 06/23/95

function Value_Of (The_Date : in String;

The_Time : in String;

Date_Form : in Date_Format := Full) return Time;

-- The function value_of needs strings of the above formats.

-- Otherwise exception lexical_error is raised.

function Image_Of (The_Interval : in Interval;

Milliseconds : in Boolean := True;

Days : in Boolean := True) return String;


function Image_Of (The_Interval : in Duration;

Milliseconds : in Boolean := True;

Days : in Boolean := True) return String;

-- The intervall image of a variable of type time delivers a string with the

-- constant number of 15 characters of the following format.

-- 123456789012345

-- dd:hh:mm:ss:mmm

-- 12:08:35:10:123

-- If days = false, days is only displayed, when it is > 0.

function Value_Of (The_Interval : in String) return Interval;

-- The function value_of needs a string of the above format.

-- Otherwise exception lexical_error is raised.

Lexical_Error : exception;


----------------------------------------------------------------------------

-- Some functions for interval.


function Duration_Of (The_Interval : in Interval) return Duration;

function Interval_Of (The_Duration : in Duration) return Interval;

function Interval_Of (The_Seconds : in Float_64) return Interval;

-- The interval_of functions may raise ada.calendar.time_error.


function "-" (Left, Right : in Ada.Calendar.Time) return Interval;

function "-" (Left, Right : in Time) return Interval;


function "-" (Left, Right : in Ada.Calendar.Time) return Float_64;

function "-" (Left, Right : in Time) return Float_64;


-- The result is in seconds.

function Seconds_Of (The_Interval : in Interval) return Float_64;


-- Gives the number of seconds between 2 intervals.

----------------------------------------------------------------------------
-

subtype Gregorian_Calendar_Year is Natural range 1582 .. Natural'Last;

function Day_Of (The_Year : in Gregorian_Calendar_Year;

The_Month : in Month;

The_Day : in Day) return Day_Name;

-- Schroer, 14.8.92: the additional routine IMAGE_OF delivers a image by

-- separating the date- and the time-image by " ,".

function Image_Of (The_Time : in Time;

Date_Form : in Date_Format := Full;

Hundreds : in Boolean := True) return String;


function Image_Of (The_Time : in Ada.Calendar.Time;

Date_Form : in Date_Format := Full;

Hundreds : in Boolean := True) return String;

-- The time image of a variable of type time delivers a string with the

-- constant number of 41 characters of the following format (for full,
true).

-- 12345678901234567890123456789012345678901

-- wwwwwwwww mmmmmmmmm dd, yyyy, hh:mm:ss:hh

-- FRIDAY JUNE 23, 1995, 16:13:08:00

function Value_Of (The_Time : in String) return Time;

-- The function value_of needs a string of the above format.

-- Otherwise exception lexical_error is raised.

end Utilities.Calendar_Utilities;

-- -*- Mode: Ada -*

-- Filename : utilities-calendar_utilities.adb

-- Description : Taken from "Software components with ADA" by Grady Booch

-- Author : J. Schroeer

-- Created On : Wed Mar 26 17:03:42 1997

-- Last Modified By:

-- Last Modified On: Wed Jul 2 13:37:20 1997

-- Update Count : 9

-- Status :

with ada.Strings.fixed;

package body Utilities.Calendar_Utilities is

use type Ada.Calendar.Time;


type Month_Day is array (Month) of Day;

Days_Per_Year : constant := 365;

Days_Per_Month : constant Month_Day :=

(1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,

7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

First_Day : constant Day_Name := Tuesday;

Seconds_Per_Minute : constant Portable.Standard.Integer_32 := 60;

Seconds_Per_Hour : constant Portable.Standard.Integer_32 :=

60 * Seconds_Per_Minute;

Seconds_Per_Day : constant Portable.Standard.Integer_32 :=

24 * Seconds_Per_Hour;

----------------------------------------------------------------------------
-

function Image_Of (The_Number : in Natural) return String is

begin

if The_Number < 10 then

return '0' & ada.Strings.fixed.trim(Integer'Image(The_Number),

ada.strings.left);

else

return ada.Strings.fixed.trim(Integer'Image(The_Number),

ada.strings.left);

end if;

end Image_Of;

----------------------------------------------------------------------------
-

function Is_Leap_Year (The_Year : in Year) return Boolean is

begin

if The_Year rem 100 = 0 then

return The_Year rem 400 = 0;

else

return The_Year rem 4 = 0;

end if;

end Is_Leap_Year;

----------------------------------------------------------------------------
-

function Days_In (The_Year : in Year) return Year_Day is

begin

if Is_Leap_Year(The_Year) then

return Days_Per_Year + 1;

else

return Days_Per_Year;

end if;

end Days_In;

----------------------------------------------------------------------------
-

function Days_In (The_Month : in Month;

The_Year : in Year) return Day is

begin

if The_Month = Month_Name'Pos(February) + 1 and Is_Leap_Year(The_Year) then

return Days_Per_Month(Month_Name'Pos(February) + 1) + 1;

else

return Days_Per_Month(The_Month);

end if;

end Days_In;

----------------------------------------------------------------------------
-

function Year_Day_Of (The_Day : in Day;

The_Month : in Month;

The_Year : in Year) return Year_Day is

Day : Year_Day := The_Day;

begin

for Month in 1 .. The_Month - 1 loop

Day := Day + Days_In (The_Month => Month, The_Year => The_Year);

end loop;

return Day;

end Year_Day_Of;

----------------------------------------------------------------------------
-

function Month_Of (The_Month : in Month) return Month_Name is

begin

return Month_Name'Val(The_Month - 1);

end Month_Of;

----------------------------------------------------------------------------
-

function Month_Of (The_Month : in Month_Name) return Month is

begin

return Month_Name'Pos(The_Month) + 1;

end Month_Of;

----------------------------------------------------------------------------
-

procedure Month_And_Day_Of(The_Year : in Year;

The_Day : in Year_Day;

The_Month : out Month;

The_Month_Day : out Day) is

Result : Year_Day := The_Day;

Days : Year_Day;

begin

for Index in Month'range loop

The_Month := Index;

Days := Year_Day(Days_In(The_Month => Index,

The_Year => The_Year));

exit when Result <= Days;

Result := Result - Days;

end loop;

The_Month_Day := Day(Result);

end Month_And_Day_Of;

----------------------------------------------------------------------------
-

function Day_Of (The_Year : in Year;

The_Day : in Year_Day) return Day_Name is

The_Month : Month;

The_Month_Day : Day;

begin

Month_And_Day_Of(The_Year => The_Year,

The_Day => The_Day,

The_Month => The_Month,

The_Month_Day => The_Month_Day);

return Day_Of(The_Year => Gregorian_Calendar_Year(The_Year),

The_Month => The_Month,

The_Day => The_Month_Day);

end Day_Of;

----------------------------------------------------------------------------
-

function Day_Of (The_Time : in Time) return Year_Day is

Day : Year_Day := The_Time.The_Day;

begin

for Month in 1 .. The_Time.The_Month - 1 loop

Day := Day + Days_In (The_Month => Month,

The_Year => The_Time.The_Year);

end loop;

return Day;

end Day_Of;

----------------------------------------------------------------------------
-

function Time_Of (The_Year : in Year;

The_Day : in Year_Day) return Time is

The_Month : Month;

The_Month_Day : Day;

begin

Month_And_Day_Of(The_Year => The_Year,

The_Day => The_Day,

The_Month => The_Month,

The_Month_Day => The_Month_Day);

return Time'(The_Weekday => Day_Of(The_Year, The_Day),

The_Year => The_Year,

The_Month => The_Month,

The_Day => The_Month_Day,

The_Hour => Hour'First,

The_Minute => Minute'First,

The_Second => Second'First,

The_Millisecond => Millisecond'First);

end Time_Of;

----------------------------------------------------------------------------
-

function Time_Of (The_Time : in Time) return Ada.Calendar.Time is

begin

return Ada.Calendar.Time_Of

(Year => Ada.Calendar.Year_Number (The_Time.The_Year),

Month => Ada.Calendar.Month_Number(The_Time.The_Month),

Day => Ada.Calendar.Day_Number (The_Time.The_Day),

Seconds => Ada.Calendar.Day_Duration

(Integer_32(The_Time.The_Hour) * Seconds_Per_Hour +

Integer_32(The_Time.The_Minute) * Seconds_Per_Minute +

Integer_32(The_Time.The_Second)));

end Time_Of;

----------------------------------------------------------------------------
-

function Time_Of (The_Time : in Ada.Calendar.Time) return Time is

Y : Ada.Calendar.Year_Number;

M : Ada.Calendar.Month_Number;

D : Ada.Calendar.Day_Number;

S : Ada.Calendar.Day_Duration;

Si : Integer_32;

H : Hour;

Min : Minute;

Sec : Second;

begin

Ada.Calendar.Split(Date => The_Time,

Year => Y,

Month => M,

Day => D,

Seconds => S);

Si := Integer_32(S);

if Duration(Si) - S = 0.5 or else Si = 86_400 then

Si := Si - 1;

end if;

H := Hour(Si / Seconds_Per_Hour);

Min := Minute((Si - Integer_32(H) * Seconds_Per_Hour) /

Seconds_Per_Minute);

Sec := Second(Si - Integer_32(H) * Seconds_Per_Hour - Integer_32(Min) *

Seconds_Per_Minute);

return Time'(The_Weekday => Day_Of

(The_Year => Gregorian_Calendar_Year(Y),

The_Month => Month(M),

The_Day => Day(D)),

The_Year => Year(Y),

The_Month => Month(M),

The_Day => Day(D),

The_Hour => H,

The_Minute => Min,

The_Second => Sec,

The_Millisecond => Millisecond(S - Duration(Si)) / 1000);

end Time_Of;

----------------------------------------------------------------------------
-

function Time_Image_Of (The_Time : in Time;

Hundreds : in Boolean := True) return String is

begin

if Hundreds then

return Image_Of(Natural(The_Time.The_Hour)) & ':' &

Image_Of(Natural(The_Time.The_Minute)) & ':' &

Image_Of(Natural(The_Time.The_Second)) & ':' &

Image_Of(Natural(The_Time.The_Millisecond) / 10);

else

return Image_Of(Natural(The_Time.The_Hour)) & ':' &

Image_Of(Natural(The_Time.The_Minute)) & ':' &

Image_Of(Natural(The_Time.The_Second));

end if;

end Time_Image_Of;

----------------------------------------------------------------------------
-

function Time_Image_Of (The_Time : in Ada.Calendar.Time;

Hundreds : in Boolean := True) return String is

begin

return Time_Image_Of(Time_Of(The_Time), Hundreds);

end Time_Image_Of;

----------------------------------------------------------------------------
-

function Date_Image_Of (The_Time : in Time;

Date_Form : in Date_Format := Full) return String is

---------------------------------------------------------------

function Extended_Name (Day : in Day_Name) return String is

Blanks : constant String := " ";

Day_Image : constant String := Day_Name'Image(Day);

begin

return Day_Image & Blanks (1 .. Day_Name'Width - Day_Image'Length);

end Extended_Name;

---------------------------------------------------------------

function Extended_Name (Month : in Month_Name) return String is

Blanks : constant String := " ";

Month_Image : constant String := Month_Name'Image(Month);

begin

return Month_Image & Blanks (1 .. Month_Name'Width - Month_Image'Length);

end Extended_Name;

---------------------------------------------------------------

function Year_Image_Of (The_year : in Year) return String is

begin

if The_Year >= 2000 then

return Image_Of (Natural (The_Year - 2000));

else

return Image_Of (Natural (The_Year - 1900));

end if;

end Year_Image_Of;

---------------------------------------------------------------

begin

case Date_Form is

when Full =>

return Extended_Name (The_Time.The_Weekday) & ' ' &

Extended_Name (Month_Of (The_Time.The_Month)) &

' ' & Image_Of (Natural (The_Time.The_Day)) &

", " & Image_Of (Natural (The_Time.The_Year));

when Month_Day_Year =>

return --Extended_Name (The_Time.The_Weekday) & ' ' &

Image_Of (Natural (The_Time.The_Month)) & '/' &

Image_Of (Natural (The_Time.The_Day)) &

'/' & Year_Image_Of (The_Time.The_Year);

end case;

end Date_Image_Of;

----------------------------------------------------------------------------
-

function Value_Of (The_Date : in String;

The_Time : in String;

Date_Form : in Date_Format := Full) return Time is

D : String renames The_Date;

T : String renames The_Time;

Ret : Time;

Blank_Pos : constant natural := ada.strings.fixed.index

(source => D, pattern => " ");

begin

Ret.The_Weekday := Day_Name'Value(D(D'First .. Blank_Pos - 1));

case Date_Form is

when Full =>

Ret.The_Year := Year'Value(D(D'Last - 3 .. D'Last));

Ret.The_Month := 1 + Month_Name'Pos(Month_Name'Value

(D(Blank_Pos + 1 .. ada.strings.fixed.index

(source => ada.strings.fixed.trim

(D(Blank_Pos + 1 .. D'Last),

ada.strings.left),

pattern => " ") - 1)));

Ret.The_Day := Day'Value(D(D'Last - 7 .. D'Last - 6));

when Month_Day_Year =>

Ret.The_Year := Year'Value (D(D'Last - 1 .. D'Last)) + 1900;

Ret.The_Month := Month'Value(D(D'Last - 4 .. D'Last - 3));

Ret.The_Day := Day'Value (D(D'Last - 7 .. D'Last - 6));

end case;

Ret.The_Hour := Hour'Value (T(T'First .. T'First + 1));

Ret.The_Minute := Minute'Value (T(T'First + 3 .. T'First + 4));

Ret.The_Second := Second'Value (T(T'First + 6 .. T'First + 7));

Ret.The_Millisecond := Millisecond'Value(T(T'First + 9 .. T'Last));

return Ret;

exception

when Constraint_Error => raise Lexical_Error;

end Value_Of;

----------------------------------------------------------------------------
-

function Duration_Of (The_Interval : in Interval) return Duration is

begin

return Duration(Seconds_Of(The_Interval));

exception

when others => raise Ada.Calendar.Time_Error;

end Duration_Of;

----------------------------------------------------------------------------
-

function Interval_Of (The_Duration : in Duration) return Interval is

Seconds : constant Integer_32 := Integer_32(The_Duration);

Int : Interval;

Temp : Integer_32;

begin

Int.Elapsed_Days := Natural(Seconds / Seconds_Per_Day);

Temp := Seconds - Integer_32(Int.Elapsed_Days) *

Seconds_Per_Day;

Int.Elapsed_Hours := Hour(Temp / Seconds_Per_Hour);

Temp := Temp - Integer_32(Int.Elapsed_Hours) *

Seconds_Per_Hour;

Int.Elapsed_Minutes := Minute(Temp / Seconds_Per_Minute);

Int.Elapsed_Seconds := Second(Temp - Integer_32(Int.Elapsed_Minutes) *

Seconds_Per_Minute);

Int.Elapsed_Milliseconds := Millisecond((The_Duration - Duration(Seconds))

/ 1000);

return Int;

-- exception

-- when others => raise Ada.Calendar.Time_Error;

end Interval_Of;

----------------------------------------------------------------------------
-

function Image_Of (The_Interval : in Interval;

Milliseconds : in Boolean := True;

Days : in Boolean := True) return String is

begin

if Days then

if Milliseconds then

return Image_Of(Natural(The_Interval.Elapsed_Days)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Hours)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Minutes)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Seconds)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Milliseconds));

else

return Image_Of(Natural(The_Interval.Elapsed_Days)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Hours)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Minutes)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Seconds));

end if;

else

if Milliseconds then

if The_Interval.Elapsed_Days > 0 then

return Image_Of(Natural(The_Interval.Elapsed_Days)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Hours)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Minutes)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Seconds)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Milliseconds));

else

return Image_Of(Natural(The_Interval.Elapsed_Hours)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Minutes)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Seconds)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Milliseconds));

end if;

else

if The_Interval.Elapsed_Days > 0 then

return Image_Of(Natural(The_Interval.Elapsed_Days)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Hours)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Minutes)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Seconds));

else

return Image_Of(Natural(The_Interval.Elapsed_Hours)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Minutes)) & ':' &

Image_Of(Natural(The_Interval.Elapsed_Seconds));

end if;

end if;

end if;

end Image_Of;

----------------------------------------------------------------------------
-

function Image_Of (The_Interval : in Duration;

Milliseconds : in Boolean := True;

Days : in Boolean := True) return String is

begin

return Image_Of(Interval_Of(The_Interval), Milliseconds, Days);

end Image_Of;

----------------------------------------------------------------------------
-

function Value_Of (The_Interval : in String) return Interval is

I : String renames The_Interval;

begin

return Interval'

(Elapsed_Days => Natural'Value (I(I'First .. I'First + 1)),

Elapsed_Hours => Hour'Value (I(I'First + 3 .. I'First + 4)),

Elapsed_Minutes => Minute'Value (I(I'First + 5 .. I'First + 6)),

Elapsed_Seconds => Second'Value (I(I'First + 7 .. I'First + 8)),

Elapsed_Milliseconds => Millisecond'Value(I(I'First + 9 .. I'Last)));

end Value_Of;

----------------------------------------------------------------------------
-

function "-" (Left, Right : in Ada.Calendar.Time) return Interval is

begin

return Interval_Of(Float_64'(Left - Right));

end "-";

----------------------------------------------------------------------------
-

function "-" (Left, Right : in Time) return Interval is

begin

return Time_Of(Left) - Time_Of(Right);

end "-";

----------------------------------------------------------------------------
-

function "-" (Left, Right : in Ada.Calendar.Time) return Float_64 is


Left_Year, Right_Year : Ada.Calendar.Year_Number;

Left_Month, Right_Month : Ada.Calendar.Month_Number;

Left_Day, Right_Day : Ada.Calendar.Day_Number;

Left_Sec, Right_Sec : Ada.Calendar.Day_Duration;

Days : Integer_32 := 0;

begin

if Left < Right then

return -(right - left);

end if;

Ada.Calendar.Split (Date => Left,

Year => Left_Year,

Month => Left_Month,

Day => Left_Day,

Seconds => Left_Sec);

Ada.Calendar.Split (Date => Right,

Year => Right_Year,

Month => Right_Month,

Day => Right_Day,

Seconds => Right_Sec);

Days := Integer_32(Year_Day_Of (The_Year => Left_Year,

The_Month => Left_Month,

The_Day => Left_Day) -

Year_Day_Of (The_Year => Right_Year,

The_Month => Right_Month,

The_Day => Right_Day));

if Left_Year /= Right_Year then

for I in Right_Year .. Left_Year - 1 loop

Days := Days + Integer_32(Days_In (I));

end loop;

end if;

return Float_64(Days) * Float_64(Seconds_Per_Day) +

Float_64(Left_Sec) - Float_64(Right_Sec);

end "-";

----------------------------------------------------------------------------
-

function "-" (Left, Right : in Time) return Float_64 is

begin

return Seconds_Of(Left - Right);

end "-";

----------------------------------------------------------------------------
-

function Seconds_Of (The_Interval : in Interval) return Float_64 is

begin

return Float_64(The_Interval.Elapsed_Days) * Float_64(Seconds_Per_Day) +

Float_64(The_Interval.Elapsed_Hours) * Float_64(Seconds_Per_Hour) +

Float_64(The_Interval.Elapsed_Minutes) * Float_64(Seconds_Per_Minute) +

Float_64(The_Interval.Elapsed_Seconds) +

Float_64(The_Interval.Elapsed_Milliseconds) / 1000.0;

end Seconds_Of;

----------------------------------------------------------------------------
-

function Interval_Of (The_Seconds : in Float_64) return Interval is

The : Interval;

Delta_Sec : Float_64;

begin

The.Elapsed_Days := Natural(Float_64'Floor

(The_Seconds / Float_64(Seconds_Per_Day)));

Delta_Sec := The_Seconds - Float_64(The.Elapsed_Days) *

Float_64(Seconds_Per_Day);

The.Elapsed_Hours := Hour(Float_64'Floor(Delta_Sec / 3600.0));

Delta_Sec := Delta_Sec - Float_64(The.Elapsed_Hours) * 3600.0;

The.Elapsed_Minutes := Minute(Float_64'Floor(Delta_Sec / 60.0));

Delta_Sec := Delta_Sec - Float_64(The.Elapsed_Minutes) * 60.0;

The.Elapsed_Seconds := Second(Float_64'Floor(Delta_Sec));

The.Elapsed_Milliseconds := Millisecond((Delta_Sec -

Float_64(The.Elapsed_Seconds)) * 1000.0);

return The;

-- exception

-- when others => raise Ada.Calendar.Time_Error;

end Interval_Of;

----------------------------------------------------------------------------
-

function Day_Of (The_Year : in Gregorian_Calendar_Year;

The_Month : in Month;

The_Day : in Day) return Day_Name is

Factor : Integer_32;

begin

if The_Month <= 2 then

Factor := 365 * Integer_32(The_Year) +

Integer_32(Integer_32(The_Day + 31 * (The_Month - 1) + (The_Year - 1) / 4) -

Integer_32(Float_64'Floor

(0.75 * Float_64((The_Year - 1) / 100 + 1))));

else

Factor := 365 * Integer_32(The_Year) +

Integer_32(Integer_32(The_Day + 31 * (The_Month - 1)) -

Integer_32(Float_64'Floor(0.4 * Float_64(The_Month) + 2.3)) +

Integer_32(The_Year / 4) -

Integer_32(Float_64'Floor(0.75 * Float_64(The_Year / 100 + 1))));

end if;

return Day_Name'Val((Factor mod 7 + 5) mod 7);

end Day_Of;

----------------------------------------------------------------------------
-

function Image_Of (The_Time : in Time;

Date_Form : in Date_Format := Full;

Hundreds : in Boolean := True) return String is

begin

return Date_Image_Of(The_Time, Date_Form) & ", " &

Time_Image_Of(The_Time, Hundreds);

end Image_Of;

----------------------------------------------------------------------------
-

function Image_Of (The_Time : in Ada.Calendar.Time;

Date_Form : in Date_Format := Full;

Hundreds : in Boolean := True) return String is

begin

return Image_Of(Time_Of(The_Time), Date_Form, Hundreds);

end Image_Of;

----------------------------------------------------------------------------
-

function Value_Of (The_Time : in String) return Time is

Pos : constant Positive := ada.strings.fixed.index

(source => The_Time,

pattern => ",",

going => ada.strings.backward);

begin

return Value_Of (The_Date => The_Time (The_Time'First .. Pos - 1),

The_Time => The_Time (Pos + 2 .. The_Time'Last));

end Value_Of;

----------------------------------------------------------------------------
-

end Utilities.Calendar_Utilities;