home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
vi_si_on
/
gamble.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-30
|
22KB
|
706 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,userret;
const
{Definitions of Constants}
perinc :real=10; {Percent of Increase in RR}
var
Credits :longint;
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;
done,finished :Boolean;
procedure game;
implementation
Procedure ansicls;
Begin
if vt52 in urec.config then begin
wvt52(#234+#234+#04);
clrscr;
end else
Write(direct,#27'[2J')
End;
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 lame;
begin
WriteLn(^R'Gee dude...were did you learn math?');
end;
Procedure exitconvert;
begin
WriteLn(^R'Your '^P'['^S,credits,^P']'^R' credits have been converted into '+
^P'['^S,trunc(credits/configset.convrate),^P']'^R' file points.');
urec.udpoints:=trunc(urec.udpoints+(credits/configset.convrate));
credits:=0
end;
procedure wingame;
begin
writeln;
write ('We have a WINNER!'^G^G);
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;
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
ANSiCLS;
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
lame;
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
lame;
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)*configset.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)/configset.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 configset.usetimebank then exit else begin;
command1:=configset.totalallowed-urec.timebank;
if command1<=0 then
writeLn (^R'You currently have '^P'['^S,urec.timebank,^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.timebank:=urec.timebank+valu(input);
urec.timetoday:=urec.timetoday-valu(input);
writeln ('You now have '^S,urec.timebank,^R' minutes in storage.');
end;
end;
end;
end;
procedure gettime;
begin
write (^R'How much time do you wish to withdraw? '^P'['^S,urec.timebank,^R' max'^P']'^R': ');
writestr('*');
if valu(input)>urec.timebank then begin
writeln ('You only have '^S,urec.timebank,^R' minutes in storage.');
exit;
end;
if valu(input)>0 then
begin;
urec.timetoday:=urec.timetoday+valu(input);
urec.timebank:=urec.timebank-valu(input);
Writeln (^R'You currently have '^P'['^S,urec.timetoday,^P']'^R' minutes left today.');
WriteLn (^R'You have '^P'['^S,urec.timebank,^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.timebank,^P']'^R' minutes in the timebank.');
end;
Procedure menu;
begin
writeln (^M^M^M^R'The File Point/Credit Bank'^M);
writeln (' '^S'1'^R' Convert Xfer Points -> Credits');
writeln (' '^S'2'^R' Convert Credits -> File Points');
writeln (' '^S'3'^R' Convert Credits -> Time');
if configset.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'7'^R' Quit');
end;
if not configset.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.timebank,^R' minutes'^P']'^R);
writeln ('Time Left '^P'['^S,urec.timetoday,^R' minutes'^P']'^R);
writestr (^R'['^P'Bank Menu'^R']['^S'?'^P'/Help'^R']['^S'Q'^P'/Quit'^R']: *');
if valu(input)=1 then getcredits;
if valu(input)=2 then getpoints;
{ if valu(input)=3 then gettime;}
if (valu(input)=4) and (configset.usetimebank) then puttime;
if (valu(input)=5) and (configset.usetimebank) then gettime;
if (valu(input)=6) and (configset.usetimebank) then checktime;
if valu(input)>7 then
begin
lame;
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
lame;
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,configset.numpoints,^P']'^R' points to win this game. You have '^P+
'['^S,configset.numthrows,^P']'^R' throws.');
writeln('Here are your throws -');
writeln;
writeln(^P'1'^S' ['^P'Fast Overarm'^S']'^R' Bullseye or Nothing');
writeln(^P'2'^S' ['^P'Controlled '^S']'^R' 10,20,30,40');
writeln(^P'3'^S' ['^P'Wild '^S']'^R' Anything');
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
lame;
exit
end;
writestr (^P'Darts'^R' - ['^S'?'^P'/Help'^R']: *');
command1:=valu(input);
if (input='?') or (capfir(input)='H') then instructions;
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>=configset.numthrows then
begin
if pig>=configset.numpoints then
begin
command1:=bet;
wingame;
end;
if pig<=configset.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>=configset.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
lame;
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,configset.chance,^R'%'^P']'^R'. If you get away with robbing the bank, you will get ');
WriteLn(^P'['^S,configset.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<configset.chance) then
begin
command1:=credits*configset.gain;
credits:=credits+(credits*configset.gain);
wingame;
exit;
end;
if (Randchar>configset.chance) then
begin
credits:=0;
WriteLn(^R'You LOST! Too bad.');
exit;
end;
end;
end;
Procedure TradeFP;
var u:userrec;
who:mstr;
n,howmuch:integer;
begin
WriteLn(^M'Please enter the Alias of the person you wish to give file points to.');
WriteStr('->*');
who:=Input;
if who='' then exit;
If who=urec.handle then begin
WriteLn('Nice Try, '+urec.handle+'!!'^G^M);
exit
end;
writeln ('Looking Up User...One Moment');
for n:=1 to numusers do begin
seek (ufile,n);
read (ufile,u);
If Match(u.handle,who) then if (u.level>0) then if (length(u.handle)>0) then Begin
WriteLn(^R'User has been found');
WriteStr(^F'Give '^A+u.handle+^F+' File Points? *');
If Yes Then Begin
Write(^S'You have '^U+strr(urec.udpoints)+^S' File Points'^M);
WriteStr(^S'Give How Many Points To '^R+u.handle+^S'?*');
if input='' then exit;
howmuch:=valu(Input);
If howmuch<0 then begin
WriteLn('Hmmm.. A Negative value is not acceptable, Nice Try!'^G^G^G^G);
Exit
End;
If howmuch<=urec.udpoints then Begin
urec.udpoints:=urec.udpoints-howmuch;
u.udpoints:=u.udpoints+howmuch;
WriteLn(^M^S+strr(howmuch)+^R' File Points have been trasferred');
End Else WriteLn('Sorry, You don''t have that many points!');
writeurec;
seek (ufile,n);
write (ufile,u);
readurec;
exit;
end else exit;
end;
end;
end;
Procedure NukeFP;
var u:userrec;
who:mstr;
n,howmuch:integer;
begin
WriteLn(^R'How This Works'^S':');
WriteLn(^F'In order to deduct another user''s file points you must also');
WriteLn(^F'deduct the '^A'SAME'^F' amount from your file points.');
WriteLn(^M^P'Who''s File Points do you wish to Nuke?');
WriteStr(^R'->*');
who:=input;
if who='' then exit;
If who=urec.handle then begin
WriteLn('Nice Try, '+urec.handle+'!!'^G^M);
exit
end;
writeln ('Looking Up Victim...One Moment');
for n:=1 to numusers do begin
seek (ufile,n);
read (ufile,u);
If Match(u.handle,who) then if (u.level>0) then if (length(u.handle)>0) then Begin
WriteLn(^R'User has been found');
WriteStr(^F'Nuke some/all of '^A+u.handle+'''s'^F' File Points? *');
If Yes Then Begin
Write(^S'You have '^U+strr(urec.udpoints)+^S' File Points'^M);
WriteStr(^S'Nuke How Many of '^R+u.handle+'''s '^S'Points? *');
if input='' then exit;
howmuch:=valu(Input);
If howmuch<0 then begin
WriteLn('Hmmm.. A Negative value is not acceptable, Nice Try!'^G^G^G^G);
Exit
End;
If howmuch<=urec.udpoints then Begin
urec.udpoints:=urec.udpoints-howmuch;
u.udpoints:=u.udpoints-howmuch;
WriteLn(^M^S+strr(howmuch)+^R' of '^A+u.handle+'''s'^R' File Points have been NUKED!');
End Else WriteLn('Sorry, You don''t have that many points!');
writeurec;
seek (ufile,n);
write (ufile,u);
readurec;
exit;
end else exit
end;
end;
end;
Procedure Classics;
begin
finished:=false;
Repeat
WriteHdr('The Classic Gambling Casino');
WriteLn(^M^P'['^S'1'^P']'^R' Enter the Bank');
WriteLn(^P'['^S'2'^P']'^R' Rob the Bank');
WriteLn(^P'['^S'3'^P']'^R' Darts');
WriteLn(^P'['^S'4'^P']'^R' Russian Roulette');
WriteLn(^P'['^S'5'^P']'^R' Hi-Lo');
WriteLn(^P'['^S'6'^P']'^R' Roulette');
writeln(^P'['^S'Q'^P']'^R' Quit'^M^M);
writeln ('You have '^P'['^S,urec.udpoints,^P']'^R' File Points');
writeln ('You have '^P'['^S,credits,^P'] Gambling Credits'^R);
writeln ('Timebank '^P'['^S,urec.timebank,^R' minutes'^P']'^R);
writeln ('Time Left '^P'['^S,urec.timetoday,^R' minutes'^P']'^R^M);
writestr (^M^P'Classic Gambling Menu'^R' - ['^S'?'^P'/Help'^R']'^P': *');
If Hungupon then Exit;
yn:=input;
If Hungupon then Exit;
yn:=capfir(yn);
Write(^R);
If (YN='1') then bank;
If (YN='2') then rob;
If (YN='3') then Darts;
If (YN='4') 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') then hilo;
If (YN='6') then roulette;
if (YN='Q') then exitconvert;
If (YN='Q') then finished:=true;
Until Finished;
end;
Begin
credits:=0;
initvar;
done:=False;
Repeat
WriteHdr('File Point Gambling/Trading/Nuking');
WriteLn;
If configset.usegambling then
WriteLn(^R'1 '^P'- '^S'Enter Classic Gambling Casino');
If configset.allowtrading then
WriteLn(^R'2 '^P'- '^S'Give File Points To Another User');
If configset.allownuking then
WriteLn(^R'3 '^P'- '^S'Nuke Another User''s File Points');
WriteLn(^R'4 '^P'- '^S'Visit The Bank');
WriteLn(^R'Q '^P'- '^S'Quit');
WriteStr(^M^R'File Point Utilities '^R'- '^S'['^A'?/Help'^S']:*');
If {Some ASSHOLE decides to} HungUpOn {You} Then Exit;
yn:=input;
If Hungupon Then Exit;
yn:=capfir(yn);
If (YN='1') and (configset.usegambling) Then classics;
If (YN='2') and (configset.allowtrading) Then TradeFP;
If (YN='3') and (configset.allownuking) Then NukeFP;
If (YN='4') then bank;
If (YN='Q') Then exitconvert;
If (YN='Q') then done:=true;
Until Done;
End;
end.