Calendar Formatter
-- =================================================================
-- Calendar_Formatter.Ads
-- by Richard Riehle, AdaWorks Software Engineering
-- http://www.adaworks.com
-- This package allows a client to create time in a variety of
-- formats. It is based on Ada.Calendar as defined in Chapter 9
-- of the Ada Language Reference Manual. You may first get the
-- Time using one of the two Get functions. Then get the formatted
-- time by calling one of the formatted time functions.
-- This package is not warranted by the author. There are no
-- guarantees either implied or specified. It is available for
-- experimentation and student use. If you plan to use it in any
-- production quality software, you should test it thoroughly and
-- make corrections as you require.
-- Richard Riehle
-- NOTE: Not all functions are implemented in this version. Future
-- versions will contain full implementation along with more features
-- such as child packages for doing comparisons and calculations.
-- =================================================================
package Calendar_Formatter is
type Formatted_Time is private; -- cannot be limited in this design
because
-- one function returns object of the
type and
-- requires an assignment statement
type Time_Reference is access all Formatted_Time;
type Month_1 is (January, February, March, April,
May, June, July, August,
September, October, November, December);
type Month_2 is (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct,
Nov, Dec);
type Day_1 is (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
type Day_2 is (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
subtype Work_Day_1 is Day_1 range Monday..Friday;
subtype Work_Day_2 is Day_2 range Mon..Fri;
function Get_Time return Formatted_Time;
function Get_Time return Time_Reference;
function YY (FT : Formatted_Time) return String; -- two character string for year
function YYYY (FT : Formatted_Time) return String; -- four character string for year
function DD (FT : Formatted_Time) return String; -- two character string for day
function MM (FT : Formatted_Time) return String; -- two character string for month
function Hour12 (FT : Formatted_Time) return String; -- two character string 12 hour clock hour
function AMPM (FT : Formatted_Time) return String; -- two character string; AM or PM
function Hour24 (FT : Formatted_Time) return String; -- two character string 24 hour clock hour
function Minute (FT : Formatted_Time) return String; -- two character string minute
function Month (FT : Formatted_Time) return String; -- Month fully spelled out
function Month (FT : Formatted_Time) return Month_1; -- Month in format of the Type;
-- function Month (FT : Formatted_Time) return Month_2; -- Not yet implemented
-- function Day (FT : Formatted_Time) return Day_1; -- Not yet implemented
-- function Day (FT : Formatted_Time) return Day_2; -- Not yet implemented
function Format_1 (FT : Formatted_Time) return Formatted_Time; -- Returns a copy of the private type
function Format_2 (FT : Formatted_Time) return String; -- formatted MM-DD-YY
function Format_3 (FT : Formatted_Time) return String; -- formatted MM-DD-YYYY HH:MM:SS
function Format_4 (FT : Formatted_Time) return String; -- e.g., July 21, 1999
function Total_Seconds (FT : Formatted_Time) return String; -- Raw number of seconds in Time
Time_Format_Error : exception;
private
type Formatted_Time is
record
Year : String(1..4) := (others => ' ');
Month : String(1..2) := (others => ' ');
Day : String(1..2) := (others => ' ');
Hour24 : String(1..2) := (others => ' ');
Hour12 : String(1..2) := (others => ' ');
Minute : String(1..2) := (others => ' ');
Seconds : String(1..2) := (others => ' ');
AMPM : String(1..2) := (others => ' ');
Noon_Mid : String(1..8) := "Midnight"; -- or "Noon ";
Month_Name : Month_1;
Day_Name : Day_1;
Holiday : String(1..15) := (others => ' ');
end record;
end Calendar_Formatter;
with Ada.Calendar; -- ALRM 9.6/10
with Ada.Text_IO; -- ALRM A.10
with Ada.Integer_Text_IO; -- ALRM A.10.8
package body Calendar_Formatter is
use Ada; -- Make package Ada directly visible
use Calendar; -- Make package Calendar directly visible
package TIO renames Ada.Text_IO; -- Some handy abbreviations
package IIO renames Ada.Integer_Text_IO; -- for dot notation
-- We need some input/output capability for the enumerated types.
package MIO_1 is new Ada.Text_IO.Enumeration_IO(Enum => Month_1);
package MIO_2 is new Ada.Text_IO.Enumeration_IO(Enum => Month_2);
package DIO_1 is new Ada.Text_IO.Enumeration_IO(Enum => Day_1);
package DIO_2 is new Ada.Text_IO.Enumeration_IO(Enum => Day_2);
-- Do a simple function call on Ada.Calendar.Clock;
The_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
Package_Level_Formatted_Time : Formatted_Time;
The_Year : Year_Number := 1963;
The_Day : Day_Number := 1;
The_Month : Month_Number := 1;
Remainder : Integer := 0;
procedure HourMin_Formatter (The_Formatted_Time : in out Formatted_Time;
The_Time : in Calendar.Time
) is
The_Duration : Calendar.Day_Duration := Calendar.Seconds(The_Time);
Hour : Integer := 0;
Hour12 : Integer := 0;
Hour24 : Integer := 0;
Minute : Integer := 0;
Seconds : Integer := 0;
The_Seconds : Integer := Integer(The_Duration);
Remainder : Integer := 0;
AMPM : String (1..2) := "PM";
begin
Hour := The_Seconds / 3600;
Hour24 := Hour;
Remainder := The_Seconds mod 3600;
Minute := Remainder / 60;
Seconds := Remainder mod 60;
if Hour > 12 then
if Hour = 24 then
AMPM := "AM";
Hour12 := 12;
The_Formatted_Time.Noon_Mid := "Midnight";
else
Hour12 := Hour - 12;
AMPM := "PM";
end if;
else
if Hour = 12 then
Hour12 := 12;
AMPM := "PM";
The_Formatted_Time.Noon_Mid := "Noon ";
else
AMPM := "AM";
end if;
end if;
IIO.Put(To => The_Formatted_Time.Hour12, Item => Hour12);
IIO.Put(To => The_Formatted_Time.Hour24, Item => Hour24);
IIO.Put(To => The_Formatted_Time.Minute, Item => Minute);
IIO.Put(To => The_Formatted_Time.Seconds, Item => Seconds);
The_Formatted_Time.AMPM := AMPM;
Package_Level_Formatted_Time := The_Formatted_Time;
-- if Hour24 = 0 then -- or else Minute = 0 or else Seconds = 0 then
-- raise Time_Format_Error;
-- end if;
end HourMin_Formatter;
procedure Day_of_Week_Formatter (The_Formatted_Time : in out
Formatted_Time) is
begin
null;
Package_Level_Formatted_Time := The_Formatted_Time;
end Day_of_Week_Formatter;
procedure Month_Day_Year_Formatter (The_Formatted_Time : in out Formatted_Time;
The_Time : in Calendar.Time) is
Day : Calendar.Day_Number := Calendar.Day(The_Time);
Month : Calendar.Month_Number := Calendar.Month(The_Time);
Year : Calendar.Year_Number := Calendar.Year(The_Time);
Position : Integer := Month - 1;
begin
IIO.Put(To => The_Formatted_Time.Day, Item => Day);
IIO.Put(To => The_Formatted_Time.Month, Item => Month);
IIO.Put(To => The_Formatted_Time.Year, Item => Year);
The_Formatted_Time.Month_Name := Month_1'Val(Position);
end Month_Day_Year_Formatter;
procedure Main_Formatter (F : in out Formatted_Time;
T : in Calendar.Time) is
begin
Month_Day_Year_Formatter(F, T);
HourMin_Formatter(F, T);
Day_Of_Week_Formatter(F);
Package_Level_Formatted_Time := F;
end Main_Formatter;
function Get_Time return Formatted_Time is -- return string of time
The_Formatted_Time : Formatted_Time;
The_Time : Calendar.Time := Calendar.Clock;
begin
Main_Formatter(The_Formatted_Time, The_Time);
return The_Formatted_Time;
end Get_Time;
function Get_Time return Time_Reference is
Time : Formatted_Time := Get_Time;
Result : Time_Reference := new Formatted_Time'(Time);
begin
return Result;
end Get_Time;
function YY (FT : Formatted_Time) return String is -- two character string for year
begin
return FT.Year(3..4);
end YY;
function YYYY (FT : Formatted_Time) return String is -- four character string for year
begin
return FT.Year;
end YYYY;
function DD (FT : Formatted_Time) return String is -- two character string for day
begin
return FT.Day;
end DD;
function MM (FT : Formatted_Time) return String is -- two character string for month
begin
return FT.Month;
end MM;
function Hour12 (FT : Formatted_Time) return String is -- two character string 12 hour clock hour
begin
return FT.Hour12;
end Hour12;
function AMPM (FT : Formatted_Time) return String is -- two character string; AM or PM
begin
return FT.AMPM;
end AMPM;
function Hour24 (FT : Formatted_Time) return String is -- two character string 24 hour clock hour
begin
return FT.Hour24;
end Hour24;
function Minute (FT : Formatted_Time) return String is -- two character string minute
begin
return FT.Minute;
end Minute;
-- ======================
function Month (FT : Formatted_Time) return String is -- Month fully spelled out
Position : Integer := Month_1'Pos(FT.Month_Name);
begin
return Month_1'Image(Month_1'Val(Position));
end Month;
function Month (FT : Formatted_Time) return Month_1 is
begin
return FT.Month_Name;
end Month;
function Month (FT : Formatted_Time) return Month_2 is
Position : Integer := Month_1'Pos(FT.Month_Name);
begin
return Month_2'Val(Position);
end Month;
function Day (FT : Formatted_Time) return Day_1 is
begin
return FT.Day_Name;
end Day;
function Day (FT : Formatted_Time) return Day_2 is
Position : Integer := Day_1'Pos(FT.Day_Name);
begin
return Day_2'Val(Position);
end Day;
function Format_1 (FT : Formatted_Time) return Formatted_Time is
begin
return FT;
end Format_1;
function Format_2 (FT : Formatted_Time) return String is -- formatted MM-DD-YY
Result : String(1..8) := (others => ' ');
begin
Result := (FT.Month & "-" & FT.Day & "-" & FT.Year);
return Result;
end Format_2;
function Format_3 (FT : Formatted_Time)return String is -- formatted MM-DD-YYYY HH:MM:SS
Result : String := (FT.Month & "-" & FT.Day & "-" & FT.Year & " " &
FT.Hour24 & ":" & FT.Minute & ":" & FT.Seconds);
begin
return Result;
end Format_3;
function Format_4 (FT : Formatted_Time) return String is -- formatted Month-Name DD YYYY HH:MM:SS
Result : String := (Month_1'Image(FT.Month_Name)
& " " & FT.Day & ", " & FT.Year & " " &
FT.Hour24 & ":" & FT.Minute & ":" & FT.Seconds);
begin
return Result;
exception
when Constraint_Error =>
return ("Constraint Error in Format_4 function ");
end Format_4;
function Total_Seconds (FT : Formatted_Time) return String is
The_Time : Calendar.Time := Clock;
The_Seconds : Calendar.Day_Duration := Seconds(The_Time);
Converted : Integer := Integer(The_Seconds);
begin
return Calendar.Day_Duration'Image(The_Seconds);
end Total_Seconds;
end Calendar_Formatter;
Contributed by: Richard Riehle
Contributed on: May 17, 1999
License: Public Domain
Back