A perpetual calendar package

-- package spec

-- Perpetual Calendar package (spec)
-- Christophe GOUIRAN (christophe@e-motive.com)
-- Any corrections/suggestions are welcome

package Perpetual_Calendar is

   -- General type declarations

   type year is range 1582 .. 10_000;
   
   type months_name is (January, Febrary, March, April, May, June, Jully,
August, September, October, November, December);
      
   type months_number is range 1 .. 12;
   
   type days_name is (Sunday, Monday, Thuesday, Friday, Thursday,
Wednesday, Saturday);
      
   type days_number is range 1 .. 7;
   
   type days_month_number is range 1 .. 31;
   
   -- Complex types
   
   type days_info is
   record
      name : days_name;
      number : days_number;
   end record;   
   
   type Complete_Month is array(days_month_number range <>) of
days_info;
   
   -- General functions
   
   function Is_Leap_Year(y : year) return Boolean;
   
   -- These two functions will return an array of days_info record type.
      
   function Get_Month(m : months_name ; y : year) return Complete_Month;

   function Get_Month(m : months_number ; y : year) return Complete_Month; 
   
end Perpetual_Calendar;

-- package body

-- Perpetual Calendar package (body)
-- Christophe GOUIRAN (christophe@e-motive.com)
-- Any corrections/suggestions are welcome

package body Perpetual_Calendar is

   Days_In_Month : array(months_number range <>) of days_month_number
:= (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

   -- Internal functions
   

----------------------------------------------------------------------------------
   
   -- Calculate number of leap years since 1582
   function Calc_Leap_Years( y : year ) return Natural is
      
      leapYears : Natural;
      hundreds : Natural;
      fourHundreds : Natural;
   
   begin
      
      leapYears := (Natural(y) - 1581) / 4;
      
      hundreds := (Natural(y) - 1501) / 100;
      leapYears := leapYears - hundreds;
      
      fourHundreds := (Natural(y) - 1201) / 400;
      
      return leapYears + fourHundreds;
   
   end Calc_Leap_Years;
   

----------------------------------------------------------------------------------
   
   -- Calculate day of the week on wich January 1st falls for given year
   function Calc_January_First( y : year ) return Natural is
   begin
      return (5 + (Natural(y) - 1582) + Calc_Leap_Years(y)) mod 7;
   end Calc_January_First;   
   

----------------------------------------------------------------------------------
   
   -- Calculates day of the week the first day of the month falls on
   function Calc_First_Of_Month( y : year ; m : months_number ) return
days_number is

      result : Positive;

   begin
      
      -- Get day of week for January 1st of the given year
      result := Positive(Calc_January_First(y));
      
      -- Increase result by days in year before given month to get first
day
      for i in 1 .. m - 1
      loop
         result := result + Positive(Days_In_Month(i));
      end loop;   

      -- Increase by one if month after February and leap year
      if (m > 2) and (Is_Leap_Year(y))
      then
         result := result + 1;
      end if;
      
      return days_number(result mod 7);
      
   end Calc_First_Of_Month;


----------------------------------------------------------------------------------
   
   function Is_Leap_Year(y : year) return Boolean is
   begin
      if y mod 100 = 0
      then
         return y mod 400 = 0;
      else
         return y mod 4 = 0;
      end if;
   end Is_Leap_Year;


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

   function Get_Month(m : months_number ; y : year) return Complete_Month
is
   
      Num_Days : days_month_number := Days_In_Month(m);
      First_Day : days_number := Calc_First_Of_Month(y, m);
   
   begin
   
      if Is_Leap_Year(y) and then m = 2
      then
         Num_Days := 29;
      end if;   
   
      declare
         result : Complete_Month(1 .. Num_Days);
         days_counter : days_number := First_Day;
      begin
         for month_counter in 1 .. Num_Days
         loop
            if days_counter = 7
            then
               result(month_counter).name := days_name'val(0);
               result(month_counter).number := 1;
               days_counter := 1;
            else
               result(month_counter).name := days_name'val(days_counter);
               result(month_counter).number := days_counter + 1;
               days_counter := days_counter + 1;
            end if;   
         end loop;   
            
         return result;
      end;   
   
   end Get_Month;


----------------------------------------------------------------------------------
   
   function Get_Month(m : months_name ; y : year) return Complete_Month is
   begin
      return Get_Month(months_name'pos(m), y);
   end Get_Month;   


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

end Perpetual_Calendar;

-- example program

-- Perpetual Calendar package (example test)
-- Christophe GOUIRAN (christophe@e-motive.com)
-- Any corrections/suggestions are welcome

with Ada.Command_Line; use Ada.Command_Line;
with Perpetual_Calendar; use Perpetual_Calendar;
with Text_IO; use Text_IO;

procedure example is

   mm : months_number;
   yy : year;
   
begin

   if Argument_Count /= 2
   then
      put_line("Syntax : " & Command_Name & " month_number
year_number(4 digits, between 1582 and 10000).");
   else
      loop
         begin
            mm := months_number'value(Argument(1));
         
            exception when CONSTRAINT_ERROR => put_line("You have made a
mistake on the month."); exit;
         end;
         
         begin
            yy := year'value(Argument(2));
            
            exception when CONSTRAINT_ERROR => put_line("You have made a
mistake on the year."); exit;
         end;   
   
         declare
            mo : Complete_Month := Get_Month(mm, yy);
         begin
            for i in mo'range
            loop
               put(days_name'image(mo(i).name));
               put(days_month_number'image(i) & " ");
               put(months_name'image(months_name'val(mm - 1)));
               put_line(year'image(yy));
            end loop;
            null;
         end;

         exit;
      end loop;
   end if;   

end example;