649 lines
16 KiB
Plaintext
649 lines
16 KiB
Plaintext
// ====================================================================
|
||
// Mystic BBS Software Copyright 1997-2013 By James Coyle
|
||
// ====================================================================
|
||
//
|
||
// This file is part of Mystic BBS.
|
||
//
|
||
// Mystic BBS is free software: you can redistribute it and/or modify
|
||
// it under the terms of the GNU General Public License as published by
|
||
// the Free Software Foundation, either version 3 of the License, or
|
||
// (at your option) any later version.
|
||
//
|
||
// Mystic BBS is distributed in the hope that it will be useful,
|
||
// but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
// GNU General Public License for more details.
|
||
//
|
||
// You should have received a copy of the GNU General Public License
|
||
// along with Mystic BBS. If not, see <http://www.gnu.org/licenses/>.
|
||
//
|
||
// ====================================================================
|
||
// ==========================================================================
|
||
// 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
|
||
// - Added command line option RESET to reset scores
|
||
// - Added command line option TOP10 to show top 10 and exit
|
||
// - No longer allows negative numbers to be a Wager.
|
||
// ==========================================================================
|
||
|
||
Uses
|
||
User;
|
||
|
||
Const
|
||
Version = '1.4';
|
||
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;
|
||
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 (21, 3);
|
||
Write ('|07Mystic BlackJack - Top 10 Money Holders');
|
||
|
||
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 := Abs(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);
|
||
|
||
If Upper(ParamStr(1)) = 'TOP10' Then Begin
|
||
ExecuteTopTen;
|
||
Halt;
|
||
End;
|
||
|
||
If Upper(ParamStr(1)) = 'RESET' Then Begin
|
||
If InputYN('|CR|12Reset blackjack scores? ') Then Begin
|
||
FileErase(DataPath + 'blackjack.ply');
|
||
WriteLn ('|CRScores have been reset|CR|CR|PA');
|
||
End;
|
||
|
||
Halt;
|
||
End;
|
||
|
||
Randomize;
|
||
DeckCreate;
|
||
LoadPlayer;
|
||
|
||
DispFile (DataPath + 'blackjack')
|
||
WriteXY (12, 23, 8, 'Mystic BlackJack v' + Version + ' Code: g00r00 Art: Grymmjack');
|
||
|
||
DrawCash;
|
||
|
||
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. No winner.', ' Press a key.');
|
||
ReadKey;
|
||
End;
|
||
|
||
Break;
|
||
End;
|
||
End;
|
||
Until False;
|
||
Until False;
|
||
|
||
SavePlayer;
|
||
|
||
ExecuteTopTen;
|
||
End.
|
||
|