{$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.