-- 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;
|
