synchro.net/synchro.net.tar/synchro.net/main/BBS/MC.ZIP/MC3.PAS

Pascal/Delphi Source File | 1988-05-06 | 18.5 KB | 578 lines

{                             Milliways Casino                               }
{                  Copyright (C) 1987 by Charles Ezzell & Matthew Warner     }
{                            All Rights Reserved                             }
{                                                                            }
{                                                                            }
overlay procedure twenty_one;
type
  handset = array[1..12] of integer;
  cards = array[1..52] of integer;
var
  new_hand, gameover, strangers_hand_done, player_hand_done,
  strangers_blackjack, player_blackjack, dealer_blackjack,
  strangers_done,      player_done,      dealer_done,
  strangers_double,    player_double,
  strangers_insurance, player_insurance,
  strangers_busted,    player_busted,    dealer_busted : boolean;

  cardcnt,
  strangers_cards, player_cards, dealer_cards,
  scardval,       pcardval,     dcardval : integer;

  player_payoff,   player_amount,   player_bet,
  strangers_payoff, strangers_amount, strangers_bet:real;

  min, max : integer;

  min_name, max_name, sst, st, ss : str;
  cha : char;
  card : cards;
  strangers_hand, player_hand, dealer_hand : handset;
  cvalue : array[1..13] of string[20];
  csuit  : array[1..4] of string[10];

procedure twenty1_init;
begin
  csuit[1]:='Hearts';csuit[2]:='Diamonds';csuit[3]:='Spades';csuit[4]:='Clubs';
  cvalue[1]:='Ace'; cvalue[2]:='Two'; cvalue[3]:='Three'; cvalue[4]:='Four';
  cvalue[5]:='Five'; cvalue[6]:='Six'; cvalue[7]:='Seven'; cvalue[8]:='Eight';
  cvalue[9]:='Nine'; cvalue[10]:='Ten'; cvalue[11]:='Jack';
  cvalue[12]:='Queen'; cvalue[13]:='King';
  cardcnt := 53;
end;

procedure twenty1_welcome;
var cha : char;
begin
  print('Welcome to the Blackjack Room.');
  nl;
  print('There are 3 empty seats around the room.'+#13+#10);
  print('You notice that each of them are at different tables,');
  print('each one having different betting limits.'+#13+#10);
  nl;
  print('Table 1 :     $10 - $500');
  print('Table 2 :    $100 - $1,000');
  print('Table 3 :    $500 - $10,000');
  nl;
  prompt('Which table do you sit at? (1-3) ');
  onek(cha,'123');
  case cha of
    '1' : begin
            min:=10; max:=500;
            min_name:='$10'; max_name:='$500';
          end;
    '2' : begin
            min:=100; max:=1000;
            min_name:='$100'; max_name:='$1,000';
          end;
    '3' : begin
            min:=500; max:=10000;
            min_name:='$500'; max_name:='$10000';
          end;
  end;
end;

procedure shuffle (var card : cards);
var i, x : integer;
    count : integer;
    used : array[1..52] of boolean;
begin
  checkhangup; if hangup then leave;
  prompt ('shuffling...');
  for i := 1 to 52 do
   used[i] := false;
  count := 52;
  while (count > 0) do begin
    repeat
      x := round(random * 52 + 0.5);
    until not used[x];
    card[count] := x;
    used[x] := true;
    count := count - 1;
  end;
  st := #8+#8+#8+#8+#8+#8+#8+#8+#8+#8+#8+#8;
  prompt (st+'            '+st);
  prompt (#13+#10+#13+#10);
end;

procedure showcard (hand : handset; inhand:integer; showit:boolean);
var i, j, x, y, c, s : integer;
    cv : str;
begin
  for i := 1 to inhand do begin
    checkhangup; if hangup then leave;
    x := hand[i] - 1;
    c := x mod 13 + 1;
    s := x div 13 + 1;
    if showit or (i <> 2) then begin
      cv:=cvalue[c]+' of '+csuit[s]
    end else begin
      cv := 'HIDDEN CARD';
    end;
    print(cv);
  end;
end;

function dealcard:integer;
begin
  cardcnt := cardcnt + 1;
  if (cardcnt > 35) and new_hand then begin
    shuffle (card);
    cardcnt := 1;
  end;
  dealcard := card[cardcnt];
end;

function handvalue (hand:handset; cardcount:integer) : integer;
var i, x, y, ace : integer;
begin
  x:=0;
  ace:=0;
  for i:=1 to cardcount do begin
    y:=(hand[i]-1) mod 13 + 1;
    if y>10 then y:=10;
    if y=1 then begin
      y:=11;
      ace:=ace+1;
    end;
    x:=x+y;
  end;
  while (x>21) and (ace>0) do begin
    x:=x-10;
    ace:=ace-1;
  end;
  if x>21 then x:=0;
  if (cardcount=2) and (x=21) then x:=22;
  handvalue:=x;
end;

procedure stranger_bets;
var temp:str;
    test, temp_max:integer;
begin
  strangers_bet:=0.0;
  if player[0].strangers_money<min then strangers_gets_more_money;
  temp_max:=max div 2;
  repeat
    strangers_bet:=random(temp_max);
    test:=round(strangers_bet);
  until (strangers_bet>min) and (test mod 100 = 0);
  if random(10)+1>5 then strangers_bet:=strangers_bet+temp_max;
  str(strangers_bet:0:0,temp);
  temp:=format_money(temp,false);
  if strangers_bet>player[0].strangers_money then strangers_gets_more_money;
  print('The stranger bets '+temp+'.');
  nl;pausescr;
end;

procedure get_bet_21;
var temp : str;
    test, error: integer;
begin
  player_bet:=0.0;
  check_winnings;
  check_random;
  repeat
    checkhangup; if hangup then leave;
    print('The dealer tells you to place your bet.');
    print('('+min_name+'-'+max_name+')');
    print('(0 to quit)');
    print('(S for stats)');nl;
    prompt('How much are you betting? ');
    input(temp,6);
    if (temp<>'B') and (temp<>'S') and (temp<>'0')then begin
      val(temp,player_bet,error);
      if (error<>0) or (player_bet<min) or (player_bet>max) then print('Illegal amount')
    end else if temp='S' then player_stats;
    if temp='0' then gameover:=true;
    if not gameover then
     if frac(player_bet/10) <> 0.0 then begin
       nl;
       print('The dealer looks down at you and says:');
       print(thisuser.name+', all bets must be in multiples of 10.');
       print('Please redo your bet.');
       nl;nl;
    end;
  until gameover or (player_bet>=min) and (player_bet<=max)and (frac(player_bet/10)=0.0);
  if not gameover then begin
    temp_money := player[pn].players_money-player_bet;
    if temp_money<0 then sell_to_bruno;
    nl;
    if not stranger_dates_kathy then stranger_bets;
  end;
end;

procedure deal_first_cards;
begin
  new_hand:=true;
  if not stranger_dates_kathy then strangers_hand[1]:=dealcard;
  player_hand[1]:=dealcard;
  dealer_hand[1]:=dealcard;
  if not stranger_dates_kathy then strangers_hand[2]:=dealcard;
  player_hand[2]:=dealcard;
  dealer_hand[2]:=dealcard;
  if not stranger_dates_kathy then strangers_cards:=2;
  dealer_cards:=2;
  player_cards:=2;
  new_hand:=false;
end;

procedure stranger_hand;
var choice:char;
    test_num:integer;
begin
  strangers_done:=false;
  strangers_payoff:=1.0;
  choice:=' ';
  repeat
    nl;print('Strangers Hand:');
    showcard(strangers_hand,strangers_cards,true);
    scardval:=handvalue(strangers_hand,strangers_cards);
    if (scardval>0) and (scardval<22) then begin
      str(scardval,sst);
      print('The stranger has: '+sst);
    end;
    if scardval=0 then begin
      print('The stranger busted!');
      strangers_hand_done:=true;
      strangers_done:=true;
      strangers_busted:=true;
      pausescr;
    end;
    if choice='D' then strangers_done:=true;
    if not strangers_done then begin
      test_num:=random(100)+1;
      if (scardval>9) and (scardval<12) and (strangers_cards=2) and
       (test_num>20) then choice:='D';
      if choice<>'D' then begin
        case scardval of
           1..11 : choice:='H';
          12..14 : if test_num<50 then choice:='H' else choice:='S';
          15..16 : if test_num<25 then choice:='H' else choice:='S';
          17..21 : choice:='S';
        end;
      end;
      case choice of
        'H' : begin
                print('The stranger takes another card.');
                strangers_cards:=strangers_cards+1;
                strangers_hand[strangers_cards]:=dealcard;
                strangers_done:=false;
              end;
        'S' : begin
                str(scardval,sst);
                print('The stranger stands with '+sst+'.');
                strangers_done:=true;
              end;
        'D' : begin
                print('The stranger doubles his bet.');
                strangers_cards:=strangers_cards+1;
                strangers_hand[strangers_cards]:=dealcard;
                strangers_done:=false;
                strangers_payoff:=2.0;
              end;
      end;
      pausescr;
    end;
  until strangers_done;
  nl;
end;

procedure players_hand;
var test_num:integer;
begin
  checkhangup; if hangup then leave;
  strangers_double:=false;
  player_double:=false;
  cha:=' ';
  dcardval:=handvalue(dealer_hand,dealer_cards);
  pcardval:=handvalue(player_hand,player_cards);
  if not stranger_dates_kathy then
   scardval:=handvalue(strangers_hand,strangers_cards)
    else begin
      scardval:=99;
      strangers_hand_done:=true;
    end;
  print('Dealers Hand');
  showcard(dealer_hand,dealer_cards,false);nl;
  if (scardval=22) or (pcardval=22) or (((dealer_hand[1]-1) mod 13)=0) then begin
    if scardval=22 then begin
      print('Strangers Hand');
      showcard(strangers_hand,strangers_cards,true);nl;
      print('The stranger has BLACKJACK!');
      strangers_hand_done:=true;
      strangers_blackjack:=true;
      strangers_payoff:=1.5;
    end;
    if not strangers_hand_done then begin
      print('Strangers Hand');
      showcard(strangers_hand,strangers_cards,false);nl;
    end;
    pausescr;
    nl;
    if pcardval=22 then begin
      print('Your Hand');
      showcard(player_hand,player_cards,true);nl;
      print('You have BLACKJACK!');
      player_payoff:=1.5;
      player_hand_done:=true;
      player_blackjack:=true;
      pausescr;
    end;
    if (not player_hand_done) or (not strangers_hand_done) then
     if ((dealer_hand[1]-1) mod 13)=0 then begin
      if not player_hand_done then begin
        str(pcardval,st);
        print('Your Hand');
        showcard(player_hand,player_cards,true);nl;
        print('You have '+st);
        pausescr;
      end;
      nl;
      print('The dealer may have blackjack.');
      test_num:=random(10)+1;
      if (not strangers_hand_done) then
       if test_num>=8 then begin
         print('The stranger takes insurance.');
         strangers_insurance:=true;
      end else print('The stranger does not take insurance.');
      nl;
      if not player_hand_done then begin
        prompt('Do you wish insurance? ');
        onek(cha,'YN');
        if cha='Y' then player_insurance:=true;
      end;
      if dcardval=22 then begin
        nl;
        print('The dealer has blackjack!');
        player_hand_done:=true;
        dealer_blackjack:=true;
        strangers_hand_done:=true;
        pausescr;
      end else print('The dealer does not have blackjack.');
    end;
  end;
  if (not strangers_hand_done) and (scardval<>99) then stranger_hand;
  if not player_hand_done then begin
    player_payoff:=1.0;
    player_done:=false;
    repeat
      checkhangup; if hangup then leave;
      print (#13+#10+'your hand:');
      showcard (player_hand,player_cards,true);
      pcardval := handvalue (player_hand,player_cards);
      if (pcardval > 0) and (pcardval < 22) then begin
        str (pcardval,st);
        print ('You have: '+st);
      end;
      if pcardval=0 then begin
        print('You busted!');
        player_done:=true;
        player_busted:=true;
      end;
      if cha='D' then player_done:=true;
      if not player_done then begin
        if (pcardval>9) and (pcardval<12) and (player_cards=2)
         then player_double:=true else player_double:=false;
        prompt ('H)it S)tand ');
        if player_double then prompt ('D)ouble ');
        prompt ('[H/S');
        if player_double then prompt ('/D');
        prompt ('] : ');
        st := 'HS';
        if player_double then st := st + 'D';
        onek (cha,st);
        prompt (#13+#10);
        case cha of
          'H' : begin
                  print ('You take another card.');
                  player_cards := player_cards + 1;
                  player_hand[player_cards] := dealcard;
                  player_done := false;
                end;
          'S' : begin
                  str (pcardval,st);
                  print ('You stand pat with '+st+'.');
                  player_done := true;
                end;
          'D' : begin
                  print ('You double your bet.');
                  player_cards := player_cards + 1;
                  player_hand[player_cards] := dealcard;
                  player_done := false;
                  player_payoff := 2.0;
                end;
        end;
      end;
    until player_done;
  end;
end;

procedure dealers_hand;
begin
  dealer_done:=false;
  if ((pcardval<>22) or (scardval<>22))
   and ((pcardval<>0) or (scardval<>0))
    and ((not player_hand_done) or (not strangers_hand_done)) then
   repeat
     checkhangup; if hangup then leave;
     print (' ');
     showcard (dealer_hand,dealer_cards,true);
     dcardval := handvalue (dealer_hand,dealer_cards);
     if (dcardval=0) then begin
       print ('Dealer goes *** BUST ***');
       dealer_done:=true;
       dealer_busted:=true;
     end else begin
       prompt ('Dealer has ');
       if dcardval=22 then st:='BLACKJACK' else str(dcardval,st);
       print (st);
       if (dcardval < 17) then begin
         print ('dealer takes a hit.');
         dealer_cards := dealer_cards + 1;
         dealer_hand[dealer_cards] := dealcard;
         dealer_done := false;
       end else begin
         print ('dealer stands pat.');
         dealer_done := true;
       end;
     end;
     pausescr;
   until dealer_done;
   nl;
end;

procedure process_hands;
var player_won,strangers_won,player_push,strangers_push:boolean;
begin
  checkhangup; if hangup then leave;
  player_won:=false;strangers_won:=false;
  player_push:=false;strangers_push:=false;

  {look for winning hands}
  if (pcardval>dcardval) or player_blackjack then player_won:=true;
  if scardval<>99 then
   if (scardval>dcardval) or strangers_blackjack then strangers_won:=true;

  { PROCESS STRANGERS HAND }
  if not stranger_dates_kathy then
   if strangers_won then begin
    print('The stranger wins his hand!');
    if strangers_insurance then begin
      print('However, he losses his insurance money.');
      strangers_payoff:=strangers_payoff-0.5;
    end;
  end else begin
    if (scardval=dcardval) and not strangers_blackjack
     and not strangers_busted then strangers_push:=true;
    if strangers_push then begin
      print('The stranger and dealers hands push.');
      if strangers_insurance then begin
        print('However, he losses his insurance money.');
        strangers_payoff:=-0.5;
      end else strangers_payoff:=0.0;
    end else begin
      print('The stranger loses.');
      strangers_payoff:=-strangers_payoff;
      if dealer_blackjack and strangers_insurance then begin
        print('The stranger''s insurance protects him from blackjack,');
        print('but he loses his insurance money.');
        strangers_payoff:=strangers_payoff+0.5;
      end else if (not dealer_blackjack) and player_insurance then begin
        print('The stranger loses both his bet and insurance.');
        strangers_payoff:=strangers_payoff-0.5;
      end;
    end;
  end;

  { PROCESS PLAYER'S HAND }
  if player_won then begin
    print ('You win your hand!');
    if player_insurance then begin
      print('However, you lose your insurance money.');
      player_payoff:=player_payoff-0.5;
    end;
  end else begin
    if (pcardval=dcardval) and not player_blackjack
     and not player_busted then player_push:=true;
    if player_push then begin
      print ('Your Hands push. No win or loss.');
      if player_insurance then begin
        print('However, you lose your insurance money.');
        player_payoff:=-0.5;
      end else player_payoff:=0.0;
    end else begin
      print ('You lose.');
      player_payoff := -player_payoff;
      if dealer_blackjack and player_insurance then begin
        print ('Insurance protects you from blackjack.');
        print ('(You lose your insurance money though.)');
        player_payoff:=player_payoff+0.5;
      end else if (not dealer_blackjack) and player_insurance then begin
        print('You lose your bet and insurance');
        player_payoff:=player_payoff-0.5;
      end;
    end;
  end;
  player_amount := player_bet * player_payoff;
  player[pn].players_money:=player[pn].players_money + player_amount;
  player[pn].won_today:=player[pn].won_today+player_amount;
  str (abs(player_amount):0:0,st);st:=format_money(st,false);
  if not stranger_dates_kathy then begin
    strangers_amount:=strangers_bet*strangers_payoff;
    player[0].strangers_money:=player[0].strangers_money+strangers_amount;
    str(abs(strangers_amount):0:0,sst);sst:=format_money(sst,false);
    if strangers_amount<>0.0 then begin
      prompt(sst);
      if strangers_amount>0.0 then prompt(' added to') else prompt(' subtracted from');
      print(' the strangers bankroll.');
    end;
  end;
  if player_amount <> 0.0 then begin
    prompt (st);
    if player_amount > 0.0 then prompt (' added to') else prompt (' subtracted from');
    print (' your bankroll.');
    nl;
  end;
  if player_amount>0 then player[0].jackpot:=player[0].jackpot-player_amount*0.05
   else player[0].jackpot:=player[0].jackpot+player_bet* 0.10;
  pausescr;
end;

begin
  checkhangup; if hangup then leave;
  twenty1_init;
  twenty1_welcome;
  gameover := false;
  prompt('You take your seat');
  if not stranger_dates_kathy then begin
    print(', and notice');
    print('the stranger sitting to your right');
    print('surrounded by his girls.');
  end else print('.');
  repeat
    tleft;
    player_payoff:=1.0;strangers_payoff:=1.0;
    player_insurance:=false;strangers_insurance:=false;
    player_done:=false;strangers_done:=false;
    player_hand_done:=false;strangers_hand_done:=false;
    strangers_blackjack:=false; dealer_blackjack:=false; player_blackjack:=false;
    strangers_busted:=false; dealer_busted:=false; player_busted:=false;
    checkhangup; if hangup then leave;
    if player[pn].bruno>0 then buy_from_bruno;
    str(player[pn].players_money:0:0,st);str(player[0].strangers_money:0:0,sst);
    st:=format_money(st,false);sst:=format_money(sst,false);
    nl;
    if not stranger_dates_kathy then print('The stranger has '+sst+'.');
    print('You have '+st+'.');
    checkhangup; if hangup then leave;
    get_bet_21;
    if not gameover then begin
      deal_first_cards;
      players_hand;
      dealers_hand;
      process_hands;
    end;
  until gameover or hangup
end; {end twenty_one}