program calendar;
{*************************************************************************
Program:  CALENDAR
Author:  Richard Conn
Date:  4 Feb 82

Description:
	CALENDAR is used to display a Calendar to the user.  The
Calendar may be that of a particular Month in a particular Year
or that of all Months in a Particular Year.
	The calendar displayed is the Gregorian Calendar.
	The Calendar display may be sent to the user's Console
(by default) or optionally to the user's LST: device or a disk file.

Usage:
		calendar [month] year [/o]
	where
		month may be one of january, february, ..., december
			(optional and only first three letters are req'd)
		year may be any year after byear
		o may be one of the following --
			p - send output to Printer
			d - send output to Disk
			(o is optional and defaults to Console if omitted)

Examples:
		CALENDAR JANUARY 1982 -- Calendar of Month of January of 1982
		CALENDAR JAN 1982 -- Same as Above
		CALENDAR 1982 -- Calendar of all months of 1982
		CALENDAR 1982 /P -- Same as Above but Output to Printer
		CALENDAR 1982 /D -- Same as Above but Output to Disk
		CALENDAR 1982 /P/D -- Same as Above but Output to Disk
			(Disk has priority)
*****************************************************************************}

{***************************************************************************

	'version' is the Version Number of CALENDAR.
	'byear1' is the Base Year of CALENDAR.  This year MUST be a Leap
Year.  Since CALENDAR uses integer arithmetic to do its calculations,
the range of years that may be addressed by CALENDAR is from byear to
byear + 30,000 (approx).
	'bday1' is the Base Day of CALENDAR.  This is the number (1 to 7)
of the First Sunday in January of the Base Year.

****************************************************************************}
const
	version = 13;
	byear1 = 1804;  { Base Year for this program }
	bday1 = 1;      { Base Day for the Base Year }

{***********************************************
	Global Types and Variables
************************************************}
type
	strptr = ^string;
var
	ofile : text;
	filename : string[14];
	month1, year1, dow : integer;
	mposfnd, mpos, ypos : integer;
	mdays : array [1..12] of integer;
	month : array [1..12] of string[10];
	year : string;
	command : strptr;
	cmdline, yline : string;
	lyear : boolean;
	icount : integer;
	match, conout, diskout : boolean;
	byear, bday, bdow : integer;

{****************************************************
	External PASCAL/MT+ System Functions
*****************************************************}
external function @cmd : strptr;

{**************************************************************************
	Function:  day_count
		Computes the number of days since the beginning of the year.
		(Jan 1 = Day 0)
	Input Parameters:
		day: integer in range 1-31
		month: integer in range 1-12
		year: integer
		mdays[i, 1<=i<=12 ]: number of days in month i, i=1=January
			(Global Parameter)
	Output Parameters:
		day_count: Number of days since 1st day of year (0=1st day)
***************************************************************************}
function day_count (day, month, year : integer) : integer;
var
	ndays, i : integer;
begin
	ndays := day - 1;  { Adjust for first day being day 0}
	if month <> 1 then for i:=1 to month-1 do ndays := ndays + mdays[i];
				{ Compute Number of Days since Year Start }
	day_count := ndays;
	lyear := false;  { Assume NOT Leap Year }
	if (year mod 4) <> 0 then exit;  { If not Leap Year, Done }
	if ((year mod 100) = 0) and ((year mod 400) <> 0) then exit;
			{ 2000, 2400, etc are Leap, other centurys not }
	lyear := true;  { Leap Year }
	if month < 3 then exit;  { If in Feb or Jan, Done }
	day_count := ndays + 1;  { Adjust for Leap Year }
end;

{*********************************************************************
	Function:  day_of_week
		Computes day of the week that a given date falls on.
	Input Parameters:
		day : integer in range 1-31
		month : integer in range 1-12
		year : integer
	Output Parameters:
		day_of_week : integer in range 1-7 (bday = Sunday)
**********************************************************************}
function day_of_week (day, month, year : integer) : integer;
var
	ndays, tyear : integer;
begin
	ndays := day_count (day, month, year);  { Compute Number of Days }
	ndays := ndays + 365*(year - byear) + ((year - byear + 3) div 4);
	tyear := (year div 100) * 100;  { Century below given year }
	if ((tyear mod 400) <> 0) and (byear < tyear) and (tyear < year) then
		ndays := ndays - 1;  { Adjust for NO Leap Year century }
	day_of_week := (ndays mod 7) + 1;
end;

{************************************************************************
	Function:  CLINE
		Print syntax of Command Line for Calendar Program.
	Input/Output Parameters:  None
*************************************************************************}
procedure cline;  { Print Syntax of Command Line }
begin
	writeln('	Calendar Command Line should be:');
	writeln('		calendar month year /o');
	writeln('	', byear1, ' <= YEAR <= 30,000 (approx)');
	writeln('	Only first three characters of MONTH are meaningful');
	writeln('	/O may be one of --');
	writeln('		/P to send output to Printer');
	writeln('		/D to send output to Disk File');
	writeln;
	writeln('	Examples:');
	writeln('		CALENDAR JAN 1982');
	writeln('		CALENDAR DECEMBER 2000');
	writeln('		CALENDAR 1982 /D');
	writeln('		CALENDAR 1984 /P');
end;

{*************************************************************************
	Function:  NUMBER
		Converts the input string of digits to an integer.
	Input Parameter:
		value:  string of digits
	Output Parameter:
		number:  value of digit string; evaluation stops at
			first non-digit character
**************************************************************************}
function number (valstr : string) : integer;
var
	idx, numb : integer;
	cont : boolean;
	digit : char;
	idigit : integer;
	val1 : string;
begin
	val1 := valstr; { Temp Variable }
	numb := 0;  { Initialize result }

	{ Test for Empty Input String; if empty, return zero value }
	if length(val1) = 0 then begin
		number := numb;  { Pass out value }
		exit;
	end;

	{ Extract each digit from string and convert into result }
	cont := true;
	idx := 1;
	while cont do begin
		digit := val1[idx];  { Get next digit }
		if (digit < '0') or (digit > '9') then idigit := 10 else
			idigit := ord(digit) - ord('0');  { Convert to bin }
		if idigit = 10 then cont := false;
		if cont then numb := numb * 10 + idigit;  { Update Value }
		idx := idx + 1;  { Increment Char Pointer }
		if length (val1) < idx then cont := false;
	end;
	number := numb;  { Final Value }
end;

{************************************************************************
	Function:  CAL
		Prints one line of the calendar.
	Input Parameters:
		dow: Day of the Week to Start On
		day: Number of Day in Month
		month:  Month of Year
		lyear:  Leap Year (T/F)
	Output Parameter:
		cal:  Number of next Day in Month (0=done)
************************************************************************}
function cal (dow, day, month : integer) : integer;
var
	i : integer;
	monlen, nday, ndays : integer;
begin
	{ If day is zero, print blank entry }
	if day=0 then begin
		for i:=1 to 7 do write(ofile, '   ');
		write(ofile, '  ');
		cal := 0;
		exit;
	end;

	{ Determine number of days in month }
	monlen := mdays[month];
	{ If month is Feb and it is a leap year, then add 1 }
	if (month=2) and lyear then monlen := monlen + 1;

	{ If number < Sunday, set dow to 7+ }
	if dow < bday then dow := dow + 7;

	{ If not Sunday, space over to proper starting column of month cal }
	if dow <> bday then for i:=1 to dow-bday do write(ofile, '   ');

	{ Compute number of days in current line }
	ndays := 7 - (dow-bday);
	{ If we exceed number of days in month, adjust to limit }
	if day+ndays > monlen then ndays := monlen-day+1;

	{ We are in proper position, to print day entries in Calendar line }
	if ndays<>0 then for i:=1 to ndays do begin
		nday := day + i - 1;
		write(ofile, nday:2, ' ');
	end;
	{ Fill out rest of line if end of calendar }
	if (day<>1) and (ndays<>7) then
		for i:=ndays+1 to 7 do write(ofile, '   ');

	{ Write ending spaces }
	write(ofile, '  ');

	{ Set return value to be day of month to start on or zero if done }
	if monlen < (ndays+day) then cal := 0 else cal := day + ndays;

end; { CAL }

{**********************************************************************
	Function:  DOMONTH
		Prints Calendar for Month 'month1' of Year 'year1'.
	Input Parameters:
		month1: month number (1 to 12)
		year1: year number (byear to 30,000)
	Output Parameters:
		- None -
***********************************************************************}
procedure domonth;
var
	day1 : integer;
begin
	{ Determine what day of the week the first day of month falls on }
	day1 := day_of_week (1,month1,year1);  { Day of 1st Day of Month }

	{ Write header for Calendar Month }
	writeln(ofile); writeln(ofile, 'Calendar for ',month[month1],' ',
		year1);
	writeln(ofile, 'Su Mo Tu We Th Fr Sa');

	{ Print first line of Calendar }
	day1 := cal (day1, 1, month1); writeln(ofile);

	{ Print rest of Calendar }
	while day1 <> 0 do begin
		day1 := cal (bday, day1, month1);
		writeln(ofile);
	end;

end; { DOMONTH }

{**************************************************************
	Function:  DOYEAR
		Prints Calendar for Year 'year1'.
	Input Parameters:
		year1: year number
	Output Parameters:
		- None -
**************************************************************}
procedure doyear;
var
	dayx : array [1..3] of integer;
	idx, mbase, group3, group4 : integer;

begin
	{ Write Header for Calendar }
	writeln(ofile, '                       Calendar of Year ', year1);
	writeln(ofile);

	{ Loop over Calendar as 4 rows of three months each }
	for group3 := 1 to 4 do begin
		{ Compute Base Month Number }
		mbase := (group3-1) * 3 + 1;

		{ Page if output to CON: and beginning 3rd group of months }
		if (group3 = 3) and conout then begin
			write('Strike RETURN Key to Continue - ');
			readln; writeln;
		end;

		{ Print Heading of Each Month }
		writeln(ofile);
		for group4 := mbase to mbase+2 do
			write(ofile, 'Calendar for ',month[group4], ' ');
		if ((group3 = 1) or (group3 = 3)) and conout then
			writeln(ofile, year1) else writeln(ofile);
		for group4 := mbase to mbase+2 do begin
	        	write(ofile, 'Su Mo Tu We Th Fr Sa   ');
			idx := group4 mod 3; if idx=0 then idx := 3;
			dayx[idx] := day_of_week(1,group4,year1);
		end;
		writeln(ofile);

		{ Print first line of Calendar }
		dayx[1] := cal (dayx[1], 1, mbase);
		dayx[2] := cal (dayx[2], 1, mbase+1);
		dayx[3] := cal (dayx[3], 1, mbase+2);
		writeln(ofile);

		{ Print rest of Calendar }
		repeat
			dayx[1] := cal (bday, dayx[1], mbase);
			dayx[2] := cal (bday, dayx[2], mbase+1);
			dayx[3] := cal (bday, dayx[3], mbase+2);
			writeln(ofile);
		until dayx[1]+dayx[2]+dayx[3] = 0;
		writeln(ofile);
	end;

end; { DOYEAR }

{*************************************************************************
	Function:  Initialize
		Initialize the command line pointer, the number of days
		in each month, and the names of the months.
	Input/Output Parameters:  None
**************************************************************************}
procedure initialize;
begin
	{ Point to Command Line }
	command := @cmd;
	cmdline := command^;

	{ Number of days in each month }
	mdays[1]  := 31; mdays[2]  := 28; mdays[3]  := 31;
	mdays[4]  := 30; mdays[5]  := 31; mdays[6]  := 30;
	mdays[7]  := 31; mdays[8]  := 31; mdays[9]  := 30;
	mdays[10] := 31; mdays[11] := 30; mdays[12] := 31;

	{ Names of each month }
	month[1]  := 'JANUARY  '; month[2]  := 'FEBRUARY ';
	month[3]  := 'MARCH    '; month[4]  := 'APRIL    ';
	month[5]  := 'MAY      '; month[6]  := 'JUNE     ';
	month[7]  := 'JULY     '; month[8]  := 'AUGUST   ';
	month[9]  := 'SEPTEMBER'; month[10] := 'OCTOBER  ';
	month[11] := 'NOVEMBER '; month[12] := 'DECEMBER ';

end;  { Initialize }

{Mainline}
begin
	{ Initialize Month Data and Command Line Pointer }
	initialize;

	{ Print Banner }
	writeln('Calendar,  Version ',(version div 10),'.',(version mod 10));

	{ Determine Output Direction }
	diskout := false;  { Assume no disk output }
	conout := false;   { Assume no console output }
	if pos ('/D',cmdline) <> 0 then begin
		diskout := true;
		write('Name of Disk Output File? '); readln(filename); end
	else if pos ('/P',cmdline) <> 0 then filename := 'LST:'
		 else begin
			filename := 'CON:'; conout := true; end;

	{ Open Output File or Device }
	assign (ofile, filename);
	rewrite(ofile);
	if ioresult = 255 then begin
		writeln ('Fatal Error: Cannot Open ', filename, ' for Output');
		exit;
	end;
	writeln('Calendar Output File/Device is ',filename);

	{ Determine which month was specified in command line }
	month1 := 0;  { Assume none for all months }
	match := false;  { No match found }
	for icount:=1 to 12 do begin
		mpos := pos (copy (month[icount],1,3), cmdline);
		if mpos <> 0 then begin
			if match then begin
				writeln('Error -- More than one month given');
				exit;
			end;
			match := true;  { We have a match }
			month1 := icount;
			mposfnd := mpos;
		end;
	end;

	{ Extract Year from command line }
	yline := copy (cmdline, mposfnd, length(cmdline)-mposfnd+1);
	ypos := pos (' ', yline);
	year := copy (yline, ypos, length(yline)-ypos+1);
	while (length(year) <> 0) and (year[1] = ' ') do
		year := copy (year, 2, length(year)-1);
	year1 := number(year);  { Convert Year String into Number }

	{ If no year specified, give syntax of command }
	if year1 = 0 then begin
		cline;  { Print syntax of command line }
		exit;
	end;
	{ If year specified is out of range, say so }
	if year1 < byear1 then begin
		write('Invalid Year Specification');
		writeln(' -- Year Specified was ',year1);
		writeln('Year MUST be such that ', byear1, ' <= Year');
		cline;  { Print syntax of command line }
		exit;
	end;

	{ Determine Base Year from byear1 and Base Day from bday1 }
	byear := byear1;   bday := bday1;
	while year1 > byear+44 do begin
		bdow := day_of_week (1,1,byear+44);  { First day of leap year }
		byear := byear + 44;  { Set byear to next 11th leap year }
		if bdow <= bday then bday := bday - bdow + 1
			       else bday := 7 - (bdow - bday) + 1;
					{ bday = 1st Sunday of Leap Year }
	end;

	{ Do Calendar }
	if ?match then doyear else domonth;
	if diskout then close (ofile, icount);

end. {Mainline}