-- Date program for the first Semester, "Professional version"
-- Debora Weber-Wulff 8.1.94
-- datum.adb

with Ada.Text_IO; use Ada.Text_IO;
PACKAGE BODY datum_paket IS
   PACKAGE iio IS NEW Ada.Text_IO.Integer_IO (integer);

   -- Fancy weekday names
   name_size : constant integer := 12;
   weekday_names
      : CONSTANT ARRAY (languages, weekday) OF string (1..name_size)
      := (English =>
	  ("Sunday      ", "Monday      ", "Tuesday     ", "Wednesday   ",
	   "Thursday    ", "Friday      ", "Saturday    "),
	  German =>
	  ("Sonntag     ", "Montag      ", "Dienstag    ", "Mittwoch    ",
	   "Donnerstag  ", "Freitag     ", "Samstag     "),
	  Icelandic =>
	  ("sunnudagur  ", "manudagur   ", "pridjudagur ", "midvikudagur",
	   "fimmtudagur ", "fostudagur  ", "laugardagur "));

   -- We will use day numbers from the day of the introduction of the
   -- Gregorian calendar. This means that October 15, 1583 = 1 and 
   -- December 31, 2500 = 335_300.

   first_day     : CONSTANT datum := (15, 10, 1582);
   first_weekday : CONSTANT weekday := Friday;

   SUBTYPE daysinyears IS long_integer 
		   RANGE 1 .. long_integer(years'LAST) * 365;
   daynr_max   : CONSTANT daysinyears := long_integer(years'FIRST) * 365;
   daynr_leaps : CONSTANT daysinyears := long_integer(years'FIRST) / 4;
   SUBTYPE daynr IS long_integer RANGE 0 .. daynr_max + daynr_leaps;

   -- Our calculations are based on a year from 1.1.1592
   -- The phantom_days are the fictious days from that day until 14.10.1592.
   phantom_days  : CONSTANT daynr := 287;

   -- We note the number of days in the year up until the month
   full_month : ARRAY (Boolean, months) of DAYNR
	      := (false => (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
		      true  => (0, 31, 60, 91, 121, 152, 182, 213, 244, 275, 305, 335));
----------------------------------------------------------------------------
FUNCTION leap_year (y : years) RETURN Boolean IS
-- Is year y a leap year?  1584 was the first one
BEGIN
   RETURN    ((y MOD 4 = 0) AND NOT (y MOD 100 = 0))
	  OR (y MOD 400 = 0);
END leap_year;
----------------------------------------------------------------------------
FUNCTION leap_years_since_1582 (yb : natural) RETURN natural IS
-- first leap year was 1584
BEGIN
   RETURN  (yb + 2)  / 4 -      -- every fourth year
	   (yb + 18) / 100 +    -- except every hundred
	   (yb + 18) / 400;     -- including every 400th
END leap_years_since_1582;
----------------------------------------------------------------------------
FUNCTION datum_to_daynr (dat : datum) RETURN daynr IS
-- Convert datum to days since 15.10.1582
   years_between : integer := integer(dat.year - years'FIRST);
   leap_years    : natural := leap_years_since_1582 (years_between);
   months_days   : daynr   := 0;
   ly            : Boolean := leap_year (dat.year);
BEGIN
   RETURN   daynr(years_between) * daynr(365)  -- each year
	  + daynr(leap_years)                  -- the leap years
	  + full_month(ly, dat.month)          -- the full months
	  + daynr(dat.day)                     -- the days
	  - phantom_days;                      -- forget the phantoms
END datum_to_daynr;
----------------------------------------------------------------------------
FUNCTION daynr_to_datum (d : daynr) RETURN datum IS
-- Convert a daynr back to a nice datum
   years_between : natural := natural((d + phantom_days) / 365);
   year          : years   := years'FIRST + years_between;
   ly            : Boolean := leap_year (year);
   -- The days in the current year
   months_days   : daynr :=   (d + phantom_days)
			    - daynr(years_between) * daynr(365)
			    - daynr(leap_years_since_1582(years_between));
BEGIN
   -- Are months_days in Jan .. Nov?
   FOR i IN months RANGE 1..11 LOOP
       IF months_days < full_month (ly, i+1) THEN
	  RETURN (days(months_days - full_month (ly, i)), i, year);
       END IF;
   END LOOP;
   -- Must be December
   RETURN (days(months_days - full_month (ly, 12)), 12, year);
END daynr_to_datum;
----------------------------------------------------------------------------
FUNCTION  set_day (d, m, y : integer) RETURN datum IS
-- This function returns a datum if d, m and y are plausible,
-- otherwise it raises datum_error
 ly         : Boolean := leap_year (y);
 month_days : days;
BEGIN
  IF m > 1 THEN
     month_days := days(full_month (ly, m) - full_month (ly, m - 1));
  ELSE
     month_days := days(full_month (ly, 1));
  END IF;
  IF d > month_days THEN RAISE datum_error; END IF;
  RETURN (d, m, y);
END set_day;
----------------------------------------------------------------------------
PROCEDURE get (d : OUT datum) IS
-- Read a datum as <day> sep <month> sep <year>
 sep : character;
BEGIN
 IF language = English THEN
    iio.get (d.month);
    get (sep); -- and forget it
    iio.get (d.day);
 ELSE
    iio.get (d.day);
    get (sep); -- and forget it
    iio.get (d.month);
 END IF;
 get (sep);
 iio.get (d.year);
 skip_line;
END get;

PROCEDURE put (d : IN datum) IS
-- Write the date with a separator
  sep : CONSTANT ARRAY (languages) OF character := ('/','.','.');
BEGIN
 IF language = English THEN
    iio.put (d.month, 0); put (sep(language));
    iio.put (d.day, 0);   put (sep(language));
 ELSE
    iio.put (d.day, 0);   put (sep(language));
    iio.put (d.month, 0); put (sep(language));
 END IF;
 iio.put (d.year,4);
END put;
--------------------------------------------------------------------------
FUNCTION  weekday_of (d : datum) RETURN weekday IS
-- Find the day of the week by calculating the day number - 1
-- modulo 7, adding the position for the weekday of daynr 1
-- and again modulo 7 to find the position in weekday.
BEGIN
   RETURN weekday'VAL ((integer(datum_to_daynr (d) - 1) MOD 7
			 + weekday'POS(first_weekday))
		       MOD 7);
END weekday_of;

PROCEDURE get (w : OUT weekday) IS
  name : string (1..name_size) := (others => ' ');
  size : natural;
BEGIN
  get_line (name, size);
  FOR i IN weekday LOOP
      IF weekday_names (language, i)(1..size) = name(1..size) THEN
	 w := i;
	 RETURN;
      END IF;
  END LOOP;
  -- Nothing found, error!
  RAISE datum_error;
END get;

PROCEDURE put (w : IN weekday) IS

BEGIN
   -- Only write out non-blank characters
   FOR i IN 1 .. name_size LOOP
       IF weekday_names (language, w)(i) /= ' ' THEN
	  put (weekday_names (language, w)(i));
       END IF;
   END LOOP;
END put;
----------------------------------------------------------------------------
-- These functions all convert to a daynr, perform the operations there,
-- and convert back.

FUNCTION next_day (d : datum) RETURN datum IS
BEGIN
  RETURN daynr_to_datum(datum_to_daynr(d)+1);
END next_day;

FUNCTION "+" (d : datum; days : integer) RETURN datum IS
BEGIN
  RETURN daynr_to_datum(datum_to_daynr(d) + daynr(days));
END "+";

FUNCTION "-" (d : datum; days : integer) RETURN datum IS
BEGIN
  RETURN daynr_to_datum(datum_to_daynr(d) - daynr(days));
END"-";

FUNCTION  "-"  (day1, day2 : datum) RETURN integer IS
-- Number of days between the two dates, CONSTRAINT_ERROR may be raised
BEGIN
  RETURN integer (datum_to_daynr (day1) - datum_to_daynr (day2));
END "-";

FUNCTION "<"   (day1, day2 : datum) RETURN Boolean IS
BEGIN
  RETURN datum_to_daynr (day1) < datum_to_daynr (day2);
END "<";

FUNCTION "<="  (day1, day2 : datum) RETURN Boolean IS
BEGIN
  RETURN datum_to_daynr (day1) <= datum_to_daynr (day2);
END "<=";

FUNCTION ">"   (day1, day2 : datum) RETURN Boolean IS
BEGIN
  RETURN datum_to_daynr (day1) > datum_to_daynr (day2);
END ">";

FUNCTION ">="  (day1, day2 : datum) RETURN Boolean IS
BEGIN
  RETURN datum_to_daynr (day1) >= datum_to_daynr (day2);
END ">=";
----------------------------------------------------------------------------
END datum_paket;