home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n04.zip / POKER.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-23  |  7KB  |  237 lines
  1. UNIT Poker;
  2. (**********************)
  3. (**)   INTERFACE    (**)
  4. (**********************)
  5. USES Crt, Cards;
  6. TYPE
  7.   Message = String[40];
  8.   PokerHand = (nothing, JacksOrBetter, TwoPair, ThreeOfAKind,
  9.                straight, flush, FullHouse, FourOfAKind,
  10.                StraightFlush, RoyalFlush);
  11.   PokerGame = OBJECT (game)
  12.     layout     : array[0..4] of CardP;
  13.     Hold       : array[0..4] of Boolean;
  14.     stake      : LongInt;
  15.     margin, tab,
  16.     topmargin  : word;
  17.     CONSTRUCTOR Init(iTC : Byte);
  18.     DESTRUCTOR Done; virtual;
  19.     FUNCTION  NameScore(P : PokerHand) : String;
  20.     FUNCTION  Analyze : PokerHand;
  21.     PROCEDURE Play(VAR again : boolean);
  22.   {--- output methods ---}
  23.     PROCEDURE AskForBet;
  24.     PROCEDURE TellHowToHold;
  25.     PROCEDURE TellWhatchaWon(S : Message);
  26.     PROCEDURE YouBusted;
  27.     PROCEDURE Display; virtual;
  28.     PROCEDURE ClearBottom; virtual;
  29.     PROCEDURE ShowStake; virtual;
  30.     PROCEDURE HoldButton(B : Byte); virtual;
  31.     PROCEDURE Tell(M1, M2 : Message); virtual;
  32.   END;
  33.  
  34. (**********************)
  35. (**) IMPLEMENTATION (**)
  36. (**********************)
  37.  
  38.   CONST Payoff : ARRAY [PokerHand] OF byte =
  39.     (0, 1, 2, 3, 4, 6, 9, 25, 50, 250); 
  40.  
  41.   CONSTRUCTOR PokerGame.Init(iTC : byte); 
  42.   BEGIN
  43.     Game.Init(iTC); 
  44.     FillChar(layout, SizeOf(layout), 0); 
  45.     stake := 40; 
  46.   END; 
  47.  
  48.   DESTRUCTOR PokerGame.Done; BEGIN game.Done; END; 
  49.  
  50.   FUNCTION PokerGame.Analyze : PokerHand; 
  51.   VAR
  52.     valu, suit   : Array[0..4] of byte;
  53.     same1, same2,
  54.     N, M, P      : Byte;
  55.     IsF, IsS     : boolean; {IsFlush and IsStraight}
  56.   BEGIN
  57.     FOR N := 0 to 4 DO
  58.       BEGIN
  59.         valu[N] := layout[N]^.GetRank;
  60.         suit[N] := layout[N]^.GetSuit;
  61.       END;
  62.     {Sort the values into order}
  63.     FOR N := 4 DOWNTO 1 DO
  64.       FOR M := 0 to pred(N) DO
  65.         IF valu[M] > valu[N] THEN
  66.           BEGIN
  67.             P := valu[M]; valu[M] := valu[N]; valu[N] := P;
  68.           END;
  69.  
  70.     IsF := true; IsS := true; {-- true 'til proven false --}
  71.     FOR M := 1 to 4 DO IF suit[M]<>suit[0] THEN IsF := false;
  72.  
  73.     FOR N := 3 downto 1 DO IF valu[N+1]-valu[N]<>1 THEN IsS := false;
  74.     IF IsS THEN IsS := valu[1]-valu[0] IN [1, 9];
  75.  
  76.     IF IsF THEN
  77.       BEGIN
  78.         IF IsS THEN
  79.           IF valu[1] = 10 THEN Analyze := RoyalFlush
  80.           ELSE Analyze := StraightFlush
  81.         ELSE Analyze := Flush;
  82.         EXIT;
  83.       END;
  84.     IF IsS THEN BEGIN Analyze := Straight; EXIT; END;
  85.  
  86.     {-- no straight, no flush, try same-rank hands --}
  87.     same1 := 0; same2 := 0;
  88.     FOR N := 0 to 3 DO
  89.       IF valu[N] = valu[succ(N)] THEN
  90.         BEGIN
  91.           inc(same1);
  92.           P := valu[N];
  93.         END;
  94.     IF same1 > 0 THEN
  95.       FOR N := 0 to 4 DO IF valu[N] = P THEN Inc(same2);
  96.     CASE same1 OF
  97.       0 : Analyze := nothing;
  98.       1 : IF P IN [0, 10, 11, 12] THEN Analyze := JacksOrBetter
  99.           ELSE Analyze := Nothing;
  100.       2 : CASE same2 OF
  101.             2 : Analyze := TwoPair;
  102.             3 : Analyze := ThreeOfAKind;
  103.           END;
  104.       3 : CASE same2 OF
  105.             2, 3 : Analyze := FullHouse;
  106.             4 : Analyze := FourOfAKind;
  107.           END;
  108.     END;
  109.   END;
  110.  
  111.   FUNCTION PokerGame.NameScore(P : PokerHand) : String;
  112.   BEGIN
  113.     CASE P OF
  114.       RoyalFlush    : NameScore := 'Royal Flush!';
  115.       StraightFlush : NameScore := 'Straight Flush';
  116.       FourOfAKind   : NameScore := 'Four of a kind';
  117.       Straight      : NameScore := 'Straight';
  118.       FullHouse     : NameScore := 'Full house';
  119.       ThreeOfAKind  : NameScore := 'Three of a kind';
  120.       Flush         : NameScore := 'Flush';
  121.       TwoPair       : NameScore := 'Two pairs';
  122.       JacksOrBetter : NameScore := 'Jacks or better';
  123.       Nothing       : NameScore := 'Nothing';
  124.       ELSE            NameScore := 'HUH?????';
  125.     END;
  126.   END;
  127.  
  128.   PROCEDURE PokerGame.Play(VAR again : boolean);
  129.   VAR CH     : Char;
  130.     N, which : Byte;
  131.     TheHand  : PokerHand;
  132.   CONST
  133.     NumCoins : Byte = 1;
  134.  
  135.   BEGIN
  136.     D^.Shuffle;
  137.     Again := false;
  138.     FillChar(Hold, SizeOf(Hold), false);
  139.     FOR N := 0 to 4 DO {--lay out 5 cards face down --}
  140.       BEGIN
  141.         layout[N] := CardP(D^.FromTop);
  142.         WITH layout[N]^ DO
  143.           BEGIN PutInPlace(margin+N*tab, topmargin); display; END;
  144.       END;
  145.     ShowStake;
  146.     AskForBet;
  147.     REPEAT CH := ReadKey UNTIL CH IN ['1'..'5', ' ', #27];
  148.     CASE CH OF
  149.       #27 : Exit;
  150.       ' ' : ; {space bets same as last time}
  151.       ELSE NumCoins := ord(CH)-ord('0');
  152.     END;
  153.     Dec(stake, NumCoins);
  154.     ShowStake;     {-- bet 1-5 quarters --}
  155.     ClearBottom;
  156.     TellHowToHold;
  157.     FOR N := 0 to 4 DO  {-- turn up the cards --}
  158.       BEGIN
  159.         WITH layout[N]^ DO BEGIN TurnUp; Display; END;
  160.         click; delay(200);
  161.       END;
  162.     which := 0;
  163.     REPEAT {-- see which ones to HOLD --}
  164.       layout[which]^.PointT(dn);
  165.       CH := ReadKey;
  166.       layout[which]^.UnPoin(dn);
  167.       CASE CH OF
  168.         #0 : CASE ReadKey OF
  169.               #$4D : which := (which+1) MOD 5;
  170.               #$4B : which := (which+4) MOD 5;
  171.             END;
  172.         #32 : BEGIN
  173.                Hold[which] := NOT Hold[which];
  174.                HoldButton(which);
  175.              END;
  176.       END;
  177.     UNTIL CH = #13;
  178.     ClearBottom;
  179.     FOR N := 0 to 4 DO     {-- deal new cards --}
  180.       IF NOT Hold[N] THEN
  181.         BEGIN
  182.       WITH layout[N]^ DO BEGIN TurnDown; Display; END;
  183.           click; delay(200);
  184.           D^.AddToBottom(Layout[N]);
  185.         END;
  186.     FOR N := 0 to 4 DO
  187.       IF NOT Hold[N] THEN
  188.         BEGIN
  189.           layout[N] := CardP(D^.FromTop);
  190.           WITH layout[N]^ DO
  191.             BEGIN
  192.               TurnUp; PutInPlace(margin+N*tab, topmargin); Display;
  193.             END;
  194.           click; delay(200);
  195.         END
  196.       ELSE BEGIN Hold[N] := false; HoldButton(N); END;
  197.     theHand := Analyze;
  198.     TellWhatchaWon(nameScore(theHand)); {-- what did you win? --}
  199.     Inc(stake, Word(NumCoins)*PayOff[theHand]);
  200.     ShowStake;
  201.     IF ReadKey = #0 THEN;
  202.     ClearBottom;
  203.     FOR N := 0 to 4 DO {-- put the cards back in the deck --}
  204.       BEGIN
  205.         WITH layout[N]^ DO BEGIN TurnDown; Hide; END;
  206.         D^.AddCard(layout[N]);
  207.       END;
  208.     IF stake <= 0 THEN
  209.       BEGIN
  210.         YouBusted;
  211.         IF ReadKey = #0 THEN;
  212.         Exit;
  213.       END;
  214.     again := true;
  215.   END;
  216.  
  217.   PROCEDURE PokerGame.TellWhatchaWon(S : Message);
  218.   BEGIN Tell(S, ''); END;
  219.  
  220.   PROCEDURE PokerGame.YouBusted;
  221.   BEGIN Tell('Sorry, friend, you''re busted!', ''); END;
  222.  
  223.   PROCEDURE PokerGame.AskForBet;
  224.   BEGIN Tell('Play 1 to 5 quarters', 'Press <Esc> to quit'); END;
  225.  
  226.   PROCEDURE PokerGame.TellHowToHold;
  227.   BEGIN
  228.     Tell('SPACEBAR turns HOLD on/off', 'ENTER when ready to draw');
  229.   END;
  230.  
  231. {--- output methods -- abstract ---}
  232.   PROCEDURE PokerGame.Display;                    BEGIN END;
  233.   PROCEDURE PokerGame.ClearBottom;                BEGIN END;
  234.   PROCEDURE PokerGame.ShowStake;                  BEGIN END;
  235.   PROCEDURE PokerGame.HoldButton(B : Byte);       BEGIN END;
  236.   PROCEDURE PokerGame.Tell(M1, M2 : Message);     BEGIN END;
  237. END.