mysticbbs/scripts/blackjack.mps

// ==========================================================================
// BLACKJACK.MPS
//
// This is a simple BlackJack game that I wrote to test out MPL features
// about a year or two ago.  I decided to port it to the later MPL version
// for the same purposes.
//
// Changelog:
//   - Added an improved AI for the dealer.  He's a lot less predictable and
//     makes more logical decisions now.
//   - When the player busts, the dealers hidden card is now shown.  This is
//     just for people curious if they would have won by standing.
//   - Fixed a few display bugs
//   - Now saves your money between sessions
//   - Added Top 10 list
// ==========================================================================

Uses
  User;

Const
  Version     = '1.3';
  CashStart   = 1000;
  CardJack    = 11;
  CardQueen   = 12;
  CardKing    = 13;
  CardAce     = 14;
  SuitClub    = 1;
  SuitSpade   = 2;
  SuitHeart   = 3;
  SuitDiamond = 4;

Type
  PlayerRec = Record
    UserID : LongInt;
    Name   : String[30];
    Cash   : LongInt;
    LastOn : LongInt;
  End;

Type
  TopTenRec = Record
    User : String[35];
    Cash : LongInt;
    Date : LongInt;
  End;

Type
  CardRec = Record
    Suit : Byte;
    Card : Byte;
  End;

Var
  DataPath      : String;
  Deck          : Array[1..52] of CardRec;
  Player        : PlayerRec;
  PlayerNumber  : LongInt = -1;
  Wager         : LongInt;
  Player_Score  : Byte;
  Player_Cards  : Byte;
  Dealer_Score  : Byte;
  Dealer_Hidden : Byte;
  Dealer_Cards  : Byte;
  Dealer_Aces   : Byte;

Procedure LoadPlayer;
Var
  F : File;
  T : PlayerRec;
Begin
  GetThisUser;

  PlayerNumber  := -1;

  Player.UserID := UserIndex;
  Player.Cash   := CashStart;

  fAssign (F, DataPath + 'blackjack.ply', 66);
  fReset  (F);

  If IoResult <> 0 Then fReWrite(F);

  While Not fEof(F) Do Begin
    fReadRec (F, T);

    If T.UserID = UserIndex Then Begin
      Player       := T;
      PlayerNumber := fPos(F) / SizeOf(Player);
      Break;
    End;

    Break;
  End;

  fClose (F);

  Player.LastOn := DateTime;
  Player.Name   := UserAlias;
End;

Procedure SavePlayer;
Var
  F : File;
Begin
  fAssign (F, DataPath + 'blackjack.ply', 66);
  fReset  (F);

  If PlayerNumber <> -1 Then
    fSeek (F, SizeOf(Player) * (PlayerNumber - 1));
  Else
    fSeek (F, fSize(F));

  fWriteRec (F, Player);
  fClose    (F);
End;

Procedure ExecuteTopTen;
Var
  TopList   : Array[1..10] of TopTenRec;
  Count1    : Byte;
  Count2    : Byte;
  Count3    : Byte;
  F         : File;
  OnePerson : PlayerRec;
Begin
  Write ('|16|CL|10Sorting top scores...');

  For Count1 := 1 to 10 Do Begin
    TopList[Count1].User := 'None';
    TopList[Count1].Cash := 0;
    TopList[Count1].Date := 0;
  End;

  fAssign (F, DataPath + 'blackjack.ply', 66);
  fReset  (F);

  If IoResult = 0 Then
    While Not fEof(F) Do Begin
      fReadRec (F, OnePerson);

      For Count2 := 1 to 10 Do
        If TopList[Count2].Cash < OnePerson.Cash Then Begin
          For Count3 := 10 DownTo Count2 + 1 Do
            TopList[Count3] := TopList[Count3 - 1]

          TopList[Count2].Cash := OnePerson.Cash;
          TopList[Count2].User := OnePerson.Name;
          TopList[Count2].Date := OnePerson.LastOn;

          Break;
        End;
    End;

  ClrScr;

  GotoXY (24, 3);
  Write  ('|07Mystic BlackJack - Top 10 Players');

  GotoXY (5, 6);
  Write  ('##  User                              Date                      Cash');

  GotoXY (5, 7);
  Write  ('|02' + strRep(#196, 68) + '|10');

  For Count1 := 1 to 10 Do Begin
    GotoXY (5, 7 + Count1);
    Write  (PadLT(Int2Str(Count1), 2, ' '));

    GotoXY (9, 7 + Count1);
    Write  (TopList[Count1].User);

    GotoXY (42, 7 + Count1);
    Write  (DateStr(TopList[Count1].Date, 1));

    GotoXY (53, 7 + Count1);
    Write  (PadLT(strComma(TopList[Count1].Cash), 20, ' '));
  End;

  GotoXY (5, 18);
  Write  ('|02' + strRep(#196, 68));

  GotoXY (26, 20);
  Write  ('|02Press |08[|15ENTER|08] |02to continue|PN');
End;

Procedure DeckCreate;
Var
  Suits,
  Numbers,
  Index    : Byte;
Begin
  Index := 1;

  For Suits := 1 to 4 Do
    For Numbers := 2 to CardAce Do Begin
      Deck[Index].Suit := Suits;
      Deck[Index].Card := Numbers;
      Index            := Index + 1;
    End;
End;

Procedure DeckShuffle;
Var
  OneCard   : CardRec;
  Shuffle,
  CardNum1,
  CardNum2  : Byte;
Begin
  For Shuffle := 1 to 200 Do Begin
    CardNum1       := Random(51) + 1;
    CardNum2       := Random(51) + 1;
    OneCard        := Deck[CardNum1];
    Deck[CardNum1] := Deck[CardNum2];
    Deck[CardNum2] := OneCard;
  End;
End;

Function GetCardNumber (Num: Byte) : String;
Var
  Res,
  Color : String[3];
Begin
  Case Deck[Num].Card of
    1..10     : Res := PadLT(Int2Str(Deck[Num].Card), 2, ' ');
    CardJack  : Res := ' J';
    CardQueen : Res := ' Q';
    CardKing  : Res := ' K';
    CardAce   : Res := ' A';
  End;

  Case Deck[Num].Suit of
    SuitClub    : GetCardNumber := '|08' + Res + #05;
    SuitSpade   : GetCardNumber := '|08' + Res + #06;
    SuitHeart   : GetCardNumber := '|04' + Res + #03;
    SuitDiamond : GetCardNumber := '|04' + Res + #04;
  End
End

Procedure DrawCard (X, Y, Showing, Num: Byte);
Var
  Str : String;
Begin
  If Y = 1 Then Y := 17 Else Y := 10;

  X   := (X - 1) * 9 + 5;
  Str := GetCardNumber(Num);

  Case Showing of
    1 : Begin
          GotoXY (X, Y);
          Write  ('|23' + Str + '   ');
          GotoXY (X, Y + 1);
          Write  ('      ');
          GotoXY (X, Y + 2);
          Write  ('   ' + Str + '|16');
        End;
    2 : Begin
          GotoXY (X, Y);
          Write  ('|07|20<32> <20><> <20>');
          GotoXY (X, Y + 1);
          Write  ('<27> <20><> <20>');
          GotoXY (X, Y + 2);
          Write  ('<27> <20><> <20>|16');
        End;
  Else
    GotoXY (X, Y);
    Write  ('|00|16      ');
    GotoXY (X, Y + 1);
    Write  ('      ');
    GotoXY (X, Y + 2);
    Write  ('      |07');
  End;
End;

Procedure Print (Str1, Str2: String);
Begin
  GotoXY (54, 13);
  Write  (strRep(' ', 23));
  GotoXY (54, 13);
  Write  (Str1);
  GotoXY (54, 14);
  Write  (strRep(' ', 23));
  GotoXY (54, 14);
  Write  (Str2);
End

Procedure GetNewCard (Dealer: Boolean);
Var
  Count,
  Value,
  Aces   : Byte;
Begin
  Aces        := 0;
  Dealer_Aces := 0;

  If Dealer Then Begin
    Dealer_Score := 0;
    Dealer_Cards := Dealer_Cards + 1;

    DrawCard (Dealer_Cards, 2, 1, Dealer_Cards + 5);

    For Count := 1 to Dealer_Cards Do Begin
      Value := Deck[Count + 5].Card;
      If Value = CardAce Then Begin
        Value       := 11;
        Dealer_Aces := Dealer_Aces + 1;
      End Else
      If Value > 10 Then
        Value := 10;

      Dealer_Score := Dealer_Score + Value;
    End;

    If Dealer_Score > 21 And Dealer_Aces > 0 Then Begin
      Repeat
        Dealer_Score := Dealer_Score - 10;
        Dealer_Aces  := Dealer_Aces - 1;
      Until Dealer_Score < 22 or Dealer_Aces = 0;

      If Deck[6].Card = CardAce And Dealer_Aces = 0 Then
        Dealer_Hidden := 1;
    End;

  End Else Begin

    Player_Score := 0;
    Player_Cards := Player_Cards + 1;

    DrawCard (Player_Cards, 1, 1, Player_Cards);

    For Count := 1 to Player_Cards Do Begin
      Value := Deck[Count].Card;
      If Value = CardAce Then Begin
        Value := 11;
        Aces  := Aces + 1;
      End Else
      If Value > 10 Then
        Value := 10;

      Player_Score := Player_Score + Value;
    End;

    If Player_Score > 21 Then
      While Player_Score > 21 And Aces > 0 Do Begin
        Player_Score := Player_Score - 10;
        Aces         := Aces - 1;
      End;
  End;
End;

Procedure DrawCash
Begin
  GotoXY (64, 19);
  Write  ('|15|17' + PadRT(strComma(Player.Cash), 10, ' ') + '|16');
End;

Procedure UpdateScores;
Begin
  GotoXY (65, 10);
  Write  ('|15' + Int2Str(Dealer_Score - Dealer_Hidden));
  GotoXY (65, 17);
  Write  (Int2Str(Player_Score));
End

Procedure Initialize;

  Procedure EraseInput;
  Begin
    GotoXY (64, 20);
    Write  ('|17          |16');
    GotoXY (64, 20);
  End;

Var
  X,
  Y : Byte;
Begin
  If Player.Cash = 0 Then Begin
    Print ('|15No cash|07? |10House loans ya', '|07$|15' + strComma(CashStart) + '|07. |12Press a key');
    Player.Cash := CashStart;
    ReadKey;
  End;

  Print ('  |12|16Shuffling deck...', '');

  DeckShuffle;

  For Y := 1 to 2 Do
    For X := 1 to 5 Do
      DrawCard(X, Y, 3, 1);

  GotoXY (65, 10);
  Write  ('   ');
  GotoXY (65, 17);
  Write  ('   ');

  DrawCash;

  Print  ('  |15|16Enter your wager:', '  |02(|14$|15' + Int2Str(Player.Cash) + ' |14max|02)|14|17');

  EraseInput;

  Write('|17');

  Wager := Str2Int(Input(10, 10, 1, ''));

  If Wager > Player.Cash Then Wager := 0;

  If Wager = 0 Then Begin
    EraseInput;
    Exit;
  End;

  Dealer_Cards  := 1;
  Player_Cards  := 0;
  Dealer_Hidden := Deck[6].Card;

  If Dealer_Hidden = CardAce Then
    Dealer_Hidden := 11
  Else
  If Dealer_Hidden > 10 Then
    Dealer_Hidden := 10

  DrawCard(1, 2, 2, 6)

  GetNewCard(False);
  GetNewCard(False);
  GetNewCard(True);

  UpdateScores;
End;

Procedure AdjustScore (Mode: Byte);
Begin
  Case Mode of
    0 : Begin
          Player.Cash := Player.Cash - Wager;
          If Player.Cash < 0 Then Player.Cash := 0;
        End;
    1 : Begin
          Player.Cash := Player.Cash + Wager;
          If Player.Cash > 99999999 Then Player.Cash := 99999999;
        End;
  End;

  DrawCash;
End;

Var
  Ch      : Char;
  GoForIt : Boolean;
Begin
  ClrScr;

  If Graphics = 0 Then Begin
    WriteLn ('Sorry, this game requires ANSI graphics.|CR|PA');
    Halt;
  End;

  DataPath := JustPath(ProgName);

  // RESET to reset scores
  // TOPLIST to show only scores and exit

  Randomize;
  DeckCreate;
  LoadPlayer;

  DispFile (DataPath + 'blackjack')

  Repeat
    Print ('  |15Want to play a game?', '  |10(|14Y|02/|14N|10)|08: |07')

    If OneKey('YN', False) = 'N' Then Break;

    Initialize;

    If Wager = 0 Then Continue;

    If Dealer_Score = 21 Then
      If Deck[6].Card = CardJack or Deck[7].Card = CardJack Then
        If Deck[6].Suit = SuitClub or Deck[7].Suit = SuitClub or Deck[6].Suit = SuitSpade or Deck[7].Suit = SuitSpade Then Begin
          DrawCard (1, 2, 1, 6);
          Dealer_Hidden := 0;
          AdjustScore(0);
          UpdateScores;
          Print (' |12Dealer has Black Jack', ' Press any key.');
          ReadKey
          Continue;
        End

    If Player_Score = 21 Then
      If Deck[1].Card = CardJack or Deck[2].Card = CardJack Then
        If Deck[1].Suit = SuitClub or Deck[2].Suit = SuitClub or Deck[1].Suit = SuitSpade or Deck[2].Suit = SuitSpade Then Begin
          Print (' |12Player has Black Jack', ' Press any key.');
          AdjustScore(1);
          ReadKey;
          Continue;
        End;

    Repeat
      If Player_Cards < 5 Then Begin
        Print ('|10[|14H|10]|07it, |10[|14S|10]|07tand, |10[|14Q|10]|07uit', '|08: |07');
        Ch := OneKey('HSQ', False);
      End Else
        Ch := 'S'

      Case Ch of
        'Q' : Begin
                AdjustScore(0);
                Break;
              End;
        'H' : Begin
                GetNewCard(False);

                UpdateScores;

                If Player_Score > 21 Then Begin
                  AdjustScore(0);
                  DrawCard(1,2,1,6); // show dealer hidden card
                  Print ('  |12Player busted', '  Press a key.');
                  ReadKey;
                  Break;
                End;

                // Dealer AI Rules for Hit
                // <16 = 100%
                // 16  =  50% (100 with ace as 1)
                // 17  =  25% ( 50 with ace as 1)
                // 18  =  10% ( 25 with ace as 1)
                // >18 =   0%

                Case Dealer_Score of
                  1..
                  15 : GoForIt := True;
                  16 : If Dealer_Aces = 0 Then
                         GoForIt := Random(1) = 0
                       Else
                         GoForIt := True;
                  17 : If Dealer_Aces = 0 Then
                         GoForIt := Random(3) = 0
                       Else
                         GoForIt := Random(1) = 0;
                  18 : If Dealer_Aces = 0 Then
                         GoForIt := Random(9) = 0
                       Else
                         GoForIt := Random(3) = 0;
                Else
                  GoForIt := False;    // Dealer decides to stand
                End;

                If GoForIt Then Begin
                  GetNewCard(True);
                  UpdateScores;

                  If Dealer_Score > 21 Then Begin
                    DrawCard (1, 2, 1, 6);
                    Dealer_Hidden := 0;
                    AdjustScore(1);
                    UpdateScores;
                    Print('  |12Dealer busted', '  Press a key.');
                    ReadKey;
                    Break;
                  End;
                End;
              End;
        'S' : Begin
                DrawCard (1, 2, 1, 6);
                Dealer_Hidden := 0;
                UpdateScores;
                While Dealer_Score < Player_Score and Dealer_Score < 22 and Dealer_Cards < 5 Do Begin
                  GetNewCard(True);
                  UpdateScores;
                End

                If Dealer_Score > 21 Then Begin
                  AdjustScore(1);
                  Print('  |12Dealer busted', '  Press a key.');
                  ReadKey;
                End Else
                If Player_Score > 21 Then Begin
                  AdjustScore(0);
                  Print('  |12Player busted', '  Press a key.');
                  ReadKey;
                End Else
                If Player_Score > Dealer_Score Then Begin
                  AdjustScore(1);
                  Print('  |12Player wins!', '  Press a key.');
                  ReadKey;
                End Else
                If Dealer_Score > Player_Score Then Begin
                  AdjustScore(0);
                  Print('  |12Dealer wins!', '  Press a key.');
                  ReadKey;
                End Else Begin
                  AdjustScore(2);
                  Print('  |12Push.  Dealer wins.', '  Press a key.');
                  ReadKey;
                End;

                Break;
              End;
      End;
    Until False;
  Until False;

  SavePlayer;

  ExecuteTopTen;
End.