SRL Archive - News and General

i got bored and made this :p
tell me what you think and i hope it keeps you amused for a few mins.

program new;
{
1 = ace
11 = jack
12 = queen
13 = king
}
  Type
    TCard = record
    Suite:Char;
    Number:Integer;
  end;
var
  Deck: Array [1..52] of TCard;
  DeckI, YourScore, HouseScore: Integer;

function Card(suite: Char; Number: Integer):TCard;
begin
  result.Suite := Suite;
  Result.number := number;
end;

Procedure generateDeck;
var
  I, II: integer;
  s: Char;
begin
  for I := 1 to 4 do
  begin
    case I of
      1: s := 'h';
      2: s := 'd';
      3: S := 'c';
      4: S := 's';
    end;
    for II := 1 to 13 do
    begin
      Deck[((I-1)*13)+II] := Card(S, II);
    end;
  end;
end;


procedure suffledeck;
var
  TDeck: Array [1..52] of TCard;
  I, T: Integer;
  Done: Boolean;
begin
  for I := 1 to 52 do
  begin
    done := false;
    repeat
      T := (Random(52)+1);
    //  writeln(T);
      if TDeck[T].Number = 0 then
      begin
      //  writeln(I);
        TDeck[T] := Deck[I];
        done := true;
      end;
    until done;
  end;
  for I := 1 to 52 do Deck[I] := TDeck[I];
end;

procedure WriteCard( Card: TCard);
var
  Suite: String;
  Name: String;
begin
  case Card.Suite of
    's': Suite := 'Spades';
    'd': Suite := 'Diamonds';
    'h': Suite := 'Hearts';
    'c': Suite := 'Clubs';
  end;
  case Card.Number of
    1: Name := 'Ace';
    2..10: Name := IntToStr(Card.Number);
    11: Name := 'Jack';
    12: Name := 'Queen';
    13: Name := 'King';
  end;
  Writeln(Name + ' of ' + Suite);
end;

Procedure WriteTable(YourCards, DealersCards: Array of TCard; ShowDealers: Boolean);
var
  I: Integer;
begin
  ClearDebug;
  Writeln('your Cards:');
  for I := 0 to high(YourCards) do
    WriteCard(YourCards[I]);
  Writeln('');
  Writeln('Dealers cards:');
  if not ShowDealers then
  begin
    writeCard(Deck[3]);
    Writeln('**********');
  end else
  begin
    for I := 0 to high(DealersCards) do
      WriteCard(DealersCards[I]);
  end;
end;

procedure AddToHand( Card: TCard; var Hand: Array of TCard);
begin
  setArrayLength(Hand, High(Hand)+2);
 // writeln(High(Hand));
  Hand[High(Hand)] := Card;
end;

function HandValue(Hand: Array of TCard):Integer;
var
  I: Integer;
  Ace: Boolean;
begin
  result := 0;
  for I := 0 to High(Hand) do
  begin
    case Hand[I].Number of
      1: if Ace then IncEx(Result, 1) else Ace := True; //if we already have 1 ace 2 will put us over 21
      2..10: IncEx(Result, Hand[i].Number);
      11..13: IncEx(Result, 10);
    end;
  end;
  if ace then
    if (Result + 11) > 21 then IncEx(Result, 1) else IncEx(Result, 11);
end;

procedure Deal;
var
  I, D5: Integer;
  YourCards, DealersCards:Array of TCard;
  fin: Boolean;
begin
  YourCards := [Deck[1], Deck[2]];
  DealersCards := [Deck[3], Deck[4]];
  if HandValue(YourCards) = 21 then
  begin
    WriteTable(YourCards, DealersCards, True);
    writeln('');
    Writeln('Blackjack! you win');
    inc(yourScore);
    exit;
  end;
  for DeckI := 5 to 8 do
  begin
    WriteTable(YourCards, DealersCards, False);
    case MessageBox('Hit?', 'Hit or stand?', 4) of
      6: AddToHand(Deck[DeckI], YourCards); //yes
      7: fin := true;//no
    end;
    if fin then Break;
    if HandValue(YourCards) > 21 then
    begin
      WriteTable(YourCards, DealersCards, True);
      Writeln('');
      Writeln('Sorry you are bust');
      inc(HouseScore);
      exit;
    end;
  end;
  if DeckI = 8 then
  begin
    WriteTable(YourCards, DealersCards, True);
    writeln('');
    Writeln('5 Cards you win!');
    inc(yourScore);
    exit;
  end;
  D5 := DeckI + 3;
  While HandValue(DealersCards) < 16 do
  begin
    AddToHand(Deck[DeckI], DealersCards);
    Inc(DeckI);
    if DeckI = D5 then
    begin
      WriteTable(YourCards, DealersCards, True);
      writeln('');
      Writeln('Dealer got 5 cards, you lose');
      inc(HouseScore);
      exit;
    end;
  end;
  WriteTable(YourCards, DealersCards, True);
  writeln('');
  if HandValue(DealersCards) > 21 then
  begin
    Writeln('Dealer busts, you win!');
    inc(yourScore);
    exit;
  end;
  if HandValue(YourCards) = HandValue(DealersCards) then Writeln('Draw, House wins if its a draw');
  if HandValue(YourCards) > HandValue(DealersCards) then
  begin
    Writeln('Well played you won!');
    inc(yourScore);
  end else
  begin
    Writeln('Unlucky you lost');
    inc(houseScore);
  end;
end;

begin
  GenerateDeck;
  repeat
    suffleDeck;
    Deal;
    writeln('you: '+Inttostr(yourScore) + ' House: ' +Inttostr(HouseScore));
  until MessageBox('Play again?', 'again?', 4) = 7;
end.

Hah that's awesome

cute, but can i suggest the use of case rather then so many goddamn if then's ? :)

I don't know if you know or realised but i have a thread running about cards/ shuffling and ordering a deck.

I don't know if any of it will be of any use, but you can ask any card questions here I suppose :D

http://villavu.com/forum/showthread.php?p=811941#post811941