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;