home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SYSPC22.ZIP / MYCOMMAN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-24  |  3.5 KB  |  161 lines
  1. overlay procedure mycommand;
  2.  
  3. var point,winlose,points,money,bet,die1,die2,dice:integer;
  4.  quit:boolean;
  5.  
  6. procedure rolldice;
  7. begin
  8.  die1:=random(6)+1;
  9.  die2:=random(6)+1;
  10.  dice:=die1+die2;
  11. end;
  12.  
  13. procedure cash;
  14. begin
  15.  writeln;
  16.  writeln ('You now have ',money,' dollars.');
  17. end;
  18.  
  19. procedure getbet;
  20. begin
  21. quit:=false;
  22.  repeat
  23.   repeat
  24.    write ('What is your bet for this round(0=end)? ');
  25.    getstr;
  26.    bet:=valu(input);
  27.    if bet=0 then quit:=true;
  28.    if bet=0 then bet:=money;
  29.   until (bet<money+1) or (bet=0);
  30.  until (bet>0) or quit;
  31.  if quit then writeln ('Had enough I guess...') else
  32.   writeln ('OK, you just bet ',bet,' dollars!');
  33. end;
  34.  
  35. procedure craps;
  36. begin
  37.  writeln ('Craps! You lose sucker...');
  38.  money:=money-bet;
  39. end;
  40.  
  41. procedure win;
  42. begin
  43.  writeln ('We have a winner!');
  44.  money:=money+bet;
  45. end;
  46.  
  47. procedure intro;
  48. begin
  49.  writeln ('You are now entering the realm of Craps.');
  50.  writestr ('Do you wish instructions? *');
  51.  if yes then printfile ('crapsins');
  52. end;
  53.  
  54. procedure pointstomoney;
  55. begin
  56.  repeat
  57.   writeln ('You have ',urec.udpoints,' file points.');
  58.   writeln ('How much would you like to convert to Cash?');
  59.   getstr;
  60.   points:=valu(input);
  61.  until (points<=urec.udpoints) or (points=0) or hungupon;
  62.  
  63.  if points>3 then writeln (^B' Maximum stake is 3 points! ');
  64.  if points>3 then exit;
  65.  if money>150 then writeln (^B' Maximum Cash stake is 150');
  66.  if money>150 then exit;
  67.  if points>0 then money:=money+(points*50);
  68.  if points>0 then urec.udpoints:=urec.udpoints-points;
  69.    writeln ('You now have ',urec.udpoints,' file points.');
  70.  
  71. end;
  72.  
  73. procedure moneytopoints;
  74. begin
  75.  writeln ('Converting your CASH to points!');
  76.  Writeln ('You have ',money,' Money!. ');
  77.  urec.udpoints:=urec.udpoints+money div 50;
  78.  Writeln ('You now have ',urec.udpoints,' Points');
  79.  money:=0;
  80. end;
  81.  
  82. procedure convert;
  83.  
  84. begin
  85.  writeln ('Money Conversion!');
  86.  writeln ('P] Points to money ');
  87.  writeln ('C] Change money to points ');
  88.  writeln ('Q] Quit');
  89.  repeat
  90.   q:=menu ('Bank','BANK','QPC');
  91.   writeln;
  92.    case q of
  93.     1:;
  94.     2:pointstomoney;
  95.     3:moneytopoints;
  96.    end
  97.   until (q=1) or hungupon;
  98. end;
  99.  
  100. procedure crapsgame;
  101. var winlose:integer;
  102. begin
  103.  intro;
  104.  quit:=false;
  105.  if money>0 then
  106.  begin
  107.   repeat
  108.    cash;
  109.    bet:=0;
  110.    getbet;
  111.    if not quit then
  112.    begin
  113.     write ('Now rolling your point:');
  114.     rolldice;
  115.     writeln ('It''s a:',dice);
  116.     winlose:=0;
  117.     if dice=7 then winlose:=2;
  118.     if dice=11 then winlose:=2;
  119.     if winlose=2 then win else begin
  120.      point:=dice;
  121.      writeln ('OK, you''ve made it this far, now try and get another ',dice,' to win!');
  122.       begin
  123.        repeat
  124.         winlose:=0;
  125.         rolldice;
  126.         writeln ('You got a ',dice);
  127.         if dice=7 then winlose:=1;
  128.         if dice=11 then winlose:=1;
  129.         if dice=point then winlose:=2;
  130.        until (winlose>0) or hungupon;
  131.       end;
  132.       if winlose=2 then win;
  133.       if winlose=1 then craps;
  134.      end;
  135.    end;
  136.   if money<1 then quit:=true;
  137.   until quit or hungupon;
  138.  end;
  139.  if money<1 then writeln ('That''s too bad, you''re out of cash! Try going to the bank!');
  140.  writeln ('Thanks you for playing Craps.');
  141. end;
  142.  
  143.  
  144. begin
  145.  money:=0;
  146.  writeln (^B'Now entering the Gambling section!');
  147.  writeln ('C] Play Craps! ');
  148.  writeln ('B] Go to the BANK. ');
  149.  writeln ('Q] Quit');
  150.  repeat
  151.   q:=menu ('Game','GAME','CBQ');
  152.   writeln;
  153.   case q of
  154.    1:crapsgame;
  155.    2:convert;
  156.    3:;
  157.   end
  158.  until (q=3) OR HUNGUPON;
  159.  moneytopoints;
  160. end;
  161.