Category : A Collection of Games for DOS and Windows
Archive   : SUPCHIP.ZIP
Filename : BIRTHDAY.PAS

{****************************************************************************}
{************* BIRTHDAY.PAS *************}
{************* Source code : Jeff Whippo *************}
{************* Plattsburgh, NY 518-561-9403 *************}
{************* January 27, 1991 *************}
{************* Written and Compiled with *************}
{************* Borland's new TURBO PASCAL 6.0 *************}
{****************************************************************************}

PROGRAM HowManyDaysOld;

USES
Crt, Dos;

TYPE
Months = (NUL,JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC);
{NUL position added for a user response that won't}
{fit into a real month-type position. }
CONST
TheThirties = [APR,JUN,SEP,NOV]; {These months have 30 days}

VAR
Name : String[15];
TempStr : String[80];
BirthDay,
PresentDay : Byte;
BirthMonth,
PresentMonth : Months;
BirthYear,
PresentYear : Integer;
DaysAlive : LongInt; {Some people are too old for just a plain integer!}
MonthNames : ARRAY[Months] OF String[3];

FUNCTION IntToStr(Number : LongInt) : String;
{This function converts an integer into a string so that it may be combined}
{with another string and displayed with the WriteAt or WriteCenter procedure}
VAR
Temp : String;

BEGIN
Str(Number,Temp);
IntToStr := Temp;
END; {IntToStr}

PROCEDURE Talk(Str : String);
{This procedure "talks" the passed string onto the display}
CONST
EndPunctuation = [ '!', '.', '?', ';' ]; {These marks end a sentence}
VAR
StrPos : Byte;

BEGIN
FOR StrPos := 1 TO Length(Str) DO
BEGIN
Write(Str[StrPos]);
IF Str[StrPos] <> ' ' THEN {Don't click blank spaces}
BEGIN
Sound(Ord(Str[StrPos])*10); {Different click for each char}
Delay(20);
NoSound;
END; {IF}
IF Str[StrPos] In EndPunctuation THEN Delay(500)
{Pause at end of sentence}
ELSE IF Str[StrPos] = ',' THEN Delay(200)
{Slight pause for commas}
ELSE Delay(10); {Normal delay between each char}
END; {FOR}
END; {Talk}

PROCEDURE WriteAt(x,y : Byte; Str : String);
{This procedure displays a passed string (Str) at the specified}
{X & Y location on the screen}
BEGIN
GotoXY(x,y);
Talk(Str);
END; {WriteAt}

PROCEDURE WriteCenter(y : Byte; Str : String);
{This procedure displays a passed string (Str) in the center of}
{the screen at the specified row (Y)}
VAR
x : Byte;

BEGIN
x := 40 - (Length(Str) DIV 2); {Determine correct X position to}
{center the string (Str)}
GoToXY(x,y);
Talk(Str);
END; {WriteCenter}

FUNCTION LeapYear(TheYear : Integer) : Boolean;
{This function determines if the passed year (TheYear) is a leap year. }
{A year is a leap year only if the year is evenly divisible by 4, except}
{for new centuries, like 1900 and 2000, which are leap years only if }
{they are divisible by 400. In this case, 1900 is not a leap year, but }
{2000 will be.}
{This function was taken from Tom Swan's book, MASTERING TURBO PASCAL 5.5,}
{which is an excellent book for learning the Turbo Pascal language!}
BEGIN
IF TheYear MOD 100 = 0 {Is the year a new century?}
THEN LeapYear := (TheYear MOD 400) = 0 {Then it must divide by 400}
ELSE LeapYear := (TheYear MOD 4) = 0; {Otherwise, it must divide by 4}
END; {LeapYear}

FUNCTION DaysLeftInMonth(TheMonth : Months;
TheDay : ShortInt; { A -1 will be passed here }
{ if user was born this month}
{ and year.}
TheYear : Integer) : Byte;
{This function determines how many days are left in the passed month}
{after the specified day. Passing a "0" as TheDay will return the }
{total amount of days in any month in any year.}
BEGIN
IF TheMonth = FEB {If the month is February and the year is a leap}
{year, it has 29 days.}
THEN IF LeapYear(TheYear)
THEN DaysLeftInMonth := (29 - TheDay)
ELSE DaysLeftInMonth := (28 - TheDay)
ELSE IF TheMonth IN TheThirties
THEN DaysLeftInMonth := (30 - TheDay)
ELSE DaysLeftInMonth := (31 - TheDay);
END; {DaysLeftInMonth}

FUNCTION DaysInYear(TheYear : Integer) : Integer;
{This function returns the number of days in a whole year, whether it is}
{a leap year or not.}
BEGIN
IF NOT LeapYear(TheYear)
THEN DaysInYear := 365
ELSE DaysInYear := 366;
END; {DaysInYear}

FUNCTION BornThisMonth : Boolean;
{This function returns TRUE if user was born in the present month AND year.}
BEGIN
BornThisMonth := (BirthYear = PresentYear) AND
(BirthMonth = PresentMonth);
END; {BornThisMonth}

FUNCTION BornThisYear : Boolean;
{This function returns TRUE if the user was born in the present year.}
BEGIN
BornThisYear := (BirthYear = PresentYear);
END; {BornThisYear}

PROCEDURE ShowDays(x,y,LastDay : Byte);
{This procedure is called by the procedure ComputeDaysAlive, and displays}
{the days on the screen as they are being computed.}
{ x, y - starting position to display the days }
{ Month - the month that the days are in }
{ Day - the day to start displaying. A "0" }
{ displays all the days in the month }
{ Year - the year that the days are in }
VAR
OneDay : Byte;
BEGIN
Delay(20);
FOR OneDay := 1 TO LastDay DO
BEGIN
GoToXY(x,y);
Sound(500); {Make a short clicking sound}
Write(OneDay);
NoSound;
Delay(4);
END; {FOR}
END; {ShowDays}

PROCEDURE ShowYear(y : Byte; Year : Integer);
{This procedure displays each year in the user's life on the left-hand}
{side of the display while DaysAlive is being computed. It is called }
{by procedure ComputeDaysAlive}
BEGIN
Delay(25);
TextBackground(LightBlue);
GotoXY(1,y);
Write(Year);
TextBackground(Black);
END; {ShowYear}

PROCEDURE ComputeDaysAlive;
{This procedure is the work-horse of the whole program. It is responsible}
{for actually computing and displaying the total days in the user's life }
CONST
ColSpace = 3;
VAR
OneMonth : Months;
OneDay : Byte;
OneYear : Integer;
Column : ARRAY[Months] OF Byte;
Row : Byte;
ch : Char;

BEGIN
Clrscr;
Row := 1;
TextBackground(LightBlue);
GoToXY(8,Row);
FOR OneMonth := JAN TO DEC DO {Display month header}
BEGIN
Column[OneMonth] := WhereX + 1;
Write(MonthNames[OneMonth]);
GoToXY(WhereX+ColSpace,Row);
END; {FOR}
TextBackground(Black);
Window(1,2,80,25); {Keep month header on the screen if the display}
{has to be scrolled up to fit all the years on }
{the screen}
{**********************************************************************}
{* Of the following three conditional statement groups, only one will *}
{* execute, depending on the user's birthdate in relation to the *}
{* present date: *}
{**********************************************************************}
{* 1 : This group will execute only if the user was born prior to *}
{* the present year. These statements first find the number of *}
{* days the user was alive in his or her birth month. Then *}
{* the number of days in each month up to and including *}
{* December are computed. If there are any full years between *}
{* the birth year and present year, these days are added. *}
{* Next, the days in the remaining months up to the month *}
{* before the present month are added. Finally, the days in *}
{* the present month up to the present day are added. *}
{* *}
{* 2 : This group will execute only if the user was born in the *}
{* present year, but not in the present month. Although a *}
{* person this young probably could not use a computer, pro- *}
{* grammers must account for every possible situation! *}
{* First, we must find the number of days the user was alive *}
{* in his or her birth month. Then the days in the months *}
{* between the birth month and present month, if any, are *}
{* added. Finally, the days in the present month up to the *}
{* present day are added. *}
{* *}
{* 3 : This group is the easiest of the three. Again, a person this *}
{* young probably isn't into computers just yet! The only thing *}
{* we need to do here is to subtract the birthday from the *}
{* present day. *}
{**********************************************************************}

{1111111111111111111111111111111111111111111111111111111111111111111111}
IF NOT BornThisYear THEN
BEGIN
DaysAlive := DaysLeftInMonth(BirthMonth,BirthDay,BirthYear);
ShowYear(Row,BirthYear);
ShowDays(Column[BirthMonth],Row,
DaysLeftInMonth(BirthMonth,BirthDay,BirthYear));
FOR OneMonth := Succ(BirthMonth) TO DEC DO
BEGIN
DaysAlive := DaysAlive + DaysLeftInMonth(OneMonth,0,BirthYear);
ShowDays(Column[OneMonth],Row,DaysLeftInMonth(OneMonth,0,BirthYear));
END; {FOR}
Row := Succ(Row);
FOR OneYear := Succ(BirthYear) TO Pred(PresentYear) DO
BEGIN
DaysAlive := DaysAlive + DaysInYear(OneYear);
ShowYear(Row,OneYear);
FOR OneMonth := JAN TO DEC DO
ShowDays(Column[OneMonth],Row,DaysLeftInMonth(OneMonth,0,OneYear));
Row := Succ(Row);
IF Row > 24 THEN {Bottom of screen}
BEGIN
Writeln; {Scroll up one line}
Row := 24; {Stay at bottom of screen}
END; {IF Row}
END; {FOR OneYear}
ShowYear(Row,PresentYear);
FOR OneMonth := JAN TO Pred(PresentMonth) DO
BEGIN
DaysAlive := DaysAlive + DaysLeftInMonth(OneMonth,0,PresentYear);
ShowDays(Column[OneMonth],Row,DaysLeftInMonth(OneMonth,0,PresentYear));
END; {FOR OneMonth}
DaysAlive := DaysAlive + PresentDay;
ShowDays(Column[PresentMonth],Row,PresentDay);
END {IF NOT BornThisYear}
{1111111111111111111111111111111111111111111111111111111111111111111111}

{2222222222222222222222222222222222222222222222222222222222222222222222}
ELSE IF NOT BornThisMonth THEN
BEGIN
ShowYear(Row,BirthYear);
DaysAlive := DaysLeftInMonth(BirthMonth,BirthDay,BirthYear);
ShowDays(Column[BirthMonth],Row,
DaysLeftInMonth(BirthMonth,BirthDay,BirthYear));
FOR OneMonth := Succ(BirthMonth) TO Pred(PresentMonth) DO
BEGIN
DaysAlive := DaysAlive + DaysLeftInMonth(OneMonth,0,BirthYear);
ShowDays(Column[OneMonth],Row,
DaysLeftInMonth(OneMonth,0,BirthYear));
END;{FOR OneMonth}
DaysAlive := DaysAlive + PresentDay;
ShowDays(Column[PresentMonth],Row,PresentDay);
END {IF NOT}
{2222222222222222222222222222222222222222222222222222222222222222222222}

{3333333333333333333333333333333333333333333333333333333333333333333333}
ELSE BEGIN {Born in this present month & year}
DaysAlive := PresentDay - BirthDay;
ShowYear(Row,BirthYear);
ShowDays(Column[PresentMonth],Row,DaysAlive);
END; {ELSE}
{3333333333333333333333333333333333333333333333333333333333333333333333}

WriteLn;
Delay(50);
WriteCenter(24,'Please press <> so that I may continue.');
Readln;
Window(1,1,80,25); {Back to full screen}
END; {ComputeDaysAlive}

PROCEDURE ConvertToMonthType(InMonth : Byte; VAR OutMonth : Months);
{This procedure receives the number that the user entered for a specific}
{month (or the month number that DOS reported using the "GetDate" }
{procedure) and converts it into the corresponding Months value. This }
{allows us to program using actual month names, instead of numbers, and }
{also allows the program to display prompt strings like this : }
{ "Is Feb 3, 1950 your real birthday?" }
{instead of like this : }
{ "Is 2/3/1950 your real birthday?" }
{If this procedure receives a value that is not in the range of 1-12, }
{the output month type will be "NUL". Now the program will know that }
{the user entered an invalid month. }
BEGIN
CASE InMonth OF
1 : OutMonth := JAN; 7 : OutMonth := JUL;
2 : OutMonth := FEB; 8 : OutMonth := AUG;
3 : OutMonth := MAR; 9 : OutMonth := SEP;
4 : OutMonth := APR; 10 : OutMonth := OCT;
5 : OutMonth := MAY; 11 : OutMonth := NOV;
6 : OutMonth := JUN; 12 : OutMonth := DEC;
ELSE OutMonth := NUL; {Not a valid month.}
END; {CASE}
END; {ConvertToMonthType}

PROCEDURE GetPresentDate;
{This procedure gets the present date from DOS and then asks the user it it}
{is correct. If it is not correct, the user is given the chance to enter the}
{real present date. This will not update the system date.}
VAR
ch : Char;
TempMonth : Byte;
Year,Month,
Day,DayOfWeek : Word;

BEGIN
Clrscr;
GetDate(Year,Month,Day,DayOfWeek); {Get the date from DOS}
PresentDay := Day;
ConvertToMonthType(Month,PresentMonth);
PresentYear := Year;
TempStr := 'Is today ' + MonthNames[PresentMonth] + ' ' +
IntToStr(PresentDay) + ', ' + IntToStr(PresentYear) + '?';
WriteCenter(10,TempStr);
WriteCenter(12,'(Yes/No)? ');
Readln(ch);
IF Upcase(ch) = 'N' THEN
BEGIN
Clrscr;
TempStr := 'Well '+ Name +
', you will have to provide the correct date for me!';
WriteCenter(10,TempStr);
WriteCenter(12,'Please press <>!');
Readln;
REPEAT
Clrscr;
WriteAt(5,10,'What is the correct MONTH, in numerical format? ');
Readln(TempMonth);
ConvertToMonthType(TempMonth,PresentMonth);
WriteAt(5,12,'What is the correct DAY, in numerical format? ');
Readln(PresentDay);
WriteAt(5,14,'What is the correct YEAR? (All 4 digits, please!) ');
Readln(PresentYear);
Clrscr;
TempStr := 'Is ' + MonthNames[PresentMonth] + ' ' +
IntToStr(PresentDay) + ', ' + IntToStr(PresentYear) +
' today''s correct date?';
WriteCenter(10,TempStr);
WriteCenter(12,'(Yes/No)? ');
Readln(ch);
Clrscr;
UNTIL Upcase(ch) = 'Y';
END; {IF}
Clrscr;
END; {GetPresentDate}

PROCEDURE GetUserBirthDate;
{This procedure simply prompts the user for his/her birthdate}
VAR
ch : char;
TempMonth : Byte;
BEGIN
REPEAT
Clrscr;
WriteAt(5,6,'What is your birth MONTH, in numerical format? ');
Readln(TempMonth);
WriteAt(5,8,'What is your birth DAY, in numerical format? ');
Readln(BirthDay);
WriteAt(5,10,'What is your birth YEAR? (All 4 digits, Please!) ');
Readln(BirthYear);
ConvertToMonthType(TempMonth,BirthMonth);
Clrscr;
TempStr := 'Is ' + MonthNames[BirthMonth] + ' ' + IntToStr(BirthDay) +
', ' + IntToStr(BirthYear) +
', your real birthday?';
WriteCenter(10,TempStr);
WriteCenter(12,'(Yes/No)? ');
Readln(ch);
UNTIL UpCase(ch) = 'Y';
END; {GetUserBirthDate}

FUNCTION BirthDateIsBeforePresentDate : Boolean;
{This function is called after the present date and the birth date are}
{known. If the birth date occurs after the present date, this function}
{returns FALSE so that the program can prompt for a new birth date. }
VAR
Temp : Boolean;
BEGIN
Temp := (BirthYear <= PresentYear);
IF (BirthYear = PresentYear) AND (BirthMonth = PresentMonth) THEN
Temp := (BirthDay <= PresentDay)
ELSE IF (BirthYear = PresentYear) THEN
Temp := (BirthMonth <= PresentMonth);
IF Temp = FALSE THEN
BEGIN
Clrscr;
TempStr := Name + ', the birth date you entered is after today!';
WriteCenter(10,TempStr);
WriteCenter(12,'Please press <> so you may try again.');
Readln;
END; {IF}
BirthDateIsBeforePresentDate := Temp;
END; {BirthDateIsBeforePresentDate}

FUNCTION DateIsValid(TheMonth : Months; TheDay,TheYear : Integer) : Boolean;
{This function determines if the passed date is actually valid. If it is not}
{valid, the user is told so. A valid date is one that will fit on a calender}
{at some time in history, or at some time in the future. }
VAR
ch : Char;
Temp : Boolean;
BEGIN
Temp := TRUE;
IF TheMonth = NUL THEN Temp := FALSE;
IF (DaysLeftInMonth(TheMonth,TheDay,TheYear) < 0) OR (TheDay < 1)
THEN Temp := FALSE;
IF (TheYear < 0) THEN Temp := FALSE;
IF Temp = FALSE THEN
BEGIN
Clrscr;
TempStr := Name + ', ' + MonthNames[TheMonth] + ' ' +
IntToStr(TheDay) + ', ' + IntToStr(TheYear) +
', is not a valid date!';
WriteCenter(10,TempStr);
WriteCenter(12,'Remember, I am Superchip; it is impossible to out-smart me!');
WriteCenter(14,'Press <> to try again.');
Readln;
Clrscr;
END; {IF}
DateIsValid := Temp;
END; {DateIsValid}

PROCEDURE OpeningComments;
VAR
ch : Char;
BEGIN
WriteCenter(10,'Hello! I am Superchip, the amazing computer!');
WriteCenter(12,'Please enter your name below so that I may know whom I''m impressing!');
WriteAt(30,14,'First Name? ');
Readln(Name);
Name[1] := Upcase(Name[1]); {Capitalize first char of name}
IF Name = '' THEN
BEGIN
Clrscr;
WriteAt(5,10,'Since you have decided not to tell me your name, I will give you one!');
WriteCenter(12,'Please press <>!');
Readln;
Name := 'Sam';
END; {IF}
Clrscr;
TempStr := 'Well ' + Name +
', have you ever tried to figure out your age in';
WriteAt(10,5,TempStr);
WriteAt(5,6,'days, instead of in years? Of course you haven''t! It would be too ');
WriteAt(5,7,'difficult for a human being, like yourself, to sit down and actually ');
WriteAt(5,8,'figure out how many days were in each month, which years in your life ');
WriteAt(5,9,'were leap years, how many days were in each February, etc.');
WriteCenter(11,'Please press <> so that I may continue!');
Readln;
Clrscr;
WriteAt(10,5,'Fortunately, I have constructed an extremely complex ');
WriteAt(5,6,'algorithm to accomplish this task! In a minute, I will perform this ');
WriteAt(5,7,'amazing feat for you, but first I need to verify your computer''s ');
WriteAt(5,8,'internal date.');
WriteCenter(10,'Please press <> so that I may verify the date!');
Readln;
END; {OpeningComments}

PROCEDURE Initialize;
{This procedure clears the screen and assigns light green as the text color. }
{The statements following assign actual string names to the global MonthNames}
{array that will be used to display the months on the screen throughout the }
{program.}
BEGIN
Clrscr;
TextColor(LightGreen);
MonthNames[NUL] := '***';{< MonthNames[JAN] := 'Jan'; MonthNames[JUL] := 'Jul';
MonthNames[FEB] := 'Feb'; MonthNames[AUG] := 'Aug';
MonthNames[MAR] := 'Mar'; MonthNames[SEP] := 'Sep';
MonthNames[APR] := 'Apr'; MonthNames[OCT] := 'Oct';
MonthNames[MAY] := 'May'; MonthNames[NOV] := 'Nov';
MonthNames[JUN] := 'Jun'; MonthNames[DEC] := 'Dec';
END; {Initialize}

PROCEDURE TerminateProgram;
{Set text color back to white, clear the screen, and make a few comments}
{before ending.}
BEGIN
TextColor(LightGray);
Clrscr;
Writeln('Thanks for trying SuperChip!');
Writeln('Written and compiled by Jeff Whippo, 1/27/91');
END; {TerminateProgram}

{***************************************************************************}
{* MAIN PROGRAM BODY *}
{***************************************************************************}
BEGIN
Initialize;
OpeningComments;
REPEAT
GetPresentDate;
UNTIL DateIsValid(PresentMonth,PresentDay,PresentYear);
WriteCenter(10,'Now that today''s date is verified, I need to know your birth date!');
WriteCenter(12,'Please press <> to continue.');
Readln;
REPEAT
GetUserBirthDate;
UNTIL DateIsValid(BirthMonth,BirthDay,BirthYear) AND BirthDateIsBeforePresentDate;
Clrscr;
TempStr := 'Now that I have the required input from you ' + Name + ', I will perform';
WriteAt(5,10,TempStr);
WriteAt(5,11,'my task for you. Let me assure you that I could compute the number of');
WriteAt(5,12,'days you''ve been alive faster that you could ever blink an eye! Since');
WriteAt(5,13,'you are a human being, I will slow my computations to an almost stand-');
WriteAt(5,14,'still so that you may actually see this process.');
WriteCenter(16,'Press <> to begin!');
Readln;
ComputeDaysAlive;
Clrscr;
TempStr := Name + ', you have been alive for ' + IntToStr(DaysAlive) +
' days!';
WriteCenter(10,TempStr);
WriteCenter(12,'Please press <> so that I may terminate this program!');
Readln;
TerminateProgram;
END.