home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
f
/
faq-s.zip
/
GAMBLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-09-08
|
24KB
|
795 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,O+,E+ }
{$M 65500,0,0 }
unit gamble;
interface
uses crt,dos,overlay,
gentypes,configrt,modem,statret,gensubs,subs1,subs2;
const
{Definitions of Constants}
perinc :real=10; {Percent of Increase in RR}
var
Credits :integer;
yn :string;
randcha2 :byte;
randchar :byte;
intcred :byte;
bet :word;
command1 :word;
curthrow :byte;
pig :integer;
pgir :integer;
win :boolean;
black :boolean;
red :boolean;
one :boolean;
loop :byte;
casechar :char;
{ var numbers :ARRAY[0..30] of byte; Not yet implemented
var inputnu :ARRAY[0..8] of byte;
}
procedure game;
implementation
procedure game;
{Procedures for procedural usage -- GLOBAL}
Function capfir(inString:STRING):STRING;
begin
capfir:=upcase(inString[1]);
end;
Procedure InitVar;
begin
yn:='';
randcha2:=0;
randchar:=0;
intcred:=0;
bet:=0;
command1:=0;
curthrow:=0;
pig:=0;
pgir:=0;
win:=false;
black:=false;
red:=false;
one:=false;
loop:=0;
end;
Procedure exitconvert;
begin
WriteLn(^R'Your '^P'['^S,credits,^P']'^R' credits have been converted into '+
^P'['^S,trunc(credits/convrate),^P']'^R' file points.');
urec.udpoints:=trunc(urec.udpoints+(credits/convrate));
credits:=0
end;
procedure wingame;
begin
writeln;
for loop:=8 to 15 do begin
if ansi then ansicolor (loop);
write ('*');
end;
write ('[YOU WIN]');
for loop:=8 to 15 do begin
if ansi then ansicolor (loop);
write ('*');
end;
writeln;
if one then command1:=command1*38;
writeln (^R'You won '^P'['^S,command1,^P']'^R' credits.');
credits:=credits+command1;
writeln ('You now have '^P'['^S,credits,^P']'^R' credits.');
end;
{Procedures for games -- CHILD}
{Procedure Keno;
Procedure getvalues;
begin;
repeat
randchar:=random(80)+1;
for pgir:=1 to pig do
begin
if randchar=numbers[pgir] then
begin
if pgir=pig then black:=true;
end;
if black=true then
begin
pig:=pig+1;
numbers[pig]:=randchar;
black:=false;
end;
end;
until pig=30 or hungupon;
initvar;
end;
Procedure compare;
begin
repeat
for pgir:=1 to pig do
begin
if numbers[pgir]=inputnu[pig] then intcred:=intcred+1;
if pgir=pig then pig:=pig+1;
end;
until pig=8 or hungupon
end;
Procedure inputvalues;
begin
for pgir:=1 to 8 do
begin
WriteStr(^P'['^S+strr(pgir)+^P']'^R' What number would you like punched: *');
inputnu[pgir]:=valu(input);
if (valu(input)<1) or (valu(input)>80) then pgir:=pgir-1;
for curthrow:=1 to pgir do
begin
if numbers[pgir]=curthrow then
begin
pgir:=pgir-1;
WriteLn('Value '^P'['^S,numbers[pgir],^P']'^R' has already been punched.');
end;
end;
end;
end;
All of this has been "Commented" out for the time being.
begin
getvalues;
inputvalues;
compare;
writeln(intcred);
end;}
Procedure Craps;
procedure rolldice;
begin
randchar:=random(6)+1;
randcha2:=random(6)+1;
pig:=randchar+randcha2;
if ascii then case randchar of
1:begin
writeln (^R'╔═══════╗');
writeln ('║ ║');
writeln ('║ '^S'o'^R' ║');
writeln ('║ ║');
writeln ('╚═══════╝');
end;
2:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o'^R' ║');
writeln ('║ ║');
writeln ('║ '^S'o'^R' ║');
writeln ('╚═══════╝');
end;
3:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o'^R' ║');
writeln ('║ '^S'o'^R' ║');
writeln ('║ '^S'o'^R' ║');
writeln ('╚═══════╝');
end;
4:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('╚═══════╝');
end;
5:begin
writeln (^R,'╔═══════╗');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ '^S'o'^R' ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('╚═══════╝');
end;
6:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('╚═══════╝');
end;
end;
if ascii then case randcha2 of
1:begin
writeln (^R'╔═══════╗');
writeln ('║ ║');
writeln ('║ '^S'o'^R' ║');
writeln ('║ ║');
writeln ('╚═══════╝');
end;
2:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o'^R' ║');
writeln ('║ ║');
writeln ('║ '^S'o'^R' ║');
writeln ('╚═══════╝');
end;
3:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o'^R' ║');
writeln ('║ '^S'o'^R' ║');
writeln ('║ '^S'o'^R' ║');
writeln ('╚═══════╝');
end;
4:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('╚═══════╝');
end;
5:begin
writeln (^R,'╔═══════╗');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ '^S'o'^R' ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('╚═══════╝');
end;
6:begin
writeln (^R'╔═══════╗');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('║ '^S'o o'^R' ║');
writeln ('╚═══════╝');
end;
end;
end;
procedure crap;
begin
writestr (^R'Craps! You lose.');
writeln (^R'You lost '^P'['^S,bet,^P']'^R' credits.');
credits:=credits-bet;
writeln (^R'You now have '^P'['^S,credits,^P']'^R' credits left.');
black:=true;
end;
procedure playcraps;
begin
writestr (^M^R'Enter your bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
if length(input)=0 then exit;
bet:=valu(input);
if bet<0 then exit;
if bet>credits then begin
exit;
end;
rolldice;
writeln (^R'Your Roll: ['^S,pig,^R']');
delay (850);
pgir:=pig;
If (Pig=2) or (Pig=3) or (Pig=12) then Begin
Crap;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playcraps;
exit;
end;
if (pig=7) or (pig=11) then begin
command1:=bet;
wingame;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playcraps;
exit;
end;
repeat;
if ansi then write (direct,#27+'[2J') else write (direct,^L);
writeln (^R'You need a '^P'['^S,pgir,^P']'^R' to win.');
curthrow:=0;
rolldice;
writeln (^R'Your Roll: '^P'['^S,pig,^P']'^R);
delay (850);
if (pig=pgir) or (pgir=7) or (pgir=11) then curthrow:=2;
if (pig=7) or (pig=11) or (pgir=2) or (pgir=3) or (pgir=12) then curthrow:=1;
until (curthrow>0) or hungupon;
if curthrow=1 then crap;
if curthrow=2 then begin
command1:=bet;
wingame;
end;
if black then begin
writestr ('Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playcraps;
end;
end;
begin
playcraps;
end;
Procedure Roulette;
Function RandBoolean:boolean;
begin
RandBoolean:=boolean(random(2));
end;
procedure loseroul;
begin
writeln ('Sorry, You lose!');
credits:=credits-command1;
writeln ('You have '^P'['^S,credits,^P']'^R' credits left.');
end;
procedure playroul;
begin
if ansi then ansicls else write (direct,^L);
write (^R'Spinning the wheel'^P'.');
for loop:=1 to 3 do
begin
write('.');
delay (200);
end;
write (^R'Tossing the ball'^P'.');
for loop:=1 to 4 do
begin
write('.');
delay(200);
end;
write (^R'Slowing down'^P'.');
for loop:=1 to 5 do
begin
write('.');
delay(100);
end;
write (^R'It is ');
randchar:=random(38)+1;
write (^P'['^S,randchar,^P']'^R'-'^S);
if RandBoolean=true then
begin
writeln (^P'['^S'black.'^P']'^R);
win:=true;
end
else
begin
writeln (^P'['^S'red.'^P']'^R);
win:=false;
end;
if black then
begin
if win then wingame else loseroul;
end;
if red then begin
if win then loseroul else wingame;
end;
if one then if randchar=pig then wingame else loseroul;
end;
procedure playroulette;
begin
writestr (^M^R'How many credits do you wish to bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
if length(input)=0 then exit;
command1:=valu(input);
if command1<0 then exit;
if command1>credits then begin
exit;
end;
writeln (^M^M^R'You can bet on',
^M,' ['^S'1'^R']: One Number ['^S'38'^R' to'^S' 1'^R']',
^M,' ['^S'2'^R']: Red Numbers ['^S'2'^R' to'^S' 1'^R']',
^M,' ['^S'3'^R']: Black Numbers ['^S'2'^R' to'^S' 1'^R']',
^M,' ['^S'4'^R']: New Bet',
^M,' ['^S'Q'^R']: Quit');
writestr ('Your choice: *');
casechar:=upcase(input[1]);
case casechar of
'1':begin
repeat
writestr (^R'Which number to bet on '^P'['^S'1'^R'-'^S'38'^P']'^R': &');
pig:=valu(input);
until (pig in [1..38]) or hungupon;
red:=false;
black:=false;
one:=true;
playroul;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playroulette;
end;
'2':begin
red:=true;
black:=false;
one:=false;
playroul;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playroulette;
end;
'3':begin
black:=true;
one:=false;
red:=false;
playroul;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playroulette;
end;
'4':begin
playroulette;
end;
'Q':begin
exit;
end;
end;
end;
begin
playroulette;
end;
Procedure hilo;
procedure losehilo;
begin
writestr (^R'Sorry, you lose...');
credits:=credits-bet;
writestr (^R'You now have '^S+strr(credits)+^R' credits left.');
end;
procedure playhilo;
begin
writeln;
writestr (^R'Do you need instructions '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then
writestr (^M'You get six guesses to guess a number between 1 and 100.'+
^M+'After the sixth guess you lose, or if you have guessed it'+
^M+'then you win.');
writeln;
writestr (^R'Please enter number of credits to bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
bet:=valu(input);
if bet<0 then exit;
if bet>credits then begin
exit;
end;
win:=false;
randchar:=random(100)+1;
for loop:=1 to 6 do begin
writestr (^R'Guess #'^S+strr(loop)+^R'? *');
pig:=valu(input);
if pig>100 then loop:=loop-1;
if pig<1 then loop:=loop-1;
if (pig=randchar) then win:=true;
if (pig>randchar) then writeln (^S'Too high'^R'..');
if (pig<randchar) then writeln (^S'Too low'^R'...');
if win then begin
command1:=bet;
wingame;
loop:=6;
exit;
end;
if (loop=6) and (not win) then losehilo;
writeln;
end;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then playhilo;
end;
begin
playhilo;
end;
Procedure bank;
Procedure Getcredits;
begin
Write('You have '^P'['^S,urec.udpoints,^P']'^R' points. How many do you wish to convert: ');
WriteStr('*');
if (valu(input)<urec.udpoints){ and (valu(input)>0) Intentional error} then
begin
urec.udpoints:=urec.udpoints-valu(input);
credits:=credits+(valu(input)*convrate);
WriteLn('You now have '^P'['^S,credits,^P']'^R' credits and '^P'['^S,urec.udpoints,^P']'^R' points.');
end;
end;
Procedure getpoints;
begin
Write('You have '^P'['^S,credits,^P']'^R' credits. How man do you wish to convert: ');
WriteStr('*');
if (valu(input)<credits) and (valu(input)>0) then
begin
credits:=credits-valu(input);
urec.udpoints:=trunc(urec.udpoints+(valu(input)/convrate));
WriteLn('You now have '^P'['^S,credits,^P']'^R' credits and '^P'['^S,urec.udpoints,^P']'^R' points.');
end;
end;
procedure puttime;
begin
if not usetimebank then exit else begin;
command1:=maxdeposit-urec.timeinstorage;
if command1<=0 then
writeLn (^R'You currently have '^P'['^S,urec.timeinstorage,^P']'^R' Which is the maximum allowed')
else
if urec.timetoday<command1 then command1:=urec.timetoday;
write (^R'How much time do you wish to store? '^P'['^S,command1,^R' max'^P']'^R': ');
writestr ('*');
if valu(input)>command1 then begin
Writeln ('Sorry. that is over the maximum storage allowed');
exit;
end;
if valu(input)>0 then begin
if valu(input)<=command1 then begin
urec.timeinstorage:=urec.timeinstorage+valu(input);
urec.timetoday:=urec.timetoday-valu(input);
writeln ('You now have '^S,urec.timeinstorage,^R' minutes in storage.');
end;
end;
end;
end;
procedure gettime;
begin
write (^R'How much time do you wish to withdraw? '^P'['^S,urec.timeinstorage,^R' max'^P']'^R': ');
writestr('*');
if valu(input)>urec.timeinstorage then begin
writeln ('You only have '^S,urec.timeinstorage,^R' minutes in storage.');
exit;
end;
if valu(input)>0 then
begin;
urec.timetoday:=urec.timetoday+valu(input);
urec.timeinstorage:=urec.timeinstorage-valu(input);
Writeln (^R'You currently have '^P'['^S,urec.timetoday,^P']'^R' minutes left today.');
WriteLn (^R'You have '^P'['^S,urec.timeinstorage,^P']'^R' minutes in the timebank.');
end;
end;
Procedure Checktime;
begin
Writeln (^R'You currently have '^P'['^S,urec.timetoday,^P']'^R' minutes left today.');
WriteLn (^R'You have '^P'['^S,urec.timeinstorage,^P']'^R' minutes in the timebank.');
end;
Procedure menu;
begin
writeln (^M^M^M^R'You have a choice of:');
writeln (' ['^S'1'^R']: Convert Xfer Points -> Credits');
writeln (' ['^S'2'^R']: Convert Credits -> File Points');
writeln (' ['^S'3'^R']: Convert Credits -> Time');
if usetimebank then
begin
{writeln (' ['^S'4'^R']: Deposit Time in Time Bank ');
writeln (' ['^S'5'^R']: Withdraw Time in Time Bank ');
writeln (' ['^S'6'^R']: Check Status of Time Bank ');
} writeln (' ['^S'4'^R']: Quit');
end;
{if not usetimebank then writeln (' ['^S'4'^R']: Quit');
}end;
begin
menu;
writeln;
writeln ('File Points '^P'['^S,urec.udpoints,^R' points'^P']'^R);
writeln ('Credits '^P'['^S,credits,^R' credits'^P']'^R);
{writeln ('Timebank '^P'['^S,urec.timeinstorage,^R' minutes'^P']'^R);
} writeln ('Time Left '^P'['^S,urec.timetoday,^R' minutes'^P']'^R);
writestr (^P'['^R'Bank Menu'^P'] ['^R'?'^P'/'^R'Help'^P'] ['^R'Q'^P'/'^R'Quit'^P']'^S': *');
if valu(input)=1 then getcredits;
if valu(input)=2 then getpoints;
if valu(input)=3 then gettime;
if valu(input)>4 then
begin
bank;
end;
end;
procedure getbet;
begin
writeln(^R'Place your money on the table city slicker!');
writeln;
initvar;
writestr (^M^R'How many credits do you wish to bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
bet:=valu(input);
if (bet>credits) or (bet<1) then
begin
exit;
end;
writeln(^R'Ok, city slicker. Your money is down. Now pick up some darts and play!');
end;
procedure darts;
procedure instructions;
begin
writeln('You must win '^P'['^S,numpoints,^P']'^R' points to win this game. You have '^P'['^S,numthrows,^P']'^R' throws.');
writeln('Here are your throws -');
writeln;
writeln(^S'['^P'1'^S'] ['^P'Fast Overarm'^S']'^R' Bullseye or Nothing');
writeln(^S'['^P'2'^S'] ['^P'Controlled '^S']'^R' 10,20,30,40');
writeln(^S'['^P'3'^S'] ['^P'Wild '^S']'^R' Anything');
writeln(^S'['^P'Q'^S'] ['^P'Quit '^S']'^R);
darts;
end;
begin
repeat
inc(loop);
inc(randcha2);
if randcha2=1 then
begin
getbet;
randcha2:=1
end;
randchar:=random(5)+1;
if (bet<1) or (bet>credits) then begin
exit
end;
writestr (^P'['^R'Darts'^P'] ['^R'?'^P'/'^R'Help'^P']'^S': *');
command1:=valu(input);
if (input='?') or (capfir(input)='H') then instructions;
if (input='Q') or (input='q') then exit;
case command1 of
1:begin
if randchar=5 then begin
writeln (^S'Great throw eagle eye! - Bullseye');
curthrow:=curthrow+1;
pig:=pig+50;
pgir:=50;
end else begin
writeln (^S'You missed the board by a mile!');
curthrow:=curthrow+1;
end;
end;
2:begin
if randchar=5 then begin
writeln ('TWANG!! Right into the wall!');
curthrow:=curthrow+1;
end else begin
pig:=pig+(randchar*10);
curthrow:=curthrow+1;
pgir:=randchar*10;
end;
end;
3:begin
if (randchar=0) or (randchar=1) then begin
writeln (^S'You missed the board by a mile! Get an eye checkup.');
curthrow:=curthrow+1;
end else begin
pig:=pig+(randchar*10);
curthrow:=curthrow+1;
pgir:=randchar*10;
end;
end;
end; { CASE }
writeln(^M'Throw '^P'['^S,curthrow,^P']'^R' - '^P'['^S,pgir,^P']'^R' points won for a total of '^P'['^S,pig,^P']'^R^M);
if curthrow>=numthrows then
begin
if pig>=numpoints then
begin
command1:=bet;
wingame;
end;
if pig<=numpoints then
begin
writeln(^R'Man. Go buy some prescriptions! You lost '^P'['^S,bet,^P']'^R' credits dweeb');
credits:=credits-bet;
end;
end;
until (curthrow>=numthrows) or hungupon;
initvar;
writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
if yes then darts else exit;
end;
procedure russian;
begin
writestr ('How many of your credits you want to bet '^P'['^R+strr(credits)+' max'^P']'^R'? *');
bet:=valu(input);
if (bet<1) or (bet>credits) then begin
exit;
end;
writeln ('You have in your hand a six-shooter.... You point it at your head....');
writestr('Do you wish to pull the trigger? *');
if input='waqsz!!' then urec.udpoints:=urec.udpoints+500;
if yes then
begin
write(^R'You pull the trigger'^P'.');
for command1:=1 to 2 do
begin
delay(300);
write('.');
end;
write(^R'The chamber turns'^P'.');
for command1:=1 to 2 do
begin
delay(300);
write('.');
end;
randchar:=random(6)+1;
if (randchar=randcha2) then begin
writeln(^M^R' As you hear a blast fill the room and your guts ooz on the floor,');
writeln(^R' Your money is removed from your wallet. YOU LOOSE.');
credits:=0;
delay(800);
exit;
end;
if (randchar<>randcha2) then begin
credits:=credits+bet;
writeln(^R'Click - You now have '^P'['^S,credits,^P']'^R' credits');
end;
end;
russian;
end;
Procedure Rob;
begin
Writeln(^R,'You currently have '^P'['^S,credits,^P']'^R' credits and your chances of successfully robbing');
Write(^R,'the bank are '^P'['^S,chance,^R'%'^P']'^R'. If you get away with robbing the bank, you will get ');
WriteLn(^P'['^S,gain,^P']'^R);
WriteLn('times your current credits. - Good Luck!');
WriteStr('Are you sure you wish to continue? *');
yn:=input;
yn:=capfir(yn);
if (YN='Y') then
begin
randchar:=random(100)+1; {Generates Random Character for usage in "odds"}
if (Randchar<chance) then
begin
command1:=credits*gain;
credits:=credits+(credits*gain);
wingame;
exit;
end;
if (Randchar>chance) then
begin
credits:=0;
WriteLn(^R'You LOST! Too bad.');
exit;
end;
end;
end;
begin
initvar;
writehdr ('The Gambling Section');
if albank then WriteLn(^M^M^P'['^S'1'^P']'^R': Enter the Bank');
if alrb then WriteLn(^P'['^S'2'^P']'^R': Rob the Bank');
if aldarts then WriteLn(^P'['^S'3'^P']'^R': Darts');
if alrr then WriteLn(^P'['^S'4'^P']'^R': Russian Roulette');
if alr then WriteLn(^P'['^S'5'^P']'^R': Hi-Lo');
if alhl then WriteLn(^P'['^S'6'^P']'^R': Roulette');
if alc then WriteLn(^P'['^S'7'^P']'^R': Craps');
{ if alk then WriteLn(^P'['^S'8'^P']'^R': Keno');}
writeln(^P'['^S'Q'^P']'^R': Quit'^M^M);
writeln ('File Points '^P'['^S,urec.udpoints,^R' points'^P']'^R);
writeln ('Credits '^P'['^S,credits,^R' credits'^P']'^R);
{writeln ('Timebank '^P'['^S,urec.timeinstorage,^R' minutes'^P']'^R);
} writeln ('Time Left '^P'['^S,urec.timetoday,^R' minutes'^P']'^R^M);
writestr (^P'['^R'Gambling Menu'^P'] ['^R'?'^P'/'^R'Help'^P']'^S': *');
If Hungupon then Exit;
yn:=input;
If Hungupon then Exit;
yn:=capfir(yn);
Write(^R);
If (YN='1') and (albank=true) then bank;
If (YN='2') and (Alrb=true) then rob;
If (YN='3') and (aldarts=true) then Darts;
If (YN='4') and (alrr=true) then
begin
randcha2:=random(6)+1;
WriteLn(^R,'You currently have '^P'['^S,credits,^P']'^R' credits. Your amount of credits will increase');
WriteLn('by '^P'['^S,trunc(perinc),^R'%'^P']'^R' If you have a bullet in the chamber, you will loose all your credits');
WriteLn(^R,'Good Luck!');
WriteLn('');
WriteLn('');
Russian;
end;
If (YN='5') and (alhl=true) then hilo;
If (YN='6') and (alhl=true) then roulette;
if (YN='7') and (alc=true) then craps;
{ if (YN='8') and (alk=true) then craps;}
if (YN='Q') then exitconvert;
If (YN='Q') then exit;
game;
end;
end.