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;