
--::::::::::
--000_read_me.info
--::::::::::
--------------------------------------------------------------------------
--
-- Considerations For Porting date_package Onto Your System:
--
--	1) This Pager file is in correct compilation order and may
--	   be given to a compiler as it stands (see number 2 below).
--	   The software documentation is in comments.
--
--	2) The generic date_package takes two parameters.
--	   The first parameter, short_value, must be at least a 16
--	   bit signed value.  The second parameter, long_value,
--	   must be at least a 32 bit signed value.
--
--	   With our compiler the type short_integer is a 16 bit signed
--	   value and integer is a 32 bit signed value.
--
--	   To run the demo programs you will modify the instantiations
--	   of date_package to use the 16 and 32 bit type names which
--	   are supported by your compiler.
--
--------------------------------------------------------------------------
--
-- Software Development Environment:
--
-- 	Operating System:	VAX/VMS version 4.4
-- 	Compiler:		DEC Ada version 1.3  
--
--	The generic date_package and demo programs have been compiled and
--	run on an IBM PC/AT.  The environment consists of MS/DOS version
--	2.1 and version 1.2 of Alsys Ada.
--
--------------------------------------------------------------------------
--
-- Compilation Order:
--
--	date_package_.ada
--	date_package.ada
--	month_print.ada
--	days_till.ada
--	friday_13th.ada
--	test_ranges.ada
--
--------------------------------------------------------------------------
--
-- File Information:
--
-- File Name		Description
--
-- date_package_.ada	Specification of the generic date_package.
-- date_package.ada	Body of date_package.
-- month_print.ada	Demo to print a month in calendar-like style.
-- days_till.ada	Demo similar to month_print but a lot more fun.
-- friday_13th.ada	Demo to find every Friday the 13th in the year range.
-- test_ranges.ada	Demo to test the error trapping of date arithmetic.
--
--------------------------------------------------------------------------
--::::::::::
--date_package_.ada
--::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : generic package specification date_package
-- Version      : 1.0
-- Authors      : David G. Gawron
--              : Dr. Mars J. Gralia
--              : The Johns Hopkins University
--              : Applied Physics Laboratory
--              : Johns Hopkins Road
--              : Laurel, Maryland  20707
-- DDN Address  : dgg@aplvax gralia@aplvax
-- Copyright    : (c) 1986 David G. Gawron, Dr. Mars J. Gralia
-- Date created :  October  1986
-- Release date :  November 1986
-- Last update  :  Gawron, October 1986
-- Machine/System Compiled/Run on : DEC VAX 11/750, DEC Ada v1.3
--
---------------------------------------------------------------
--
-- Keywords     :  Calendar, Date, Julian Date
--
-- Abstract     :  
--
--  Please refer to the prologue file for a description of the
-- date package.
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION	AUTHOR                  HISTORY
-- 10/86        1.0     Gawron/Gralia           Initial release
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the authors.
--
-- This software is released to the Ada community.
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------



generic
    type short_value is range <>;   -- at least a 16 bit signed value
    type long_value  is range <>;   -- at least a 32 bit signed value



package date_package is



    -- date_type is the main object dealt with by all of
    -- the routines in this package.
    --
    type date_type is private;



    -- These types constrain the values
    -- used to compose dates.
    --
    -- The lower bound of the year range is set at 1753 to
    -- get around a glitch in the calendar that happened in
    -- September 1752.  The internal routines used for date
    -- calculations don't account for this glitch.  The upper
    -- bound of the year range corresponds to the upper bound
    -- of the year number used in CALERDAR.
    --
    subtype year_number_type  is short_value range 1753..2099;
    subtype month_number_type is short_value range 1..12;
    subtype day_number_type   is short_value range 1..31;
    subtype julian_day_type   is short_value range 1..366;



    -- day_delta_type reflects the number of days from
    -- January 1, year_number_type'first to December 31, year_number_type'last.
    -- The range spans the values possible as a result of the 
    -- subtraction operator when applied to two dates.
    --
    subtype day_delta_type is long_value range -126_739..126_739;



    -- day_name_type provides the standard names for the
    -- days of the week.
    --
    type day_name_type is
	(Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);




    -- Description:
    --	current_date returns the current date.
    --  Note: that the range of dates returned is dependent upon
    --  the range of the system date.  The current range is todays
    --  date to December 31, year_number_type'last.
    --
    -- Raises:
    --  nothing
    --
    function current_date
	return date_type;



    -- Description:
    --  year returns the year number of the given date.
    --
    -- Raises:
    --  nothing.
    --
    function year (date : in date_type)
	return year_number_type;



    -- Description:
    --  month returns the month number of the given date.
    --
    -- Raises:
    --  nothing.
    --
    function month (date : in date_type)
	return month_number_type;



    -- Description:
    --  day returns the day number of the given date.
    --
    -- Raises:
    --  nothing.
    --
    function day (date : in date_type)
	return day_number_type;



    -- Description:
    --  day_of_year returns the annual Julian day
    --  number of the given date.
    --
    -- Raises:
    --  nothing.
    --
    function day_of_year (date : in date_type)
	return julian_day_type;



    -- Description:
    --  day_name returns the day name of the given date.
    --
    -- Raises:
    --  nothing.
    --
    function day_name (date : in date_type)
	return day_name_type;



    -- Description:
    --  split breaks apart a date into the year, month, day, and
    --  day name components.
    --
    -- Raises:
    --  nothing.
    --
    procedure split (date     : in date_type;
		     year     : out year_number_type;
		     month    : out month_number_type;
		     day      : out day_number_type;
		     day_name : out day_name_type);


    -- Description:
    --	split break apart a date into the year and
    --	annual Julian day number components.
    --
    -- Raises:
    --  nothing.
    --
    procedure split (date        : in date_type;
		     year        : out year_number_type;
		     julian_day  : out julian_day_type);



    -- Description:
    --  date_of takes a year, month, and day then converts
    --  them into a date.
    --
    -- Raises:
    --  date_is_not_valid when the day given is larger than
    --  the maximum number of days in the given month.
    --	For example, February 30 or September 31.
    --
    function date_of (year  : in year_number_type;
		      month : in month_number_type;
		      day   : in day_number_type)
	return date_type;


    -- Description:
    --  date_of takes a year and annual Julian day number
    --  then converts them into a date.
    --
    -- Raises:
    --  date_is_not_valid when the day number given is
    --  366 for non-leap years.
    --
    function date_of (year        : in year_number_type;
		      julian_day  : in julian_day_type)
	return date_type;



    -- Description:
    --  + adds days to a date.  This is one form of + where
    --  the date is on the left side of the operator.
    --
    -- Raises:
    --  result_out_of_range when the resulting date does
    --	not fall in the year range
    --	year_number_type'first to year_number_type'last.
    --
    function "+" (left  : in date_type;
		  right : in day_delta_type)
	return date_type;


    -- Description:
    --  + adds days to a date.  This another form of + where
    --  the date is on the right side of the operator.
    --
    -- Raises:
    --  result_out_of_range when the resulting date does
    --	not fall in the year range
    --	year_number_type'first to year_number_type'last.
    --
    function "+" (left  : in day_delta_type;
		  right : in date_type)
	return date_type;



    -- Description:
    --  - subtracts days days from a date.  This is one form
    --  of - where the date is on the left side of the operator
    --  and the days are on the right.
    --
    -- Raises:
    --  result_out_of_range when the resulting date does
    --	not fall in the year range
    --	year_number_type'first to year_number_type'last.
    --
    function "-" (left  : in date_type;
		  right : in day_delta_type)
	return date_type;


    -- Description:
    --  - subtracts a date from a date.  This is another form
    --  of - where the result is expreseed in days.
    --
    -- Raises:
    --  nothing.
    --
    function "-" (left  : in date_type;
		  right : in date_type)
	return day_delta_type;



    -- Description:
    --  The following functions provide logical
    --  operations on dates.
    --
    -- Raises:
    --  exceptions are not raised by any of
    --	these routines.

    function "<" (left, right : in date_type)
	return boolean;

    function "<=" (left, right : in date_type)
	return boolean;



    function ">" (left, right : in date_type)
	return boolean;

    function ">=" (left, right : in date_type)
	return boolean;



    -- Raised when the used gives a date that is not valid.
    -- For example, February 30 for any year would cause this
    -- exception to be raised.
    --
    -- Raised by both versions of the date_of function.
    --
    date_is_not_valid	    : exception;


    -- Raised when the result of date arithmetic is not in the
    -- range for dates.  For example, 1/1/1753 minus 2 days
    -- would cause this exception to be raised.
    --
    -- Raised by both versions of "+" and by "-" which handles
    -- date_type and day_delta_type.
    --
    result_out_of_range	    : exception;



    private
	type date_type is
	    record
		year	    : year_number_type;
		month	    : month_number_type;
		day	    : day_number_type;
		day_name    : day_name_type;
		julian_date : long_value;
	    end record;



end date_package;
--::::::::::
--date_package.ada
--::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : package body date_package
-- Version      : 1.0
-- Authors      : David G. Gawron
--              : Dr. Mars J. Gralia
--              : The Johns Hopkins University
--              : Applied Physics Laboratory
--              : Johns Hopkins Road
--              : Laurel, Maryland  20707
-- DDN Address  : dgg@aplvax gralia@aplvax
-- Copyright    : (c) 1986 David G. Gawron, Dr. Mars J. Gralia
-- Date created :  October  1986
-- Release date :  November 1986
-- Last update  :  Gawron, October 1986
-- Machine/System Compiled/Run on : DEC VAX 11/750, DEC Ada v1.3
--
---------------------------------------------------------------
--
-- Keywords     :  Calendar, Date, Julian Date
--
-- Abstract     :  
--
--  Please refer to the prologue file for a description of the
-- date package.
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION	AUTHOR                  HISTORY
-- 10/86        1.0     Gawron/Gralia           Initial release
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the authors.
--
-- This software is released to the Ada community.
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------



with text_io;
with calendar;


package body date_package is





------------ START OF NON EXPORTED TYPES AND VARIABLES ------------


    -- These types will be used to construct tables that will
    -- hold information about the days of the months.
    --
    subtype day_span_type is short_value range 0..334;

    type month_table_type is
	array(month_number_type) of day_span_type;



    -- days_in_month_table holds a count of the number of days
    -- in each month.  The table is set up for a non-leap year.
    -- In a leap year a local copy of the table is modified to
    -- reflect the 29 days in February.
    --
    days_in_month_table : constant month_table_type :=
	(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);


------------ END OF NON EXPORTED TYPES AND VARIABLES  ------------





------------ START OF NON EXPORTED ROUTINES ------------


    -- Description:
    --  leap_year will return true when the given year is
    --  a leap year.
    --
    -- Raises:
    --  nothing.
    --
    function leap_year (year : in year_number_type)
	return boolean is
	begin
	    if ((year mod 4 = 0)    and
	       (year mod 100 /= 0)) or
	       (year mod 400 = 0)
	    then
		return true;
	    else
		return false;
	    end if;
	end leap_year;



    -- Description:
    --  valid_date will return true if the given day is less-than
    --  or equal-to the number of days in the given month.
    --  days_in_month_table will be modified when a leap year
    --  is encountered.
    --
    -- Raises:
    --  nothing.
    --
    function valid_date (year  : in year_number_type;
			 month : in month_number_type;
			 day   : in day_number_type)
	return boolean is

	days_in_month	    : short_value;

	begin
	    days_in_month := days_in_month_table(month);

	    if (leap_year (year) and month = 2) then
		days_in_month := 29;
	    end if;

	    if (day <= days_in_month) then
		return true;
	    else
		return false;
	    end if;
	end valid_date;



    -- Description:
    --  This version of valid_date will return true if the
    --  given julian day number is less-than or equal-to 365
    --  for a non-leap year.  When a lear year is encountered
    --  true is returned automatically since the range constraint
    --  on julian_day_type will prevent the value from being
    --  greater-than 366.
    --
    -- Raises:
    --  nothing.
    --
    function valid_date (year        : in year_number_type;
			 julian_day  : in julian_day_type)
	return boolean is

	begin
	    if (leap_year (year)) then
		return true;
	    elsif (julian_day <= 365) then
		return true;
	    else
		return false;
	    end if;
	end valid_date;



    -- Description:
    --  calculate_date will take an internal julian date and
    --  convert it into a date_type.
    --
    --  The code of this function is a modified version of algorithm
    --  199 from the Collected Algorithms of the ACM.
    --  The author of algorithm 199 is Robert G. Tantzen.
    --
    -- Raises:
    --  nothing.
    --
    function calculate_date (julian_date : in long_value)
	return date_type is

	a	: long_value;
	b	: long_value;
	c	: long_value;
	d	: long_value;
	date	: date_type;

	begin
	    a := julian_date - 1_721_119;
	    b := (4 * a - 1) / 146_097;    
	    a := 4 * a - 1 - 146_097 * b;    
	    d := a / 4;
	    a := (4 * d + 3) / 1_461;
	    d := 4 * d + 3 - 1_461 * a;
	    d := (d + 4) / 4;
	    c := (5 * d - 3) / 153;
	    d := 5 * d - 3 - 153 * c;
	    d := (d + 5) / 5;
	    b := 100 * b + a;

	    if (c < 10) then
		c := c + 3;
	    else
		c := c - 9;
		b := b + 1;
	    end if;

	    date.year        := year_number_type(b);
	    date.month       := month_number_type(c);
	    date.day         := day_number_type(d);
	    date.day_name    := day_name_type'val((julian_date + 1) mod 7);
	    date.julian_date := julian_date;

	    return date;
	end calculate_date;



    -- Description:
    --  calculate_julian will take a year, month, and day and
    --  convert it into an internal julian date.
    --
    --  The code of this function is a modified version of algorithm
    --  199 from the Collected Algorithms of the ACM.
    --  The author of algorithm 199 is Robert G. Tantzen.
    --
    -- Raises:
    --  nothing.
    --
    function calculate_julian (year  : in year_number_type;
			       month : in month_number_type;
			       day   : in day_number_type)
	return long_value is

	internal_year	: long_value;
	internal_month	: long_value;
	internal_day	: long_value;
	julian_date	: long_value;
	c		: long_value;
	ya		: long_value;

	begin
	    internal_year  := long_value(year);
	    internal_month := long_value(month);
	    internal_day   := long_value(day);

	    if (internal_month > 2) then
		internal_month := internal_month - 3;
	    else
		internal_month := internal_month + 9;
		internal_year  := internal_year - 1;
	    end if;

	    c  := internal_year / 100;
	    ya := internal_year - (100 * c);
	    julian_date := (146_097 * c) / 4 +
			   (1_461 * ya) / 4 +
			   (153 * internal_month + 2) / 5 +
			   internal_day + 1_721_119;

	    return julian_date;
	end calculate_julian;


------------ END OF NON EXPORTED ROUTINES ------------





------------ START OF EXPORTED ROUTINES ------------


    function current_date
	return date_type is

	date		: date_type;
	current_time	: calendar.time;

	begin
	    -- The range of the dates the will be returned by
	    -- this function depend upon the CALENDAR package.
	    -- Currently the largest date CALENDAR handles is
	    -- December 31 2099.
	    --
	    current_time := calendar.clock;

	    date.year  := year_number_type(calendar.year (current_time));
	    date.month := month_number_type(calendar.month (current_time));
	    date.day   := day_number_type(calendar.day (current_time));

	    date.julian_date :=
		calculate_julian (date.year, date.month, date.day);

	    date.day_name := day_name_type'val((date.julian_date + 1) mod 7);

	    return date;
	end current_date;



    function year (date : in date_type)
	return year_number_type is
	begin
	    return date.year;
	end year;



    function month (date : in date_type)
	return month_number_type is
	begin
	    return date.month;
	end month;



    function day (date : in date_type)
	return day_number_type is
	begin
	    return date.day;
	end day;



    function day_of_year (date : in date_type)
	return julian_day_type is

	-- day_count_table holds a count, for each month, of the total
	-- number of days in the preceeding months.  For example,
	-- there are 59 days before March in a non-leap year.
	--
	day_count_table : constant month_table_type :=
	    (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);

	days_since_first_of_year    : julian_day_type;

	begin
	    days_since_first_of_year :=
		day_count_table(date.month) + date.day;

	    -- When a date in a leap year is given and the date
	    -- falls after February the count is adjusted to
	    -- account for the extra day in February.
	    --
	    if (leap_year (date.year) and (date.month > 2)) then
		days_since_first_of_year := days_since_first_of_year + 1;
	    end if;

	    return days_since_first_of_year;
	end day_of_year;



    function day_name (date : in date_type)
	return day_name_type is
	begin
	    return date.day_name;
	end day_name;



    procedure split (date     : in date_type;
		     year     : out year_number_type;
		     month    : out month_number_type;
		     day      : out day_number_type;
		     day_name : out day_name_type) is
	begin
	    year     := date.year;
	    month    := date.month;
	    day      := date.day;
	    day_name := date.day_name;
	end split;


    procedure split (date       : in date_type;
		     year       : out year_number_type;
		     julian_day : out julian_day_type) is
	begin
	    year       := date.year;
	    julian_day := day_of_year (date);
	end split;



    function date_of (year  : in year_number_type;
		      month : in month_number_type;
		      day   : in day_number_type)
	return date_type is

	date	: date_type;

	begin
	    if (valid_date (year, month, day)) then
		date.year  := year;
		date.month := month;
		date.day   := day;

		date.julian_date := calculate_julian (year, month, day);

		date.day_name :=
		    day_name_type'val((date.julian_date + 1) mod 7);
		return date;
	    else
		raise date_is_not_valid;
	    end if;
	end date_of;


    function date_of (year       : in year_number_type;
		      julian_day : in julian_day_type)
	return date_type is

	month	    : month_number_type;
	date	    : date_type;

	day_table   : month_table_type;
	days	    : short_value;

	begin
	    if (valid_date (year, julian_day)) then

		day_table := days_in_month_table;

		-- When the given date is in a leap year the table
		-- is adjusted to account for the extra day in February.
		--
		if (leap_year (year)) then
		    day_table(2) := 29;
		end if;

		-- The months are looped through and the annual
		-- julian day number reduced until it falls into
		-- a month.
		--
		days := julian_day;
		for i in month_number_type loop
		    month := i;
		    exit when (days - day_table(i)) <= 0;
		    days := days - day_table(i);
		end loop;

		date.year  := year;
		date.month := month;
		date.day   := day_number_type(days);

		date.julian_date :=
		    calculate_julian (date.year, date.month, date.day);

		date.day_name :=
		    day_name_type'val((date.julian_date + 1) mod 7);
		return date;
	    else
		raise date_is_not_valid;
	    end if;
	end date_of;



    function "+" (left  : in date_type;
		  right : in day_delta_type)
	return date_type is
	begin
	    return calculate_date (left.julian_date + right);

	    -- A constraint error in this case would originate in
	    -- calculate_date and indicate that the range constraint
	    -- on year_number_type was violated by the result of
	    -- left.julian_date + right.
	    --
	    exception
		when constraint_error =>
		    raise result_out_of_range;
	end "+";


    function "+" (left  : in day_delta_type;
		  right : in date_type)
	return date_type is
	begin
	    return calculate_date (right.julian_date + left);

	    -- A constraint error in this case would originate in
	    -- calculate_date and indicate that the range constraint
	    -- on year_number_type was violated by the result of
	    -- right.julian_date + left.
	    --
	    exception
		when constraint_error =>
		    raise result_out_of_range;
	end "+";



    function "-" (left  : in date_type;
		  right : in day_delta_type)
	return date_type is
	begin
	    return calculate_date (left.julian_date - right);

	    -- A constraint error in this case would originate in
	    -- calculate_date and indicate that the range constraint
	    -- on year_number_type was violated by the result of
	    -- left.julian_date - right.
	    --
	    exception
		when constraint_error =>
		    raise result_out_of_range;
	end "-";


    function "-" (left  : in date_type;
		  right : in date_type)
	return day_delta_type is
	begin
	    return left.julian_date - right.julian_date;
	end "-";



    function "<" (left, right : in date_type)
	return boolean is
	begin
	    return (left.julian_date < right.julian_date);
	end "<";


    function "<=" (left, right : in date_type)
	return boolean is
	begin
	    return (left.julian_date <= right.julian_date);
	end "<=";



    function ">" (left, right : in date_type)
	return boolean is
	begin
	    return (left.julian_date > right.julian_date);
	end ">";


    function ">=" (left, right : in date_type)
	return boolean is
	begin
	    return (left.julian_date >= right.julian_date);
	end ">=";


------------ END OF EXPORTED ROUTINES ------------



end date_package;
--::::::::::
--month_print.ada
--::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : procedure month_print
-- Version      : 1.0
-- Authors      : David G. Gawron
--              : The Johns Hopkins University
--              : Applied Physics Laboratory
--              : Johns Hopkins Road
--              : Laurel, Maryland  20707
-- DDN Address  : dgg@aplvax
-- Copyright    : (c) 1986 David G. Gawron
-- Date created :  October  1986
-- Release date :  November 1986
-- Last update  :  Gawron, October  1986
-- Machine/System Compiled/Run on : DEC VAX 11/750, DEC Ada v1.3
--
---------------------------------------------------------------
--
-- Keywords     :  Demonstration of date_package
--
-- Abstract     :  
--
--  This procedure demonstrates the use of several date_package
-- entry points.  The procedure generates a calendar-like listing
-- of a month that includes the annual Julian day number for each
-- day of the month.  Try it for a leap year.
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION	AUTHOR                  HISTORY
-- 10/86        1.0     Gawron                  Initial release
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------



with text_io;
with date_package;



procedure month_print is


    package date is new date_package(short_value => short_integer,
				     long_value  => integer);


    use text_io;
    use date;


    -- The date package doesn't provide the month names
    -- so this type is used.
    --
    type month_name_type is
	(January, February, March, April, May, June,
	 July, August, September, October, November, December);



    -- These will specify the year and month to be printed.
    --
    base_year		    : year_number_type;
    base_month		    : month_number_type;



    -- These dates will be used to print the month
    -- in calerdar form.
    --
    base_date_1		    : date_type;
    base_date_2		    : date_type;



    -- These are used in the layout of the values
    -- printed for a month.
    --
    column_setting_1	    : positive_count;
    column_setting_2	    : positive_count;



    -- This will be used to tell if the user wants to continue
    -- running the demo.
    --
    user_response	    : character;



    -- The I/O for each type we deal with.
    --
    package year_io       is new integer_io(year_number_type);
    package month_io      is new integer_io(month_number_type);
    package day_io        is new integer_io(day_number_type);
    package day_name_io   is new enumeration_io(day_name_type);
    package month_name_io is new enumeration_io(month_name_type);
    package julian_day_io is new integer_io(julian_day_type);



    begin

    loop
	new_line (25);
	put_line ("This demo takes one date as input.");
	put_line ("The date given will specify the year and month");
	put_line ("to be printed in a style similar to a calendar.");
	new_line;
	put_line ("The printout will include the annual Julian day");
	put_line ("number for each day of the month.  The annual Julian");
	put_line ("day is a count of the number of days into a year.");
	put_line ("For example, December 31 has an annual Julian day");
	put_line ("number of 365 in non-leap years and 366 in leap years.");
	new_line (2);

	put ("Valid year numbers are within the range ");
	year_io.put (year_number_type'first);
	put (" to ");
	year_io.put (year_number_type'last);
	new_line;
	put ("and valid month numbers are within the range ");
	month_io.put (month_number_type'first);
	put (" to ");
	month_io.put (month_number_type'last);
	put (".");
	new_line (2);


	put ("Please enter the month to be printed out: ");
	month_io.get(base_month);
	new_line;
	put ("and the year: ");
	year_io.get(base_year);

	-- The dates are set up to be the first
	-- of the given month.
	--
	base_date_1 := date_of (base_year, base_month, 1);
	base_date_2 := base_date_1;


	-- The month name and year are printed at
	-- the top.
	--
	new_line (25);
	text_io.set_col (35);
	month_name_io.put (month_name_type'val(base_month - 1));
	year_io.put (base_year);
	text_io.new_line (2);


	-- The weekday names are printed.
	--
	column_setting_1 := 1;
	for day_name in day_name_type loop
	    set_col (column_setting_1);
	    day_name_io.put (day_name);
	    column_setting_1 := column_setting_1 + 12;
	end loop;
	text_io.new_line (2);


	-- An offset into the week is calculated.  The offset
	-- places the start of the month on the correct day.
	--
	column_setting_1 :=
		(day_name_type'pos(day_name (base_date_1)) * 12) + 1;

	column_setting_2 := column_setting_1;


	loop
	    -- The days of the month are printed.
	    --
	    loop
		exit when (base_month /= month (base_date_1));
		set_col (column_setting_1);
		day_io.put (day (base_date_1));
		exit when (day_name (base_date_1) = Saturday) or
			  ((base_month = 12) and (day (base_date_1) = 31));
		column_setting_1 := column_setting_1 + 12;
		base_date_1 := base_date_1 + 1;
	    end loop;


	    -- And the annual Julian day is printed below the
	    -- day number.
	    --
	    loop
		exit when (base_month /= month (base_date_2));
		set_col (column_setting_2);
		text_io.put ("(");
		julian_day_io.put (item  => day_of_year (base_date_2),
			       	   width => 1);
		text_io.put (")");
		exit when (day_name (base_date_2) = Saturday) or
			  ((base_month = 12) and (day (base_date_2) = 31));
		column_setting_2 := column_setting_2 + 12;
		base_date_2 := base_date_2 + 1;
	    end loop;


	    -- When the month flips over or at the end of the
	    -- year we know the printing is done.
	    --
	    exit when (base_month /= month (base_date_1)) or
		      ((base_month = 12) and (day (base_date_1) = 31));

	    -- Setup for the next week to be printed.
	    --
	    text_io.new_line (2);
	    column_setting_1 := 1;
	    column_setting_2 := 1;
	    base_date_1 := base_date_1 + 1;
	    base_date_2 := base_date_1;
	end loop;


	new_line (2);
	put ("Enter a Q to quit or any other character to continue: ");
	get (user_response);
	exit when (user_response = 'Q');


    end loop;


	exception
	    when data_error =>
		new_line (2);
		put_line ("Input data out of range.  Bye!");

    end month_print;
--::::::::::
--days_till.ada
--::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : procedure days_till
-- Version      : 1.0
-- Authors      : David G. Gawron
--              : The Johns Hopkins University
--              : Applied Physics Laboratory
--              : Johns Hopkins Road
--              : Laurel, Maryland  20707
-- DDN Address  : dgg@aplvax
-- Copyright    : (c) 1986 David G. Gawron
-- Date created :  October  1986
-- Release date :  November 1986
-- Last update  :  Gawron, October  1986
-- Machine/System Compiled/Run on : DEC VAX 11/750, DEC Ada v1.3
--
---------------------------------------------------------------
--
-- Keywords     :  Demonstration of date_package
--
-- Abstract     :  
--
--  This procedure demonstrates the use of several date_package
-- entry points.  The procedure generates a calendar-like listing
-- of a month that includes a countdown by days to some date
-- specified by the user.  Try it for a 'days till Christmas'
-- listing.
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION	AUTHOR                  HISTORY
-- 10/86        1.0     Gawron                  Initial release
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------



with text_io;
with date_package;



procedure days_till is


    package date is new date_package(short_value => short_integer,
				     long_value  => integer);


    use text_io;
    use date;


    -- The date package doesn't provide the month names
    -- so this type is used.
    --
    type month_name_type is
	(January, February, March, April, May, June,
	 July, August, September, October, November, December);



    -- These will specify the fixed date that will be counted
    -- down to.
    --
    target_year		    : year_number_type;
    target_month	    : month_number_type;
    target_day		    : day_number_type;



    -- These will specify the year and month
    -- that will be printed.
    --
    base_year		    : year_number_type;
    base_month		    : month_number_type;



    -- These dates will be used to print the month
    -- in calendar form.
    --
    base_date_1		    : date_type;
    base_date_2		    : date_type;
    fixed_target_date	    : date_type;



    -- days_till is the difference in days between the fixed
    -- date and the day of the month.
    --
    days_till		    : day_delta_type;



    -- These are used in the layout of the values
    -- printed for a month.
    --
    column_setting_1	    : positive_count;
    column_setting_2	    : positive_count;



    -- This will be used to tell if the user wants to continue
    -- running the demo.
    --
    user_response	    : character;



    -- The I/O for each type we deal with.
    --
    package year_io       is new integer_io(year_number_type);
    package month_io      is new integer_io(month_number_type);
    package day_io        is new integer_io(day_number_type);
    package day_name_io   is new enumeration_io(day_name_type);
    package month_name_io is new enumeration_io(month_name_type);
    package till_io       is new integer_io(day_delta_type);



    begin

    loop
	new_line (25);
	put_line ("This demo takes two dates as input.");
	put_line ("The first date given will be a target date of some");
	put_line ("future or past event.");
	put_line ("The second date given will specify the year and month");
	put_line ("to be printed in a style similar to a calendar.");
	new_line;
	put_line ("The printout will include a days-till count down to the");
	put_line ("target date.  For example, if you entered 12 25 1986 for");
	put_line ("the first date and 11 1986 for the second, then a");
	put_line ("print out of November 1986 will be generated and include");
	put_line ("a days-till Christmas count down.");
	new_line (2);

	put ("Valid year numbers are within the range ");
	year_io.put (year_number_type'first);
	put (" to ");
	year_io.put (year_number_type'last);
	put (",");
	new_line;
	put ("valid month numbers are within the range ");
	month_io.put (month_number_type'first);
	put (" to ");
	month_io.put (month_number_type'last);
	put (",");
	new_line;
	put ("and valid day numbers are within the range ");
	day_io.put (day_number_type'first);
	put (" to ");
	day_io.put (day_number_type'last);
	put (".");
	new_line (2);


	put ("Please enter a target month: ");
	month_io.get (target_month);
	new_line;
	put ("Please enter a target day: ");
	day_io.get (target_day);
	new_line;
	put ("Please enter a target year: ");
	year_io.get (target_year);
	new_line (2);

	-- The fixed date stays the same through out
	-- the procedure.
	--
	fixed_target_date := date_of (target_year, target_month, target_day);


	put ("Now enter the month to be printed out: ");
	month_io.get (base_month);
	new_line;
	put ("and the year : ");
	year_io.get (base_year);

	-- The dates are set up to be the first
	-- of the given month.
	--
	base_date_1 := date_of (base_year, base_month, 1);
	base_date_2 := base_date_1;


	-- The month name and year are printed at
	-- the top.
	--
	new_line (25);
	text_io.set_col (35);
	month_name_io.put (month_name_type'val(base_month - 1));
	year_io.put (base_year);
	text_io.new_line (2);


	-- The weekday names are printed.
	--
	column_setting_1 := 1;
	for day_name in day_name_type loop
	    set_col (column_setting_1);
	    day_name_io.put (day_name);
	    column_setting_1 := column_setting_1 + 12;
	end loop;
	text_io.new_line (2);


	-- An offset into the week is calculated.  The offset
	-- places the start of the month on the correct day.
	--
	column_setting_1 :=
	    (day_name_type'pos(day_name (base_date_1)) * 12) + 1;

	column_setting_2 := column_setting_1;


	loop
	    -- The days of the month are printed.
	    --
	    loop
		exit when (base_month /= month (base_date_1));
		set_col (column_setting_1);
		day_io.put (day (base_date_1));
		exit when (day_name (base_date_1) = Saturday) or
			  ((base_month = 12) and (day (base_date_1) = 31));
		column_setting_1 := column_setting_1 + 12;
		base_date_1 := base_date_1 + 1;
	    end loop;


	    -- An the count down is printed below the
	    -- day number.
	    --
	    loop
		exit when (base_month /= month (base_date_2));
		set_col (column_setting_2);
		days_till := fixed_target_date - base_date_2;
		text_io.put ("(");
		till_io.put (item  => days_till,
			     width => 1);
		text_io.put (")");
		exit when (day_name (base_date_2) = Saturday) or
			  ((base_month = 12) and (day (base_date_2) = 31));
		column_setting_2 := column_setting_2 + 12;
		base_date_2 := base_date_2 + 1;
	    end loop;


	    -- When the month flips over or at the end of the
	    -- year we know the printing is done.
	    --
	    exit when (base_month /= month (base_date_1)) or
		      ((base_month = 12) and (day (base_date_1) = 31));


	    -- Setup for the next week to be printed.
	    --
	    text_io.new_line (2);
	    column_setting_1 := 1;
	    column_setting_2 := 1;
	    base_date_1 := base_date_1 + 1;
	    base_date_2 := base_date_1;
	end loop;


	new_line (2);
	put ("Enter a Q to quit or any other character to continue: ");
	get (user_response);
	exit when (user_response = 'Q');


    end loop;


	exception
	    when date_is_not_valid =>
		new_line (2);
		month_name_io.put (month_name_type'val(target_month - 1));
		put (" doesn't have that many days");
		if ((target_month = 2) and (target_day = 29)) then
		    put (" in ");
		    year_io.put (target_year);
		end if;
		put_line (".");

	    when data_error =>
		new_line (2);
		put_line ("Input data out of range.  Bye!");


    end days_till;
--::::::::::
--friday_13th.ada
--::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : procedure days_till
-- Version      : 1.0
-- Authors      : David G. Gawron
--              : The Johns Hopkins University
--              : Applied Physics Laboratory
--              : Johns Hopkins Road
--              : Laurel, Maryland  20707
-- DDN Address  : dgg@aplvax
-- Copyright    : (c) 1986 David G. Gawron
-- Date created :  October  1986
-- Release date :  November 1986
-- Last update  :  Gawron, October  1986
-- Machine/System Compiled/Run on : DEC VAX 11/750, DEC Ada v1.3
--
---------------------------------------------------------------
--
-- Keywords     :  Demonstration of date_package
--
-- Abstract     :  
--
--  This procedure demonstrates the use of several date_package
-- entry points.  The procedure generates a listing which contains
-- every Friday the 13th in the year range defined by the date
-- package.  In the end, each month is printed showing the number
-- of Friday the 13th's found for that month.
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION	AUTHOR                  HISTORY
-- 10/86        1.0     Gawron                  Initial release
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------



with text_io;
with date_package;



procedure friday_13th is


    package date is new date_package(short_value => short_integer,
				     long_value  => integer);


    use text_io;
    use date;


    -- The date package doesn't provide the month names
    -- so this type is used.
    --
    type month_name_type is
	(January, February, March, April, May, June,
	 July, August, September, October, November, December);



    -- These will keep track of stats for the number of times
    -- Friday the 13th shows up in a month.
    --
    type month_stats_type is
	array (month_name_type) of natural;

    month_stats		    : month_stats_type;
    month_name		    : month_name_type;
    total		    : natural := 0;





    -- These will specify a possible date for Friday the 13th.
    --
    target_year		    : year_number_type;
    target_month	    : month_number_type;



    -- This will be used to find all Friday 13th.
    -- dates.
    --
    base_date		    : date_type;



    -- The I/O for each type we deal with.
    --
    package year_io       is new integer_io(year_number_type);
    package month_name_io is new enumeration_io(month_name_type);
    package stats_io      is new integer_io(natural);



    begin

	new_line (25);
	put_line ("This demo finds all Friday the 13th's from");
	year_io.put (year_number_type'first);
	put (" to ");
	year_io.put (year_number_type'last);
	put (".");
	new_line (2);


	for i in month_name_type loop
	    month_stats(i) := 0;
	end loop;


	for base_year in year_number_type loop
	    for base_month in month_number_type loop
		base_date := date_of (base_year, base_month, 13);
		if (day_name (base_date) = Friday) then
		    month_name := month_name_type'val(base_month - 1);
		    month_stats(month_name) := month_stats(month_name) + 1;

		    month_name_io.put (month_name);
		    set_col (12);
		    year_io.put (base_year);
		    new_line;
		end if;
	    end loop;
	end loop;


	for i in month_name_type loop
	    total := total + month_stats(i);
	end loop;

	new_line;
	put_line ("These are the statistics for Friday the 13th");
	put_line ("density per month.");
	new_line;
	put ("There were ");
	stats_io.put (item => total, width => 1);
	put_line (" Friday the 13th's.");
	new_line;


	for i in month_name_type loop
	    month_name_io.put (i);
	    set_col (12);
	    stats_io.put (item => month_stats(i), width => 1);
	    new_line;
	end loop;


    end friday_13th;
--::::::::::
--test_ranges.ada
--::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : procedure test_ranges
-- Version      : 1.0
-- Authors      : David G. Gawron
--              : The Johns Hopkins University
--              : Applied Physics Laboratory
--              : Johns Hopkins Road
--              : Laurel, Maryland  20707
-- DDN Address  : dgg@aplvax
-- Copyright    : (c) 1986 David G. Gawron
-- Date created :  October  1986
-- Release date :  November 1986
-- Last update  :  Gawron, October  1986
-- Machine/System Compiled/Run on : DEC VAX 11/750, DEC Ada v1.3
--
---------------------------------------------------------------
--
-- Keywords     :  Demonstration of date_package
--
-- Abstract     :  
--
--  This procedure demonstrates error trapping when using date
-- arithmetic.
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION	AUTHOR                  HISTORY
-- 10/86        1.0     Gawron                  Initial release
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------



with text_io;
with date_package;



procedure test_ranges is


    package date is new date_package(short_value => short_integer,
				     long_value  => integer);


    use text_io;
    use date;


    -- This will be used as a base to force range constraint errors
    -- when doing date arithmetic.
    --
    first_date		    : date_type;
    todays_date		    : date_type;
    last_date		    : date_type;
    test_date		    : date_type;



    begin

	new_line (25);
	put_line ("This demo forces range constraint errors to see");
	put_line ("how well the date package handles date arithmetic.");
	new_line;
	put_line ("The tests should all produce messages with");
	put_line ("a banner indicating the test number.  Any");
	put_line ("number skiped will indicate that something is");
	put_line ("wrong in the date package.");
	new_line;
	put_line ("These cases will be tested:");
	put_line ("   1) Subtract one day from the first valid date.");
	put_line ("   2) Add one day to the last valid date.");
	put_line ("   3) Subtract full range of days from the current date.");
	put_line ("   4) Add full range of days to the current date.");
	new_line (3);


	first_date  := date_of (year_number_type'first, 1, 1);
	todays_date := current_date;
	last_date   := date_of (year_number_type'last, 12, 31);


	begin
	    test_date := first_date - 1;
	    exception
		when result_out_of_range =>
		    put_line ("------- Test 1 OK -------");
	end;

		
	begin
	    test_date := last_date + 1;
	    exception
		when result_out_of_range =>
		    put_line ("------- Test 2 OK -------");
	end;

		
	begin
	    test_date := todays_date - day_delta_type'last;
	    exception
		when result_out_of_range =>
		    put_line ("------- Test 3 OK -------");
	end;

		
	begin
	    test_date := todays_date + day_delta_type'last;
	    exception
		when result_out_of_range =>
		    put_line ("------- Test 4 OK -------");
	end;
		
    end test_ranges;
