WITH Ada.Calendar;
PACKAGE BODY Dates IS
------------------------------------------------------------------
--|
--| body for package to represent calendar dates
--|
--| Author: Michael B. Feldman, The George Washington University
--| Last Modified: September 1995
--|
------------------------------------------------------------------
-- body for package to represent calendar dates
-- tables containing the Julian day of the last day of each month
NonLeapDayEndOfMonth: ARRAY(MonthNumber) OF JulianDay :=
-- Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
(31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365);
LeapDayEndOfMonth: ARRAY(MonthNumber) OF JulianDay :=
-- Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
(31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366);
FUNCTION IsLeap(Year: YearNumber) RETURN Boolean IS
-- Pre: Year is defined
-- Post: returns True if and only if Year is a leap year
BEGIN
RETURN (Year REM 4 = 0) AND
((Year REM 100 /= 0) OR (Year REM 400 = 0));
END IsLeap;
FUNCTION MakeDate(Year : YearNumber;
Month : MonthNumber;
Day : DayNumber) RETURN Date IS
TempTime: Ada.Calendar.Time;
Result: Date;
BEGIN -- MakeDate
TempTime := Ada.Calendar.Time_Of(Year=>Year, Month=>Month, Day=>Day);
-- assert: date is valid if and only if Time_Error is not raised
Result.Year := Year;
-- If it's January, finding the day is easy. If not,
-- look up days to end of previous month in table
IF Month = MonthNumber'First THEN -- it's January
Result.DayOfYear := Day;
ELSIF IsLeap(Year) THEN -- leap year
Result.DayOfYear := LeapDayEndOfMonth(Month-1) + Day;
ELSE -- not leap year
Result.DayOfYear := NonLeapDayEndOfMonth(Month-1) + Day;
END IF;
RETURN Result;
EXCEPTION
WHEN Ada.Calendar.Time_Error =>
RAISE Date_Error;
END MakeDate;
FUNCTION Today RETURN Date IS
-- Finds today's date and returns it as a record of type Date
-- Today's date is gotten from PACKAGE Ada.Calendar
RightNow : Ada.Calendar.Time; -- holds internal clock value
BEGIN -- Today
-- Get the current time value from the computer's clock
RightNow := Ada.Calendar.Clock;
-- Extract the current month, day, and year from the time value
-- and call date constructor to put it in our form
RETURN MakeDate(Month => Ada.Calendar.Month(RightNow),
Day => Ada.Calendar.Day (RightNow),
Year => Ada.Calendar.Year (RightNow));
END Today;
FUNCTION Year (Right: Date) RETURN YearNumber IS
BEGIN
RETURN Right.Year;
END Year;
FUNCTION DayOfYear (Right: Date) RETURN JulianDay IS
BEGIN
RETURN Right.DayOfYear;
END DayOfYear;
FUNCTION Month (Right: Date) RETURN MonthNumber IS
DayOfYear: JulianDay;
Result : MonthNumber;
BEGIN -- Month
DayOfYear := Right.DayOfYear;
-- search table until a quantity > Right.Day is found
IF IsLeap(Right.Year) THEN -- leap year
FOR WhichMonth IN MonthNumber LOOP
Result := WhichMonth;
EXIT WHEN LeapDayEndOfMonth(WhichMonth) >= DayOfYear;
END LOOP;
ELSE -- not leap year
FOR WhichMonth IN MonthNumber LOOP
Result := WhichMonth;
EXIT WHEN NonLeapDayEndOfMonth(WhichMonth) >= DayOfYear;
END LOOP;
END IF;
RETURN Result;
END Month;
FUNCTION DayOfMonth (Right: Date) RETURN DayNumber IS
WhichMonth: MonthNumber;
Result : DayNumber;
BEGIN -- DayOfMonth
WhichMonth := Month(Right); -- call routine above
IF WhichMonth = MonthNumber'First THEN -- it's January
Result := Right.DayOfYear;
ELSIF IsLeap(Right.Year) THEN -- leap year
Result := Right.DayOfYear - LeapDayEndOfMonth(WhichMonth - 1);
ELSE
Result := Right.DayOfYear - NonLeapDayEndOfMonth(WhichMonth - 1);
END IF;
RETURN Result;
END DayOfMonth;
FUNCTION DayOfWeek (Right: Date) RETURN WeekDay IS
SUBTYPE Code IS Natural RANGE 0..6;
Result : WeekDay;
MonthCode : Code;
Century : Code;
ThisMonth : MonthNumber;
ThisYear : YearNumber;
BEGIN -- DayOfWeek
ThisMonth := Month(Right);
ThisYear := Year(Right);
CASE ThisMonth IS
WHEN 1 => IF IsLeap(ThisYear) THEN
MonthCode := 5;
ELSE
MonthCode := 6;
END IF;
WHEN 2 => IF IsLeap(ThisYear) THEN
MonthCode := 1;
ELSE
MonthCode := 2;
END IF;
WHEN 3 => MonthCode := 2;
WHEN 4 => MonthCode := 5;
WHEN 5 => MonthCode := 0;
WHEN 6 => MonthCode := 3;
WHEN 7 => MonthCode := 5;
WHEN 8 => MonthCode := 1;
WHEN 9 => MonthCode := 4;
WHEN 10 => MonthCode := 6;
WHEN 11 => MonthCode := 2;
WHEN 12 => MonthCode := 4;
END CASE;
IF ThisYear/100 = 19 THEN
Century := 0;
ELSE
Century := 6;
END IF;
Result := (((ThisYear REM 100) + ((ThisYear REM 100) / 4)
+ DayOfMonth(Right) + MonthCode + Century)
REM 7) + 1;
RETURN Result;
END DayOfWeek;
-- comparison operators
FUNCTION "<" (Left, Right: Date) RETURN Boolean IS
BEGIN
IF Left.Year = Right.Year THEN
RETURN Left.DayOfYear < Right.DayOfYear;
ELSE
RETURN Left.Year < Right.Year;
END IF;
END "<";
FUNCTION "<=" (Left, Right: Date) RETURN Boolean IS
BEGIN
IF Left.Year = Right.Year THEN
RETURN Left.DayOfYear <= Right.DayOfYear;
ELSE
RETURN Left.Year < Right.Year;
END IF;
END "<=";
FUNCTION ">" (Left, Right: Date) RETURN Boolean IS
BEGIN
IF Left.Year = Right.Year THEN
RETURN Left.DayOfYear > Right.DayOfYear;
ELSE
RETURN Left.Year > Right.Year;
END IF;
END ">";
FUNCTION ">=" (Left, Right: Date) RETURN Boolean IS
BEGIN
IF Left.Year = Right.Year THEN
RETURN Left.DayOfYear >= Right.DayOfYear;
ELSE
RETURN Left.Year > Right.Year;
END IF;
END ">=";
-- arithmetic operators
FUNCTION "+" (Left: Date; Right: JulianDay) RETURN Date IS
Result : Date;
Temp : Positive;
YearMax: JulianDay;
BEGIN
IF IsLeap(Left.Year) THEN -- leap year
YearMax := 366;
ELSE
YearMax := 365;
END IF;
IF (Right = 366) AND THEN -- special case, adding
(NOT IsLeap(Left.Year + 1)) AND THEN -- 366 to Dec 31 when
Left.DayOfYear = YearMax THEN -- next year not leap
Result := (Left.Year + 2, DayOfYear => 1);
ELSE -- normal case
Temp := Left.DayOfYear + Right;
IF Temp > YearMax THEN -- into next year
Result := (Year => Left.Year + 1, DayOfYear => Temp - YearMax);
ELSE
Result := (Year => Left.Year, DayOfYear => Temp);
END IF;
END IF;
RETURN Result;
EXCEPTION
WHEN Constraint_Error => -- next year out of range
RAISE Date_Error;
END "+";
FUNCTION "+" (Left: JulianDay; Right: Date) RETURN Date IS
BEGIN
RETURN Right + Left; -- use the other "+" above
END "+";
FUNCTION "-" (Left: Date; Right: JulianDay) RETURN Date IS
Difference: Integer; -- to hold difference between day fields
Result: Date;
BEGIN
IF (Right = 366) AND THEN -- special case, subtracting
(NOT IsLeap(Left.Year - 1)) AND THEN -- 366 from Jan 1 when
Left.DayOfYear = 1 THEN -- previous year not leap
Result := MakeDate(Year => Left.Year - 2, Month => 12, Day => 31);
ELSE
Difference := Left.DayOfYear - Right;
IF Difference > 0 THEN -- result is in the same year
Result := (Year => Left.Year, DayOfYear => Difference);
ELSE -- result is in previous year
IF IsLeap(Left.Year - 1) THEN
Result := (Year => Left.Year-1, DayOfYear => 366+Difference);
ELSE
Result := (Year => Left.Year-1, DayOfYear => 365+Difference);
END IF;
END IF;
END IF;
RETURN Result;
EXCEPTION
WHEN Constraint_Error => -- previous year out of range
RAISE Date_Error;
END "-";
END Dates;