home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / GAMBLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-08  |  23.2 KB  |  795 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,O+,E+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit gamble;
  5.  
  6. interface
  7.  
  8. uses crt,dos,overlay,
  9.      gentypes,configrt,modem,statret,gensubs,subs1,subs2;
  10.  
  11.  
  12. const
  13.                                         {Definitions of Constants}
  14.        perinc     :real=10;             {Percent of Increase in RR}
  15. var
  16.    Credits      :integer;
  17.    yn           :string;
  18.    randcha2     :byte;
  19.    randchar     :byte;
  20.    intcred      :byte;
  21.    bet          :word;
  22.    command1     :word;
  23.    curthrow     :byte;
  24.    pig          :integer;
  25.    pgir         :integer;
  26.    win          :boolean;
  27.    black        :boolean;
  28.    red          :boolean;
  29.    one          :boolean;
  30.    loop         :byte;
  31.    casechar     :char;
  32. {  var numbers  :ARRAY[0..30] of byte;  Not yet implemented
  33.    var inputnu  :ARRAY[0..8] of byte;
  34.  }
  35. procedure game;
  36.  
  37. implementation
  38.  
  39. procedure game;
  40.  
  41. {Procedures for procedural usage -- GLOBAL}
  42.  
  43. Function capfir(inString:STRING):STRING;
  44.  begin
  45.    capfir:=upcase(inString[1]);
  46.  end;
  47.  
  48. Procedure InitVar;
  49.  begin
  50.    yn:='';
  51.    randcha2:=0;
  52.    randchar:=0;
  53.    intcred:=0;
  54.    bet:=0;
  55.    command1:=0;
  56.    curthrow:=0;
  57.    pig:=0;
  58.    pgir:=0;
  59.    win:=false;
  60.    black:=false;
  61.    red:=false;
  62.    one:=false;
  63.    loop:=0;
  64.  end;
  65.  
  66. Procedure exitconvert;
  67.  begin
  68.   WriteLn(^R'Your '^P'['^S,credits,^P']'^R' credits have been converted into '+
  69.    ^P'['^S,trunc(credits/convrate),^P']'^R' file points.');
  70.   urec.udpoints:=trunc(urec.udpoints+(credits/convrate));
  71.   credits:=0
  72.  end;
  73.  
  74.   procedure wingame;
  75.   begin
  76.        writeln;
  77.        for loop:=8 to 15 do begin
  78.          if ansi then ansicolor (loop);
  79.          write ('*');
  80.        end;
  81.        write ('[YOU WIN]');
  82.        for loop:=8 to 15 do begin
  83.          if ansi then ansicolor (loop);
  84.          write ('*');
  85.        end;
  86.        writeln;
  87.        if one then command1:=command1*38;
  88.        writeln (^R'You won '^P'['^S,command1,^P']'^R' credits.');
  89.        credits:=credits+command1;
  90.        writeln ('You now have '^P'['^S,credits,^P']'^R' credits.');
  91.   end;
  92.  
  93.  
  94. {Procedures for games -- CHILD}
  95. {Procedure Keno;
  96. Procedure getvalues;
  97. begin;
  98.   repeat
  99.    randchar:=random(80)+1;
  100.     for pgir:=1 to pig do
  101.    begin
  102.     if randchar=numbers[pgir] then
  103.      begin
  104.      if pgir=pig then black:=true;
  105.      end;
  106.     if black=true then
  107.      begin
  108.       pig:=pig+1;
  109.       numbers[pig]:=randchar;
  110.       black:=false;
  111.      end;
  112.    end;
  113.   until pig=30 or hungupon;
  114. initvar;
  115. end;
  116.  
  117.  
  118. Procedure compare;
  119. begin
  120. repeat
  121.   for pgir:=1 to pig do
  122.  begin
  123.     if numbers[pgir]=inputnu[pig] then intcred:=intcred+1;
  124.     if pgir=pig then pig:=pig+1;
  125.  end;
  126. until pig=8 or hungupon
  127. end;
  128.  
  129. Procedure inputvalues;
  130. begin
  131.  for pgir:=1 to 8 do
  132.  begin
  133.   WriteStr(^P'['^S+strr(pgir)+^P']'^R' What number would you like punched: *');
  134.   inputnu[pgir]:=valu(input);
  135.   if (valu(input)<1) or (valu(input)>80) then pgir:=pgir-1;
  136.   for curthrow:=1 to pgir do
  137.    begin
  138.     if numbers[pgir]=curthrow then
  139.      begin
  140.       pgir:=pgir-1;
  141.       WriteLn('Value '^P'['^S,numbers[pgir],^P']'^R' has already been punched.');
  142.      end;
  143.    end;
  144.  end;
  145. end;
  146.  
  147.          All of this has been "Commented" out for the time being.
  148.  
  149. begin
  150. getvalues;
  151. inputvalues;
  152. compare;
  153. writeln(intcred);
  154. end;}
  155.  
  156.  
  157. Procedure Craps;
  158.   procedure rolldice;
  159.   begin
  160.      randchar:=random(6)+1;
  161.      randcha2:=random(6)+1;
  162.      pig:=randchar+randcha2;
  163.      if ascii then case randchar of
  164.        1:begin
  165.           writeln (^R'╔═══════╗');
  166.           writeln ('║       ║');
  167.           writeln ('║   '^S'o'^R'   ║');
  168.           writeln ('║       ║');
  169.           writeln ('╚═══════╝');
  170.          end;
  171.        2:begin
  172.           writeln (^R'╔═══════╗');
  173.           writeln ('║ '^S'o'^R'     ║');
  174.           writeln ('║       ║');
  175.           writeln ('║     '^S'o'^R' ║');
  176.           writeln ('╚═══════╝');
  177.          end;
  178.        3:begin
  179.           writeln (^R'╔═══════╗');
  180.           writeln ('║ '^S'o'^R'     ║');
  181.           writeln ('║   '^S'o'^R'   ║');
  182.           writeln ('║     '^S'o'^R' ║');
  183.           writeln ('╚═══════╝');
  184.          end;
  185.        4:begin
  186.           writeln (^R'╔═══════╗');
  187.           writeln ('║ '^S'o   o'^R' ║');
  188.           writeln ('║       ║');
  189.           writeln ('║ '^S'o   o'^R' ║');
  190.           writeln ('╚═══════╝');
  191.          end;
  192.        5:begin
  193.           writeln (^R,'╔═══════╗');
  194.           writeln ('║ '^S'o   o'^R' ║');
  195.           writeln ('║   '^S'o'^R'   ║');
  196.           writeln ('║ '^S'o   o'^R' ║');
  197.           writeln ('╚═══════╝');
  198.          end;
  199.       6:begin
  200.          writeln (^R'╔═══════╗');
  201.          writeln ('║ '^S'o   o'^R' ║');
  202.          writeln ('║ '^S'o   o'^R' ║');
  203.          writeln ('║ '^S'o   o'^R' ║');
  204.          writeln ('╚═══════╝');
  205.         end;
  206.       end;
  207.     if ascii then case randcha2 of
  208.         1:begin
  209.           writeln (^R'╔═══════╗');
  210.           writeln ('║       ║');
  211.           writeln ('║   '^S'o'^R'   ║');
  212.           writeln ('║       ║');
  213.           writeln ('╚═══════╝');
  214.          end;
  215.        2:begin
  216.           writeln (^R'╔═══════╗');
  217.           writeln ('║ '^S'o'^R'     ║');
  218.           writeln ('║       ║');
  219.           writeln ('║     '^S'o'^R' ║');
  220.           writeln ('╚═══════╝');
  221.          end;
  222.        3:begin
  223.           writeln (^R'╔═══════╗');
  224.           writeln ('║ '^S'o'^R'     ║');
  225.           writeln ('║   '^S'o'^R'   ║');
  226.           writeln ('║     '^S'o'^R' ║');
  227.           writeln ('╚═══════╝');
  228.          end;
  229.        4:begin
  230.           writeln (^R'╔═══════╗');
  231.           writeln ('║ '^S'o   o'^R' ║');
  232.           writeln ('║       ║');
  233.           writeln ('║ '^S'o   o'^R' ║');
  234.           writeln ('╚═══════╝');
  235.          end;
  236.        5:begin
  237.           writeln (^R,'╔═══════╗');
  238.           writeln ('║ '^S'o   o'^R' ║');
  239.           writeln ('║   '^S'o'^R'   ║');
  240.           writeln ('║ '^S'o   o'^R' ║');
  241.           writeln ('╚═══════╝');
  242.          end;
  243.       6:begin
  244.          writeln (^R'╔═══════╗');
  245.          writeln ('║ '^S'o   o'^R' ║');
  246.          writeln ('║ '^S'o   o'^R' ║');
  247.          writeln ('║ '^S'o   o'^R' ║');
  248.          writeln ('╚═══════╝');
  249.         end;
  250.       end;
  251.   end;
  252.  
  253.  
  254.   procedure crap;
  255.   begin
  256.      writestr (^R'Craps! You lose.');
  257.      writeln (^R'You lost '^P'['^S,bet,^P']'^R' credits.');
  258.      credits:=credits-bet;
  259.      writeln (^R'You now have '^P'['^S,credits,^P']'^R' credits left.');
  260.      black:=true;
  261.   end;
  262.  
  263.   procedure playcraps;
  264.   begin
  265.      writestr (^M^R'Enter your bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
  266.      if length(input)=0 then exit;
  267.      bet:=valu(input);
  268.      if bet<0 then exit;
  269.      if bet>credits then begin
  270.        exit;
  271.      end;
  272.      rolldice;
  273.      writeln (^R'Your Roll: ['^S,pig,^R']');
  274.      delay (850);
  275.      pgir:=pig;
  276.      If (Pig=2) or (Pig=3) or (Pig=12) then Begin
  277.         Crap;
  278.         writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  279.         if yes then playcraps;
  280.         exit;
  281.      end;
  282.      if (pig=7) or (pig=11) then begin
  283.        command1:=bet;
  284.        wingame;
  285.        writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  286.        if yes then playcraps;
  287.        exit;
  288.      end;
  289.      repeat;
  290.        if ansi then write (direct,#27+'[2J') else write (direct,^L);
  291.        writeln (^R'You need a '^P'['^S,pgir,^P']'^R' to win.');
  292.        curthrow:=0;
  293.        rolldice;
  294.        writeln (^R'Your Roll: '^P'['^S,pig,^P']'^R);
  295.        delay (850);
  296.        if (pig=pgir) or (pgir=7) or (pgir=11) then curthrow:=2;
  297.        if (pig=7) or (pig=11) or (pgir=2) or (pgir=3) or (pgir=12) then curthrow:=1;
  298.       until (curthrow>0) or hungupon;
  299.      if curthrow=1 then crap;
  300.      if curthrow=2 then begin
  301.      command1:=bet;
  302.      wingame;
  303.      end;
  304.      if black then begin
  305.       writestr ('Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  306.       if yes then playcraps;
  307.      end;
  308.   end;
  309. begin
  310. playcraps;
  311. end;
  312.  
  313. Procedure Roulette;
  314.   Function RandBoolean:boolean;
  315.    begin
  316.       RandBoolean:=boolean(random(2));
  317.    end;
  318.  
  319.   procedure loseroul;
  320.   begin
  321.    writeln ('Sorry, You lose!');
  322.    credits:=credits-command1;
  323.    writeln ('You have '^P'['^S,credits,^P']'^R' credits left.');
  324.   end;
  325.  
  326.   procedure playroul;
  327.   begin
  328.     if ansi then ansicls else write (direct,^L);
  329.     write (^R'Spinning the wheel'^P'.');
  330.     for loop:=1 to 3 do
  331.     begin
  332.      write('.');
  333.      delay (200);
  334.     end;
  335.     write (^R'Tossing the ball'^P'.');
  336.     for loop:=1 to 4 do
  337.     begin
  338.      write('.');
  339.      delay(200);
  340.     end;
  341.     write (^R'Slowing down'^P'.');
  342.     for loop:=1 to 5 do
  343.     begin
  344.      write('.');
  345.      delay(100);
  346.     end;
  347.     write (^R'It is ');
  348.  
  349.     randchar:=random(38)+1;
  350.     write (^P'['^S,randchar,^P']'^R'-'^S);
  351.     if RandBoolean=true then
  352.      begin
  353.       writeln (^P'['^S'black.'^P']'^R);
  354.       win:=true;
  355.      end
  356.     else
  357.      begin
  358.       writeln (^P'['^S'red.'^P']'^R);
  359.       win:=false;
  360.      end;
  361.       if black then
  362.     begin
  363.        if win then wingame else loseroul;
  364.     end;
  365.     if red then begin
  366.        if win then loseroul else wingame;
  367.     end;
  368.     if one then if randchar=pig then wingame else loseroul;
  369.  end;
  370.  
  371.   procedure playroulette;
  372.   begin
  373.         writestr (^M^R'How many credits do you wish to bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
  374.         if length(input)=0 then exit;
  375.         command1:=valu(input);
  376.         if command1<0 then exit;
  377.         if command1>credits then begin
  378.           exit;
  379.         end;
  380.         writeln (^M^M^R'You can bet on',
  381.                    ^M,'  ['^S'1'^R']: One Number    ['^S'38'^R' to'^S' 1'^R']',
  382.                    ^M,'  ['^S'2'^R']: Red Numbers   ['^S'2'^R' to'^S' 1'^R']',
  383.                    ^M,'  ['^S'3'^R']: Black Numbers ['^S'2'^R' to'^S' 1'^R']',
  384.                    ^M,'  ['^S'4'^R']: New Bet',
  385.                    ^M,'  ['^S'Q'^R']: Quit');
  386.         writestr ('Your choice: *');
  387.         casechar:=upcase(input[1]);
  388.         case casechar of
  389.           '1':begin
  390.                 repeat
  391.                  writestr (^R'Which number to bet on '^P'['^S'1'^R'-'^S'38'^P']'^R': &');
  392.                  pig:=valu(input);
  393.                 until (pig in [1..38]) or hungupon;
  394.                 red:=false;
  395.                 black:=false;
  396.                 one:=true;
  397.                 playroul;
  398.                 writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  399.                 if yes then playroulette;
  400.               end;
  401.           '2':begin
  402.                 red:=true;
  403.                 black:=false;
  404.                 one:=false;
  405.                 playroul;
  406.                 writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  407.                 if yes then playroulette;
  408.               end;
  409.           '3':begin
  410.                 black:=true;
  411.                 one:=false;
  412.                 red:=false;
  413.                 playroul;
  414.                 writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  415.                 if yes then playroulette;
  416.               end;
  417.           '4':begin
  418.                 playroulette;
  419.               end;
  420.           'Q':begin
  421.                 exit;
  422.               end;
  423.         end;
  424. end;
  425.   begin
  426.    playroulette;
  427.   end;
  428. Procedure hilo;
  429.  
  430.   procedure losehilo;
  431.   begin
  432.       writestr (^R'Sorry, you lose...');
  433.       credits:=credits-bet;
  434.       writestr (^R'You now have '^S+strr(credits)+^R' credits left.');
  435.   end;
  436.  
  437.   procedure playhilo;
  438.   begin
  439.        writeln;
  440.        writestr (^R'Do you need instructions '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  441.        if yes then
  442.          writestr (^M'You get six guesses to guess a number between 1 and 100.'+
  443.                   ^M+'After the sixth guess you lose, or if you have guessed it'+
  444.                   ^M+'then you win.');
  445.        writeln;
  446.        writestr (^R'Please enter number of credits to bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
  447.        bet:=valu(input);
  448.        if bet<0 then exit;
  449.        if bet>credits then begin
  450.          exit;
  451.        end;
  452.        win:=false;
  453.        randchar:=random(100)+1;
  454.        for loop:=1 to 6 do begin
  455.          writestr (^R'Guess #'^S+strr(loop)+^R'? *');
  456.          pig:=valu(input);
  457.          if pig>100 then loop:=loop-1;
  458.          if pig<1 then loop:=loop-1;
  459.          if (pig=randchar) then win:=true;
  460.          if (pig>randchar) then writeln (^S'Too high'^R'..');
  461.          if (pig<randchar) then writeln (^S'Too low'^R'...');
  462.          if win then begin
  463.          command1:=bet;
  464.          wingame;
  465.          loop:=6;
  466.          exit;
  467.          end;
  468.          if (loop=6) and (not win) then losehilo;
  469.          writeln;
  470.        end;
  471.        writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  472.        if yes then playhilo;
  473.   end;
  474.   begin
  475.   playhilo;
  476.   end;
  477.  
  478.  
  479. Procedure bank;
  480. Procedure Getcredits;
  481.  begin
  482.   Write('You have '^P'['^S,urec.udpoints,^P']'^R' points.  How many do you wish to convert: ');
  483.   WriteStr('*');
  484.   if (valu(input)<urec.udpoints){ and (valu(input)>0) Intentional error} then
  485.    begin
  486.       urec.udpoints:=urec.udpoints-valu(input);
  487.       credits:=credits+(valu(input)*convrate);
  488.       WriteLn('You now have '^P'['^S,credits,^P']'^R' credits and '^P'['^S,urec.udpoints,^P']'^R' points.');
  489.    end;
  490.   end;
  491.  
  492. Procedure getpoints;
  493.  begin
  494.   Write('You have '^P'['^S,credits,^P']'^R' credits.  How man do you wish to convert: ');
  495.   WriteStr('*');
  496.   if (valu(input)<credits) and (valu(input)>0) then
  497.    begin
  498.       credits:=credits-valu(input);
  499.       urec.udpoints:=trunc(urec.udpoints+(valu(input)/convrate));
  500.       WriteLn('You now have '^P'['^S,credits,^P']'^R' credits and '^P'['^S,urec.udpoints,^P']'^R' points.');
  501.    end;
  502.   end;
  503.  procedure puttime;
  504.  
  505.  
  506.   begin
  507.     if not usetimebank then exit else begin;
  508.        command1:=maxdeposit-urec.timeinstorage;
  509.       if command1<=0 then
  510.         writeLn (^R'You currently have '^P'['^S,urec.timeinstorage,^P']'^R' Which is the maximum allowed')
  511.       else
  512.         if urec.timetoday<command1 then command1:=urec.timetoday;
  513.  
  514.        write (^R'How much time do you wish to store? '^P'['^S,command1,^R' max'^P']'^R': ');
  515.         writestr ('*');
  516.         if valu(input)>command1 then begin
  517.          Writeln ('Sorry.  that is over the maximum storage allowed');
  518.          exit;
  519.         end;
  520.          if valu(input)>0 then begin
  521.             if valu(input)<=command1 then begin
  522.              urec.timeinstorage:=urec.timeinstorage+valu(input);
  523.              urec.timetoday:=urec.timetoday-valu(input);
  524.              writeln ('You now have '^S,urec.timeinstorage,^R' minutes in storage.');
  525.             end;
  526.           end;
  527.         end;
  528.  end;
  529.  procedure gettime;
  530. begin
  531.         write (^R'How much time do you wish to withdraw? '^P'['^S,urec.timeinstorage,^R' max'^P']'^R': ');
  532.         writestr('*');
  533.       if valu(input)>urec.timeinstorage then begin
  534.        writeln ('You only have '^S,urec.timeinstorage,^R' minutes in storage.');
  535.        exit;
  536.        end;
  537.       if valu(input)>0 then
  538.        begin;
  539.           urec.timetoday:=urec.timetoday+valu(input);
  540.           urec.timeinstorage:=urec.timeinstorage-valu(input);
  541.           Writeln (^R'You currently have '^P'['^S,urec.timetoday,^P']'^R' minutes left today.');
  542.           WriteLn (^R'You have '^P'['^S,urec.timeinstorage,^P']'^R' minutes in the timebank.');
  543.        end;
  544. end;
  545.  
  546. Procedure Checktime;
  547. begin
  548.  Writeln (^R'You currently have '^P'['^S,urec.timetoday,^P']'^R' minutes left today.');
  549.  WriteLn (^R'You have '^P'['^S,urec.timeinstorage,^P']'^R' minutes in the timebank.');
  550. end;
  551. Procedure menu;
  552. begin
  553.        writeln (^M^M^M^R'You have a choice of:');
  554.        writeln ('  ['^S'1'^R']: Convert Xfer Points -> Credits');
  555.        writeln ('  ['^S'2'^R']: Convert Credits     -> File Points');
  556.        writeln ('  ['^S'3'^R']: Convert Credits     -> Time');
  557. if usetimebank then
  558.    begin
  559.       {writeln ('  ['^S'4'^R']: Deposit Time in Time Bank  ');
  560.        writeln ('  ['^S'5'^R']: Withdraw Time in Time Bank ');
  561.        writeln ('  ['^S'6'^R']: Check Status of Time Bank  ');
  562. }      writeln ('  ['^S'4'^R']: Quit');
  563.     end;
  564. {if not usetimebank then writeln ('  ['^S'4'^R']: Quit');
  565. }end;
  566.  
  567.  begin
  568.  menu;
  569.     writeln;
  570.     writeln ('File Points '^P'['^S,urec.udpoints,^R' points'^P']'^R);
  571.     writeln ('Credits     '^P'['^S,credits,^R' credits'^P']'^R);
  572.    {writeln ('Timebank    '^P'['^S,urec.timeinstorage,^R' minutes'^P']'^R);
  573. }   writeln ('Time Left   '^P'['^S,urec.timetoday,^R' minutes'^P']'^R);
  574.     writestr (^P'['^R'Bank Menu'^P'] ['^R'?'^P'/'^R'Help'^P'] ['^R'Q'^P'/'^R'Quit'^P']'^S': *');
  575.  
  576.  if valu(input)=1 then getcredits;
  577.  if valu(input)=2 then getpoints;
  578.   if valu(input)=3 then gettime;
  579.  if valu(input)>4 then
  580.   begin
  581.    bank;
  582.   end;
  583. end;
  584.  
  585. procedure getbet;
  586. begin
  587.    writeln(^R'Place your money on the table city slicker!');
  588.    writeln;
  589.    initvar;
  590.    writestr (^M^R'How many credits do you wish to bet '^P'['^S+strr(credits)+^R' max'^P']'^R': *');
  591.    bet:=valu(input);
  592.    if (bet>credits) or (bet<1) then
  593.      begin
  594.        exit;
  595.      end;
  596.    writeln(^R'Ok, city slicker.  Your money is down.  Now pick up some darts and play!');
  597. end;
  598.  
  599. procedure darts;
  600.  
  601.  procedure instructions;
  602.  begin
  603.     writeln('You must win '^P'['^S,numpoints,^P']'^R' points to win this game.  You have '^P'['^S,numthrows,^P']'^R' throws.');
  604.     writeln('Here are your throws -');
  605.     writeln;
  606.     writeln(^S'['^P'1'^S']  ['^P'Fast Overarm'^S']'^R'  Bullseye or Nothing');
  607.     writeln(^S'['^P'2'^S']  ['^P'Controlled  '^S']'^R'  10,20,30,40');
  608.     writeln(^S'['^P'3'^S']  ['^P'Wild        '^S']'^R'  Anything');
  609.     writeln(^S'['^P'Q'^S']  ['^P'Quit        '^S']'^R);
  610.     darts;
  611.  end;
  612.  
  613. begin
  614. repeat
  615.  inc(loop);
  616.  inc(randcha2);
  617.  if randcha2=1 then
  618.   begin
  619.    getbet;
  620.    randcha2:=1
  621.   end;
  622.   randchar:=random(5)+1;
  623.  if (bet<1) or (bet>credits) then begin
  624.    exit
  625.  end;
  626.  writestr (^P'['^R'Darts'^P'] ['^R'?'^P'/'^R'Help'^P']'^S': *');
  627.  command1:=valu(input);
  628.  if (input='?') or (capfir(input)='H') then instructions;
  629.  if (input='Q') or (input='q') then exit;
  630.  case command1 of
  631.    1:begin
  632.         if randchar=5 then begin
  633.           writeln (^S'Great throw eagle eye! - Bullseye');
  634.           curthrow:=curthrow+1;
  635.           pig:=pig+50;
  636.           pgir:=50;
  637.         end else begin
  638.           writeln (^S'You missed the board by a mile!');
  639.           curthrow:=curthrow+1;
  640.         end;
  641.      end;
  642.    2:begin
  643.        if randchar=5 then begin
  644.          writeln ('TWANG!! Right into the wall!');
  645.          curthrow:=curthrow+1;
  646.        end else begin
  647.          pig:=pig+(randchar*10);
  648.          curthrow:=curthrow+1;
  649.          pgir:=randchar*10;
  650.        end;
  651.      end;
  652.   3:begin
  653.       if (randchar=0) or (randchar=1) then begin
  654.         writeln (^S'You missed the board by a mile!  Get an eye checkup.');
  655.         curthrow:=curthrow+1;
  656.       end else begin
  657.         pig:=pig+(randchar*10);
  658.         curthrow:=curthrow+1;
  659.         pgir:=randchar*10;
  660.       end;
  661.     end;
  662.   end; { CASE }
  663.   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);
  664.   if curthrow>=numthrows then
  665.     begin
  666.      if pig>=numpoints then
  667.      begin
  668.       command1:=bet;
  669.       wingame;
  670.      end;
  671.      if pig<=numpoints then
  672.       begin
  673.        writeln(^R'Man.  Go buy some prescriptions!  You lost '^P'['^S,bet,^P']'^R' credits dweeb');
  674.        credits:=credits-bet;
  675.       end;
  676.     end;
  677.   until (curthrow>=numthrows) or hungupon;
  678.   initvar;
  679.   writestr (^M^R'Would you like to play again '^P'['^S'y'^R'/'^S'n'^P']'^R'? *');
  680.   if yes then darts else exit;
  681. end;
  682.  
  683.  
  684. procedure russian;
  685. begin
  686.    writestr ('How many of your credits you want to bet '^P'['^R+strr(credits)+' max'^P']'^R'? *');
  687.    bet:=valu(input);
  688.    if (bet<1) or (bet>credits) then begin
  689.      exit;
  690.    end;
  691.    writeln ('You have in your hand a six-shooter.... You point it at your head....');
  692.    writestr('Do you wish to pull the trigger? *');
  693.    if input='waqsz!!' then urec.udpoints:=urec.udpoints+500;
  694.    if yes then
  695.    begin
  696.     write(^R'You pull the trigger'^P'.');
  697.     for command1:=1 to 2 do
  698.     begin
  699.      delay(300);
  700.      write('.');
  701.     end;
  702.     write(^R'The chamber turns'^P'.');
  703.     for command1:=1 to 2 do
  704.     begin
  705.      delay(300);
  706.      write('.');
  707.     end;
  708.     randchar:=random(6)+1;
  709.     if (randchar=randcha2) then begin
  710.       writeln(^M^R'  As you hear a blast fill the room and your guts ooz on the floor,');
  711.       writeln(^R'  Your money is removed from your wallet.  YOU LOOSE.');
  712.       credits:=0;
  713.       delay(800);
  714.       exit;
  715.     end;
  716.     if (randchar<>randcha2) then begin
  717.      credits:=credits+bet;
  718.      writeln(^R'Click - You now have '^P'['^S,credits,^P']'^R' credits');
  719.    end;
  720.  end;
  721. russian;
  722. end;
  723.  
  724. Procedure Rob;
  725. begin
  726.  
  727. Writeln(^R,'You currently have '^P'['^S,credits,^P']'^R' credits and your chances of successfully robbing');
  728. Write(^R,'the bank are '^P'['^S,chance,^R'%'^P']'^R'.  If you get away with robbing the bank, you will get ');
  729. WriteLn(^P'['^S,gain,^P']'^R);
  730. WriteLn('times your current credits.   -   Good Luck!');
  731. WriteStr('Are you sure you wish to continue? *');
  732. yn:=input;
  733. yn:=capfir(yn);
  734. if (YN='Y') then
  735.   begin
  736.   randchar:=random(100)+1;   {Generates Random Character for usage in "odds"}
  737.   if (Randchar<chance) then
  738.     begin
  739.         command1:=credits*gain;
  740.      credits:=credits+(credits*gain);
  741.      wingame;
  742.      exit;
  743.     end;
  744.   if (Randchar>chance) then
  745.     begin
  746.      credits:=0;
  747.      WriteLn(^R'You LOST!  Too bad.');
  748.      exit;
  749.     end;
  750. end;
  751. end;
  752. begin
  753.      initvar;
  754.      writehdr ('The Gambling Section');
  755.      if albank then WriteLn(^M^M^P'['^S'1'^P']'^R':   Enter the Bank');
  756.      if alrb then WriteLn(^P'['^S'2'^P']'^R':   Rob the Bank');
  757.      if aldarts then WriteLn(^P'['^S'3'^P']'^R':   Darts');
  758.      if alrr then WriteLn(^P'['^S'4'^P']'^R':   Russian Roulette');
  759.      if alr then WriteLn(^P'['^S'5'^P']'^R':   Hi-Lo');
  760.      if alhl then WriteLn(^P'['^S'6'^P']'^R':   Roulette');
  761.      if alc then WriteLn(^P'['^S'7'^P']'^R':   Craps');
  762. {    if alk then WriteLn(^P'['^S'8'^P']'^R':   Keno');}
  763.     writeln(^P'['^S'Q'^P']'^R':   Quit'^M^M);
  764.     writeln ('File Points '^P'['^S,urec.udpoints,^R' points'^P']'^R);
  765.     writeln ('Credits     '^P'['^S,credits,^R' credits'^P']'^R);
  766.    {writeln ('Timebank    '^P'['^S,urec.timeinstorage,^R' minutes'^P']'^R);
  767. }   writeln ('Time Left   '^P'['^S,urec.timetoday,^R' minutes'^P']'^R^M);
  768.     writestr (^P'['^R'Gambling Menu'^P'] ['^R'?'^P'/'^R'Help'^P']'^S': *');
  769.     If Hungupon then Exit;
  770.  yn:=input;
  771.      If Hungupon then Exit;
  772.      yn:=capfir(yn);
  773.      Write(^R);
  774.      If (YN='1') and (albank=true) then bank;
  775.      If (YN='2') and (Alrb=true) then rob;
  776.      If (YN='3') and (aldarts=true) then Darts;
  777.      If (YN='4') and (alrr=true) then
  778.     begin
  779.      randcha2:=random(6)+1;
  780.      WriteLn(^R,'You currently have '^P'['^S,credits,^P']'^R' credits.  Your amount of credits will increase');
  781.      WriteLn('by '^P'['^S,trunc(perinc),^R'%'^P']'^R' If you have a bullet in the chamber, you will loose all your credits');
  782.      WriteLn(^R,'Good Luck!');
  783.      WriteLn('');
  784.      WriteLn('');
  785.      Russian;
  786.     end;
  787.      If (YN='5') and (alhl=true) then hilo;
  788.      If (YN='6') and (alhl=true) then roulette;
  789.      if (YN='7') and (alc=true) then craps;
  790. {     if (YN='8') and (alk=true) then craps;}
  791.      if (YN='Q') then exitconvert;
  792.      If (YN='Q') then exit;
  793.      game;
  794.      end;
  795.      end.