Category : BBS Programs+Doors
Archive   : BOI120.ZIP
Filename : HILO.PAS

{$D-}
{$S-}
{$V-}

program HiLo;
{ Copyright (C) 1990 Andrew J. Mead
All Rights Reserved.
Contact POB 1155 Chapel Hill, NC 27514-1155 }

{ Version 0.1 beta dated 12/12/90 using BBS Onliner Interface 1.20
Version 1.07 12/11/90 BOI 1.20

}

Uses
dos,
boidecl,
getcmbbs,
iolib,
support;

Const
version = '1.00';
regnum = '';
regstr = 'Unregistered Version';
registered = false;

{ registered users
}

Const
hoffile = 'Hilohof.dat';

Var
hilonum : word; { computer's number }

gotit : boolean; { player success indicator }
quit : boolean; { player quit indicator }
inchar : char; { standard input variable }

Procedure GETINSTRUCTIONS;
begin {* GetInstructions *}
PortWindow(1,1,80,pagelength);
ClrPortScr;
PortColor(yellow,white);
SendString('HI-LO',false);
PortColor(cyan,lightgray);
SendString('',true);
SendString('The object of Hi-Lo is to guess the correct number in as few as a turns as',true);
SendString('necessary. The computer has chosen a number from 1 to 1024. After each',true);
SendString('guess, you''ll be told whether the guess was correct, too high, or too low.',true);

SendString('The other commands are ''Q'' to quit the game,''I'' to review these',true);
SendString('instructions, or ''T'' to check time remaining (if it is available.',true);
SendString('',true);
PortColor(yellow,white);
SendString('',true);
SendString('Press almost any key to continue game.',false);
ClearBuffers;
inchar := ReadPortKey
end; {* GetInstructions *}

Procedure INITIALIZE;
begin {* Initialize *}
randomize;
hilonum := random(1024) + 1;
quit := false;
playerpoints := 0;
gotit := false
end; {* Initialize *}

Procedure PLAYGAME;
var
moved : boolean;
linein : string;

Procedure SHOWSCREEN;
begin {* PlayGame,ShowScreen *}
PortWindow(1,1,80,pagelength);
ClrPortScr;
PortColor(cyan,lightgray);
SendString('Hi-Lo Guessing Game',false);
GotoPortXY(1,18);
TextPortColor(lightgray);
SendString('Hi-Lo options: ',false);
LineWrite('[I]nstructions ',true);
LineWrite('[T]ime ',usetime);
LineWrite('[Q]uit',true)
end; {* PlayGame,ShowScreen *}

Procedure WRITELINE;
begin {* PlayGame,WriteLine *}
ClrPortScr;
TextPortColor(lightgray);
if usetime then
begin
If LeftTime <= 0 then
begin
SendString('Your time limit has expired. Game is being exited.',true);
timexp := true;
exit
end
else if LeftTime < 4 then SendString(#7 + 'You have less than ' +
IntStr(LeftTime,0) + ' minutes left.',true)
end;
SendString('You have made '+ IntStr(playerpoints,0) + ' guesses. ',true);
PortColor(yellow,lightgray);
SendString('Enter your guess: ',false)
end; {* PlayGame,WriteLine *}

Procedure GETINPUT;
begin {* PlayGame,GetInput *}
repeat
begin
inchar := ReadPortKey;
if not (upcase(inchar) in ['1'..'9','Q','I','T']) then
SendString(#7,false)
end
until upcase(inchar) in ['1'..'9','Q','I','T'];
TextPortColor(white);
case upcase(inchar) of
'Q' :
begin
SendString('Quit',true);
SendString('Do you really want to quit? [Y/N] ',false);
repeat inchar := upcase(ReadPortKey) until inchar in ['Y','N'];
if inchar = 'Y' then
begin
quit := true;
SendString('Yes',true)
end
else SendString('No',false)
end;
'I' :
begin
GetInstructions;
ShowScreen;
PortWindow(1,20,80,pagelength)
end;
'T' :
begin
PortWindow(1,20,80,pagelength);
ClrPortScr;
GotoPortXY(1,1);
if usetime then SendString('You have less than ' +
IntStr(LeftTime,0) + ' minutes remaining.',false)
else SendString('This function is not operational.',false);
GotoPortXY(1,2);
SendString('Press almost any key to continue. ',false);
ClearBuffers;
inchar := ReadPortKey;
ClrPortScr
end
else
begin
SendString(inchar,false);
GetString(linein);
linein := inchar + linein;
moved := true
end
end
end; {* PlayGame,GetInput *}

Procedure PROCESSGUESS;
var
guessamount : word;
dummy : word;

begin {* PlayGame,ProcessGuess *}
Val(linein,guessamount,dummy);
PortWindow(1,1,80,pagelength);
if (dummy = 0) and (guessamount > 0) and (guessamount < 1024) then
begin
Inc(playerpoints);
GotoPortXY(1,12);
ClrPortEOL;
if guessamount = hilonum then
begin
PortColor(lightred + blink,white + blink);
SendString('Congratulations!!!',false);
PortColor(lightgreen,white);
SendString(' You''ve Done It!!!',false);
gotit := true
end
else
begin
TextPortColor(lightgray);
SendString('Your guess is ',false);
if guessamount < hilonum then
begin
PortColor(lightblue,lightgray);
SendString('Too Low',false)
end
else
begin
PortColor(yellow,lightgray);
SendString('Too High',false)
end
end
end
else SendString(#7#7#7,false)
end; {* PlayGame,ProcessGuess *}

begin {* PlayGame *}
ShowScreen;
repeat
begin
PortWindow(1,20,80,pagelength);
moved := false;
repeat
begin
WriteLine;
if not timexp then GetInput
end
until moved or quit or timexp;
if not (quit or timexp) then ProcessGuess
end;
until quit or gotit or timexp;
PortWindow(1,20,80,pagelength);
ClrPortScr;
TextPortColor(lightgray)
end; {* PlayGame *}

begin
GetCommand('BBSNOTES.DOC','HiLoHOF.Txt','HiLoErr.Log','Hi-Lo',version,[]);
SetPort;
If pagelength < 23 then AbortGame(23);
QueryUser;
if WriteCopy('HiLo',version,regnum,regstr,'',registered,false,true) then GetInstructions;
repeat
begin
Initialize;
PlayGame;
EndGame('HiLo','Guessers',regstr,hoffile,registered,gotit,false,false)
end
until not doagain;
EndPort
end.

Copyright (C) 1990 Andrew J. Mead
All Rights Reserved.

For further information, contact:
The Mad Programmer
Andrew J. Mead
POB 1155
Chapel Hill, NC 27514-1155