From 19e0e1b5f50ac1ced656a383a833d2441e6cbe84 Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 13:42:10 +0300 Subject: [PATCH 1/7] Merged accidental commit from 'master' branch --- src/Poker/Interface/Renderer.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Poker/Interface/Renderer.hs b/src/Poker/Interface/Renderer.hs index 627f354..757ba71 100644 --- a/src/Poker/Interface/Renderer.hs +++ b/src/Poker/Interface/Renderer.hs @@ -23,10 +23,10 @@ drawTableScreen screen | state screen == Dealing_Hand = pictures ([tableWithDealerChip] ++ map (\p -> playerOnSeatBold p) (players screen)) | state screen == Waiting_User_Input || - state screen == Show_Click = pictures [tableWithDealerChip, potWithBoard, playersWithHands, + state screen == Show_Click = pictures [tableWithDealerChip, potWithBoard, playersHands, playersBets, drawButtons possibleActions (button $ images screen, buttonClicked $ images screen) (buttonTexts $ images screen) (pressed activePlayer), sliderImage, smallButtons, betWindowImage] - | otherwise = pictures [tableWithDealerChip, potWithBoard, playersWithHands] + | otherwise = pictures [tableWithDealerChip, potWithBoard, playersHands, playersBets] where chipImages = (chipLayout $ images screen) playerOnSeatBold p = pictures [drawPlayerSeatBold p (case active p of @@ -37,8 +37,11 @@ drawTableScreen screen drawDealerChip (dealer screen) chipImages] potWithBoard = pictures [drawPot (calculatePot $ players screen) chipImages, drawCardsOnTable (board screen) (front . deckLayout $ images screen)] - playersWithHands = pictures (map (\p -> pictures [drawPlayerHand p (deckLayout $ images screen), - playerOnSeatBold p, drawPlayerBet p chipImages]) (players screen)) + playersHands = pictures (map (\p -> case action $ move p of + Bankrupted -> blank + Folded -> blank + _ -> pictures [drawPlayerHand p (deckLayout $ images screen)]) (players screen)) + playersBets = pictures (map (\p -> pictures [playerOnSeatBold p, drawPlayerBet p chipImages]) (players screen)) activePlayer = getActivePlayer $ players screen maxBet = countMaxBet $ players screen possibleActions = getPossibleActions activePlayer maxBet From 8382eea77e726faebcb7756ff98472f619268ce2 Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 14:45:34 +0300 Subject: [PATCH 2/7] Implemented detecting of winners --- src/Client.hs | 2 +- src/Poker/Interface/Renderer.hs | 2 -- src/Poker/Logic/Calculations.hs | 19 ++++++++++-- src/Poker/Logic/Trading.hs | 27 ++++++++++++++--- src/Poker/Logic/Types.hs | 2 +- test/Test.hs | 54 +++++++++++++++++---------------- 6 files changed, 69 insertions(+), 37 deletions(-) diff --git a/src/Client.hs b/src/Client.hs index 5b32641..bc45df2 100644 --- a/src/Client.hs +++ b/src/Client.hs @@ -14,7 +14,7 @@ import Poker.Logic.Dealer import Poker.Logic.Trading import Poker.Logic.Types -import Debug.Trace +--import Debug.Trace ------------------------------------------------------------------------------- -- * Game launch related functions diff --git a/src/Poker/Interface/Renderer.hs b/src/Poker/Interface/Renderer.hs index 757ba71..b20867c 100644 --- a/src/Poker/Interface/Renderer.hs +++ b/src/Poker/Interface/Renderer.hs @@ -11,8 +11,6 @@ import Poker.Interface.Offsets import Poker.Logic.Trading import Poker.Logic.Types -import Debug.Trace - ------------------------------------------------------------------------------- -- * Render functions ------------------------------------------------------------------------------- diff --git a/src/Poker/Logic/Calculations.hs b/src/Poker/Logic/Calculations.hs index bad85c6..0a17b1b 100644 --- a/src/Poker/Logic/Calculations.hs +++ b/src/Poker/Logic/Calculations.hs @@ -5,7 +5,7 @@ import Data.List (sort) import Poker.Logic.Types -import Debug.Trace +--import Debug.Trace ------------------------------------------------------------------------------- -- * Functions to operate with cards @@ -85,7 +85,8 @@ computeCombination :: Maybe (Card, Card) -> [Card] -> Combination computeCombination handCards board = Combination { handRank = fst handRankComputations , structure = fst $ snd handRankComputations - , kicker = snd $ snd handRankComputations } + , kicker = snd $ snd handRankComputations + } where handRankComputations = computeHandRank allCards allCards = case handCards of @@ -144,3 +145,17 @@ countRanks cards = foldl (\ranks card -> addRank ranks $ fromEnum (cardRank card takeEqualBestN :: Int -> Int -> [Int] -> [Int] takeEqualBestN n num list = snd . unzip . take n $ reverse (filter (\x -> fst x == num) (zip list [0..12])) + +-- | Convert combination list to bool list with marked top combinations. +-- Receive combination list zipped with bool list that indicates if +-- the combination require to participate in comparing. +markWinningCombinations :: [(Bool, Combination)] -> [Bool] +markWinningCombinations participateAndCombinations = bitWinners + where + filteredWithIndexes = map (\((_,c),i) -> (c,i)) $ filter (\pAc -> fst $ fst pAc) + (zip participateAndCombinations [0..length participateAndCombinations]) + sorted = reverse $ sort filteredWithIndexes + winners = (head sorted:takeWhile (\(c, i) -> c == fst (head sorted)) (tail sorted)) + bitWinners = foldl (\bitmap index -> + fst (splitAt index bitmap) ++ [True] ++ tail (snd $ splitAt index bitmap)) + (replicate (length participateAndCombinations) False) (snd $ unzip winners) diff --git a/src/Poker/Logic/Trading.hs b/src/Poker/Logic/Trading.hs index 2fb7713..b32c9d4 100644 --- a/src/Poker/Logic/Trading.hs +++ b/src/Poker/Logic/Trading.hs @@ -1,6 +1,7 @@ -- | Contains stuff to process bet rounds. module Poker.Logic.Trading where +import Poker.Logic.Calculations import Poker.Logic.Types ------------------------------------------------------------------------------- @@ -150,12 +151,12 @@ applyMoveResults :: [Player] -> [Player] applyMoveResults players = map (\player -> player { balance = balance player - bet player - , move = case action $ move player of - Bankrupted -> Move Bankrupted 0 - Folded -> Move Folded 0 - All_In_ed -> Move All_In_ed 0 - _ -> Move Waiting 0 , active = False + , move = case action $ move player of + Bankrupted -> Move Bankrupted 0 + Folded -> Move Folded 0 + All_In_ed -> Move All_In_ed 0 + _ -> Move Waiting 0 , invested = invested player + bet player }) players @@ -176,6 +177,22 @@ computeHandResults players board = maxInvested = maximum (map (\player -> invested player) players) tookFromEach = takePotFromPlayers players maxInvested +-- | Return amount of winners among player that invested something and mark them as active. +markWinnersActive :: [Player] -> [Card] -> (Int, [Player]) +markWinnersActive players board = (winnersAmount, markedPlayers) + where + combinations = map (\player -> computeCombination (hand player) board) players + playersWithCombinations = zip players combinations + markedCombinations = + map (\(player, combination) -> (invested player > 0, combination)) playersWithCombinations + winningCombinations = markWinningCombinations markedCombinations + winnersAmount = foldl1 (+) $ map (\x-> case x of + True -> 1 + False -> 0) winningCombinations + markedPlayers = map (\(player, isWinner) -> case isWinner of + True -> player { active = True } + False -> player) $ zip players winningCombinations + -- | Take from player part of invested sized in pot. takePotFromPlayer :: Player -> Int -> (Player, Int) takePotFromPlayer player pot = diff --git a/src/Poker/Logic/Types.hs b/src/Poker/Logic/Types.hs index afd73a9..585d9b7 100644 --- a/src/Poker/Logic/Types.hs +++ b/src/Poker/Logic/Types.hs @@ -122,7 +122,7 @@ data Combination = Combination { handRank :: HandRank , structure :: [CardRank] -- ^ card ranks to indicate combination strength , kicker :: [CardRank] -- ^ kicker card ranks - } deriving (Eq, Ord) + } deriving (Eq, Ord, Show) -- | Hand ranks. data HandRank diff --git a/test/Test.hs b/test/Test.hs index 0ff3508..d89108b 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -3,38 +3,40 @@ import Poker.Logic.Types main :: IO () main = do - putStrLn ("\n 1: " ++ show (computeHandRank hand00r)) - putStrLn ("\n 2: " ++ show (computeHandRank hand00)) - putStrLn ("\n 3: " ++ show (computeHandRank hand01)) - putStrLn ("\n 4: " ++ show (computeHandRank hand02)) - putStrLn ("\n 5: " ++ show (computeHandRank hand03)) - putStrLn ("\n 6: " ++ show (computeHandRank hand04)) - putStrLn ("\n 7: " ++ show (computeHandRank hand05)) - putStrLn ("\n 8: " ++ show (computeHandRank hand06)) - putStrLn ("\n 9: " ++ show (computeHandRank hand07)) - putStrLn ("\n 10: " ++ show (computeHandRank hand08)) - putStrLn ("\n 11: " ++ show (computeHandRank hand09)) - putStrLn ("\n 12: " ++ show (computeHandRank hand10)) - putStrLn ("\n 13: " ++ show (computeHandRank hand11)) - putStrLn ("\n 14: " ++ show (computeHandRank hand12)) - putStrLn ("\n 14: " ++ show (computeHandRank hand13)) - putStrLn ("\n" ++ show (getCombination hand00r > getCombination hand00)) - putStrLn ("\n" ++ show (getCombination hand00 > getCombination hand01)) - putStrLn ("\n" ++ show (getCombination hand02 > getCombination hand03)) - putStrLn ("\n" ++ show (getCombination hand03 > getCombination hand04)) - putStrLn ("\n" ++ show (getCombination hand05 > getCombination hand06)) - putStrLn ("\n" ++ show (getCombination hand07 > getCombination hand07c)) - putStrLn ("\n" ++ show (getCombination hand10 > getCombination hand12)) - putStrLn ("\n" ++ show (getCombination hand12 < getCombination hand12c)) - putStrLn ("\n" ++ show (getCombination hand09 > getCombination hand09c)) - putStrLn ("\n" ++ show (getCombination hand08 > getCombination hand08c)) +-- putStrLn ("\n 1: " ++ show (computeHandRank hand00r)) +-- putStrLn ("\n 2: " ++ show (computeHandRank hand00)) +-- putStrLn ("\n 3: " ++ show (computeHandRank hand01)) +-- putStrLn ("\n 4: " ++ show (computeHandRank hand02)) +-- putStrLn ("\n 5: " ++ show (computeHandRank hand03)) +-- putStrLn ("\n 6: " ++ show (computeHandRank hand04)) +-- putStrLn ("\n 7: " ++ show (computeHandRank hand05)) +-- putStrLn ("\n 8: " ++ show (computeHandRank hand06)) +-- putStrLn ("\n 9: " ++ show (computeHandRank hand07)) +-- putStrLn ("\n 10: " ++ show (computeHandRank hand08)) +-- putStrLn ("\n 11: " ++ show (computeHandRank hand09)) +-- putStrLn ("\n 12: " ++ show (computeHandRank hand10)) +-- putStrLn ("\n 13: " ++ show (computeHandRank hand11)) +-- putStrLn ("\n 14: " ++ show (computeHandRank hand12)) +-- putStrLn ("\n 14: " ++ show (computeHandRank hand13)) +-- putStrLn ("\n" ++ show (getCombination hand00r > getCombination hand00)) +-- putStrLn ("\n" ++ show (getCombination hand00 > getCombination hand01)) +-- putStrLn ("\n" ++ show (getCombination hand02 > getCombination hand03)) +-- putStrLn ("\n" ++ show (getCombination hand03 > getCombination hand04)) +-- putStrLn ("\n" ++ show (getCombination hand05 > getCombination hand06)) +-- putStrLn ("\n" ++ show (getCombination hand07 > getCombination hand07c)) +-- putStrLn ("\n" ++ show (getCombination hand10 > getCombination hand12)) +-- putStrLn ("\n" ++ show (getCombination hand12 < getCombination hand12c)) +-- putStrLn ("\n" ++ show (getCombination hand09 > getCombination hand09c)) +-- putStrLn ("\n" ++ show (getCombination hand08 > getCombination hand08c)) + putStrLn ("\n" ++ show (markWinningCombinations markedCombinations)) where handRankComputations cards = computeHandRank cards getCombination cards = Combination { handRank = fst $ handRankComputations cards , structure = fst . snd $ handRankComputations cards , kicker = snd . snd $ handRankComputations cards } - + combinations = map getCombination [hand00, hand01, hand02, hand05, hand00r, hand06] + markedCombinations = zip (replicate (length combinations) True) combinations -- | Test cases for combinations. From fb205cc9a5b1fe9c475f2cd9e688da975ef94405 Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 15:24:32 +0300 Subject: [PATCH 3/7] Implemented dealing pot to winners at showdown --- src/Poker/Logic/Trading.hs | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/src/Poker/Logic/Trading.hs b/src/Poker/Logic/Trading.hs index b32c9d4..0b1f24b 100644 --- a/src/Poker/Logic/Trading.hs +++ b/src/Poker/Logic/Trading.hs @@ -172,10 +172,35 @@ computeHandResults players board = Folded -> player _ -> player { balance = balance player + snd tookFromEach }) (fst tookFromEach) - else players + else if (notFinished) + then computeHandResults clearedPlayers board + else clearedPlayers where - maxInvested = maximum (map (\player -> invested player) players) - tookFromEach = takePotFromPlayers players maxInvested + maxInvested = maximum (map (\player -> invested player) players) + tookFromEach = takePotFromPlayers players maxInvested + winResults = markWinnersActive players board + markedPlayers = snd winResults + winnersAmount = fst winResults + minWinning = minimum (map (\player -> invested player) $ + filter (\player -> active player) markedPlayers) + takeResults = takePotFromPlayers markedPlayers minWinning + takenPlayers = fst takeResults + winnersPot = snd takeResults + winnerAward = winnersPot `div` winnersAmount + leftPart = winnersPot - winnerAward * winnersAmount + awardedPlayers = giveLeftPart leftPart $ map (\player -> case active player of + True -> player { balance = balance player + winnerAward } + False -> player) takenPlayers + notFinished = any (\player -> invested player > 0) takenPlayers + clearedPlayers = map (\player -> player { active = False }) awardedPlayers + +-- | Give award to first active player. +giveLeftPart :: Int -> [Player] -> [Player] +giveLeftPart _ [] = [] +giveLeftPart award players + | active $ head players = + ((head players) { balance = balance (head players) + award } : tail players) + | otherwise = (head players : giveLeftPart award (tail players)) -- | Return amount of winners among player that invested something and mark them as active. markWinnersActive :: [Player] -> [Card] -> (Int, [Player]) From 8ae09a134157ceee2d3a050948568db096e38021 Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 16:04:09 +0300 Subject: [PATCH 4/7] Added checks for game end --- src/Client.hs | 18 ++++++++++++------ src/Poker/Interface/Handlers.hs | 2 -- src/Poker/Interface/Types.hs | 1 + src/Poker/Logic/Calculations.hs | 2 +- src/Poker/Logic/Dealer.hs | 13 ++++++++++--- src/Poker/Logic/Trading.hs | 9 ++++++++- src/Poker/Logic/Types.hs | 6 ++++-- 7 files changed, 36 insertions(+), 15 deletions(-) diff --git a/src/Client.hs b/src/Client.hs index bc45df2..6c9a539 100644 --- a/src/Client.hs +++ b/src/Client.hs @@ -47,6 +47,7 @@ createTableScreenWith generator imgs = TableScreen , players = [Player Human " Hero" 1500 SB Bottom Nothing False False 0 (Move Waiting 0) 0, Player Human "Opponent" 1500 BB Top Nothing True False 0 (Move Waiting 0) 0] + , hero = " Hero" , street = Preflop , handCount = 1 , dealer = Bottom @@ -64,8 +65,12 @@ createTableScreenWith generator imgs = TableScreen -- | Update game parameters depending on game state. updateGame :: Float -> TableScreen -> TableScreen -updateGame timePassed screen - | state screen == Dealing_Hand = +updateGame timePassed screen + | state screen == Start_Hand = + if (checkGameEnd $ players screen) + then screen { state = Finish_Game } + else screen { state = Dealing_Hand } + | state screen == Dealing_Hand = if (timer screen < dealTime) then screen { timer = timer screen + timePassed } else screen @@ -87,8 +92,9 @@ updateGame timePassed screen | state screen == Start_Round = if (street screen == Showdown) then screen - { state = Finish_Hand - , timer = 0 + { state = Finish_Hand + , timer = 0 + , players = openHands $ players screen } else screen { state = Bet_Round @@ -137,7 +143,7 @@ updateGame timePassed screen then screen { state = Finish_Hand , timer = 0 - , players = applyMoveResults (players screen) + , players = openHands $ applyMoveResults (players screen) } else if (activePlayerPosition == lastPosition) then if (checkReTrade (players screen) maxBet) @@ -155,7 +161,7 @@ updateGame timePassed screen if (timer screen < showdownTime) then screen { timer = timer screen + timePassed } else screen - { state = Dealing_Hand + { state = Start_Hand , timer = 0 , players = changePlayerPositions $ computeHandResults (players screen) (board screen) diff --git a/src/Poker/Interface/Handlers.hs b/src/Poker/Interface/Handlers.hs index bc9ee7c..6d4eb18 100644 --- a/src/Poker/Interface/Handlers.hs +++ b/src/Poker/Interface/Handlers.hs @@ -9,8 +9,6 @@ import Poker.Interface.Offsets import Poker.Logic.Trading import Poker.Logic.Types -import Debug.Trace - ------------------------------------------------------------------------------- -- * Handler functions ------------------------------------------------------------------------------- diff --git a/src/Poker/Interface/Types.hs b/src/Poker/Interface/Types.hs index ed3c28e..5aefea7 100644 --- a/src/Poker/Interface/Types.hs +++ b/src/Poker/Interface/Types.hs @@ -15,6 +15,7 @@ data TableScreen = TableScreen { state :: GameState -- ^ current game state , timer :: Float -- ^ for detecting time , players :: [Player] -- ^ info about every player + , hero :: String -- ^ name of hero , street :: Street -- ^ current street , handCount :: Int -- ^ current hand number , dealer :: Seat -- ^ position of dealer diff --git a/src/Poker/Logic/Calculations.hs b/src/Poker/Logic/Calculations.hs index 0a17b1b..40e50d0 100644 --- a/src/Poker/Logic/Calculations.hs +++ b/src/Poker/Logic/Calculations.hs @@ -155,7 +155,7 @@ markWinningCombinations participateAndCombinations = bitWinners filteredWithIndexes = map (\((_,c),i) -> (c,i)) $ filter (\pAc -> fst $ fst pAc) (zip participateAndCombinations [0..length participateAndCombinations]) sorted = reverse $ sort filteredWithIndexes - winners = (head sorted:takeWhile (\(c, i) -> c == fst (head sorted)) (tail sorted)) + winners = (head sorted:takeWhile (\(c, _) -> c == fst (head sorted)) (tail sorted)) bitWinners = foldl (\bitmap index -> fst (splitAt index bitmap) ++ [True] ++ tail (snd $ splitAt index bitmap)) (replicate (length participateAndCombinations) False) (snd $ unzip winners) diff --git a/src/Poker/Logic/Dealer.hs b/src/Poker/Logic/Dealer.hs index d7f6ce8..1313ac0 100644 --- a/src/Poker/Logic/Dealer.hs +++ b/src/Poker/Logic/Dealer.hs @@ -59,23 +59,26 @@ dealBoard randomizer deck board street -- * Operations with players ------------------------------------------------------------------------------- --- | Take blind from player. +-- | Take blind from player and mark bankrupted players. takeBlind :: Player -> Int -> Player takeBlind player blind | balance player == 0 = player + { move = Move Bankrupted 0 } | balance player <= blind = player { move = Move All_In_ed (balance player) } | otherwise = player { move = Move Raised blind } --- | Take blinds from players. +-- | Take blinds from players and mark bankrupted players. takeBlinds :: [Player] -> Int -> [Player] takeBlinds [] _ = [] takeBlinds (p:ps) bb = let takeBB player blind = case position player of SB -> takeBlind player (blind `div` 2) BB -> takeBlind player blind - _ -> player + _ -> if (balance player == 0) + then player { move = Move Bankrupted 0 } + else player in (takeBB p bb : takeBlinds ps bb) -- | Hide hand depending on player type and settings. @@ -86,6 +89,10 @@ hideHands players = map AI -> player { hideHand = hideAIhand }) players +-- | Open all hands. +openHands :: [Player] -> [Player] +openHands players = map (\player -> player { hideHand = False }) players + ------------------------------------------------------------------------------- -- * Constants ------------------------------------------------------------------------------- diff --git a/src/Poker/Logic/Trading.hs b/src/Poker/Logic/Trading.hs index 0b1f24b..bc39d3c 100644 --- a/src/Poker/Logic/Trading.hs +++ b/src/Poker/Logic/Trading.hs @@ -90,6 +90,13 @@ checkReTrade players bet = or (map mv p = action $ move p bt p = betSize $ move p +-- | Return if game ended. +checkGameEnd :: [Player] -> Bool +checkGameEnd players = sum (map (\player -> + if (balance player == 0) + then 0 + else 1) players) == 1 + -- | Return default move to proposed bet size when human didn't made any input. autoHumanMove :: Player -> Int -> Move autoHumanMove player bet @@ -262,7 +269,7 @@ writeButtonClick btn players -- | Time to get response from AI player. aiThinkTime :: Float -aiThinkTime = 2.0 +aiThinkTime = 1.0 -- | Time to get response from human player. humanThinkTime :: Float diff --git a/src/Poker/Logic/Types.hs b/src/Poker/Logic/Types.hs index 585d9b7..7c93f7a 100644 --- a/src/Poker/Logic/Types.hs +++ b/src/Poker/Logic/Types.hs @@ -13,15 +13,17 @@ import Data.List -- | Possible game states. data GameState - = Dealing_Hand + = Start_Hand + | Dealing_Hand | Posting_Blinds + | Start_Round | Bet_Round | Show_Click | Waiting_User_Input | AI_Thinking | Next_Move - | Start_Round | Finish_Hand + | Finish_Game deriving (Eq) -- | Contain all personal player data. From 0094d654b13e45bb7d4b674371a862cac7a587d0 Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 16:21:40 +0300 Subject: [PATCH 5/7] Added display of game results --- img/text/loss.png | Bin 0 -> 2057 bytes img/text/win.png | Bin 0 -> 1929 bytes src/Poker/Interface/Loader.hs | 4 ++++ src/Poker/Interface/Offsets.hs | 4 ++++ src/Poker/Interface/Renderer.hs | 11 ++++++++--- src/Poker/Interface/Types.hs | 2 ++ src/Poker/Logic/Trading.hs | 5 +++++ 7 files changed, 23 insertions(+), 3 deletions(-) create mode 100644 img/text/loss.png create mode 100644 img/text/win.png diff --git a/img/text/loss.png b/img/text/loss.png new file mode 100644 index 0000000000000000000000000000000000000000..252c0397fd948cf74c0baf2729ce8f55ad7e3b43 GIT binary patch literal 2057 zcmV+k2=@1hP)Px#1ZP1_K>z@;j|==^1poj532;bRa{vGi!vFvd!vV){sAK>D2cAhpK~#8N?VLZT z9Yqwz-?LLYBiICEVFVkaV4=iklZe>F&L~*LHl`9mP>Wz`p~luKqKRE>L`*;kl8Ayv z5Fu%ziH#&Fgv9dseY@Xm=FZNXnZ0*+-+k}y59XbnKRbJO=Iq&-GqZ1fZDMKI+}u12 z@lYLGdk|sY`uh6Ib#!7b(5NR6N;s}lia_~G^=TEi5%wr+LZD49SFK~9qALe(eM5&y zP-YLpS%e!14(b|p@0f~J1^ogkE~|JJl-;OLX}F-Q2@kZ(q~HO#OyS_c5U(|4Le1uM}K-Bx%7P@|c5xTv?o#6;hmk+it#TX6ENq{S{Ma>`}+mZalL$t?rFl^z|=%w0H%!13E% zH&O)TA69u6cn(9+M0;XbWH|5Cu_Tuy?}84T+hvG!e-?a0$yrdAlMVVaIq3=~9E>xa z`Nh6?o|vI!0gy&T&S5?nT|iyEOfpf-c_BDqi`B_KWjY_wxjkAq*YBqgUW5K;{*LH8 z4e8nYHHh_BuD-T0LSoVE6wI8AI4z#fNo6HL88$}A1Lec=Csaj}x~R#vS8!xgvDsfS zFN6iJTYMiVOU3TePy9Wt{zqEh3U2DEip_#_Hd;x8&A1F1uag^+uX5z^8vaUWNYyx$ zbucxG|qQ?k5~ihJg>tU&27>J$D&WtO zDUM3|yeioOzrmVcos)DtDmfH4B}1y;k+R_Al%xe+hM`6NRWb$_iOf~2uyZ1v6;iVJ zw3EnL#9NX+Ib+2)Vd!149-`M#p2L@xVL^Y7et za+w=*rreL6&r`ZZs{xR<^kZ-(TSPlnc@{J0DJ=)b+w^2~euGwL+hoV!1m$9$l-tTS zEjal`vXmS%q^5XfB>qI~5WA7@>La@f%JfaM(hN9xls|4j(@E zTLl*{=|F`mO!NsR)-Y~X;XBUp}qr(p=l1u-B_4V;#Gp(b!Pi9HT z`KKR{^vM|ru0Z?#WPb7P^Q2@8o%b9vX1lFmoyi@9YX2YVSd`cX zye=!`DRK|)Q<65gxe|)K7$|FPGMd?B!+4z>CAlGod3BLaSYH`Awsf-qF1Lyvx(0B8zzhAvN~p9{K8%H5{`YQbVtEs4KO_f!lJ!H^ouZNyThF{>Cvs zSK~txF7*>y=_83ZY|bF=M!kH%`DQ(U@Guhta?XWcByD)10*WoT1Lq9((J?`}m=y}4 zg{e9Wa$9_|=0G;BGcBBDp=0p6MfZVn^VCmx4Rg~K@=N-MM7Mz;ogS1F^IPx#1ZP1_K>z@;j|==^1poj532;bRa{vGi!vFvd!vV){sAK>D2Odd8K~#8N?VLTR z9Yq+1b1f}w60k533!`9>7*R|Nw=!ZQ+8LEth+vf;3$YLtys?rL(WFwWl0xmS2qNBq zC>jMp6A&@6&?GjJ*d^`teP`b}ch2nmoqNvio;~gZbH1J3nY}Z+-+c4U&)zKq|8LgU z*AF6GKybN)u%aaW0fjzgil1kq$|1e`fNmn}(4~Pn0qcjdCL5CWvuK$+I9WACk*?T^g7p@LtYTuP4f?l6DHpK}Ei5N)%`1Hl_bgGR010 zSk`flS0ybcB?ksJ1NCWpbr|JE^9v=V=9f@pVUf4lqta;#RxNu%T@ z!};n|lC1BG>qkw>4bJG&z#M}2Gxq~PlqKg5kqx7X2rE@WQaN$mZxqA8Z(u5*L%x9w zaY4x|aDpu|$8{yIfos0IG7S6%rUrUc;s&oSDZK$FPC*>5Vo8oKEiJvJ;}L=U$B^!Q z9d`oC#6jzxDrR^X;SPjzsj?y8L5Mr6nBg(W6Ug_iju#5A&aCeh)b&Ue4TC(cUu~c5 z%%2hd&P|Bht5}fZk{ck?rl;v}-km;)T5unvT|wX+B6|jZK*BiB^Lnu#$BY?j(@r>7 z(w$8;C_?^{dHppduYqeZcQDxt;=1b>8`lpq*Av&?GtN!?j1Xs?`S;Uv#0iitSJwJW z8%`FD9Kl#-#Qley9rz&)D_PQbT$r9cK$0qHlCG4wq|1!X0O49}FjVUPjTDr})u|{` zDKjNP$@|T^qezp~OQx~&%q}d*t?DqzyONeyBrP9E*1+H9!==Mcmt?CsInG&hQ*?pO zR?#t-{xI_MMf7fPiE8}?aj}X;*^au!=Ja<-`fN?)c}bG|DA_0|3k}YD2%-1uvlr=e zM&gQOh|Bz`DRbe&Cc8Xkav$==jL-BHLhPknM&1{AAZZF3U?&3a(?`CMO!2a$&s~xs zo{{uRS0(3S$#p_bNT#SYcGQ)YH)ZJ_lJv3nx|T6AvtqC04+wW7Jd2R)?Ng1EhAlOb z@DG22%B%{fT7qT2-_c@^Z_69s3_I}r@SQNkKBQeWs zsTm2}gM(&kXug(g1NP4QSXYEk5dXV69i_w_F%~$$IsU{fGx=CD1^qPN(*7bD;vIz4 z^ongrBm8&(-jDa~8zqY6cfB#oYYF+yk4lm@Tnx*kZbk{Q24Q;Vs4_!|XkBA1!R0AQ z%iEG69+8X@>kV?fMDD)xNQq*(zAj0*XBOXjKOotbi$QW@rp@xFq{}V*E%tOt%S^tI zEQN!&R3%DY#%5^hzKx;hlyfyk^^(Oc>550z8+o`0V)L}=VuX}#7K|@hSB$K6PMP08 zD4C|SLja*w0InHeC$k!#2RLk}jhuyQDJ9e3wkq z5t{qd(&y8XP0{rIo1jF&tU|iJZwj{oJSfRQd0Q?vLsX=+)@SoRcJe5`E30gEaf(%Sf&eh;*AT6y`OwQfr;JmWC z=<=cDBJi)I0s1+be=f1i1I_ZeWQx}%$xjHm*`0e3>_Q1$j8OO7OHh~H2qSdb(55ms zy;3)e`)`wM4ZII3T5bx|T@BX=X04DQ0y4-I8rns&IB7 zS7OaAi{xS?Y1_>xSt8#Iv$`+$5p+SR!kK!?nwLzOE|iObu><$LkL{U9;MPzxE!(y- z=eoz(;zw>#Wa@2=dLZ;QTSp34vf4_2+46^EiiL48@P4?*dFq3ocy5N^P6$8@b+jPurH63eAqygzU5KN`-tS(*Ax-tvyGl)HG zZn!t!4@$;bB$YL_U!i0Rs|yz+KB^8oBh>)Emvl*`@9S4MF>=P~=T4LvR)rh3ISqCi zA!J<+L6P~9qP3VVOn(~r@8x}}Q+05STUbjrywK<7zfRa!MLQ*>fT4!w4hUW7Vgx^s z=rJkdWVW1kWtj~qz!3y4RPcWuQ1RIM`~f24JkRS?x^2wI3ptREU$q=Vpw)F7jlCy7 zn7tqA=HkVx9De-?-KkK+jeUi)a4v?P4fVv`o56R=L2lRMoq>T_vSrJE<4&uESRy2# P00000NkvXXu0mjfcip2- literal 0 HcmV?d00001 diff --git a/src/Poker/Interface/Loader.hs b/src/Poker/Interface/Loader.hs index f834b15..60cd2fc 100644 --- a/src/Poker/Interface/Loader.hs +++ b/src/Poker/Interface/Loader.hs @@ -15,6 +15,8 @@ import Poker.Logic.Types loadedTableImages :: IO TableImages loadedTableImages = do Just imgBackground <- loadJuicyPNG "img/background.png" + Just imgWin <- loadJuicyPNG "img/text/win.png" + Just imgLoss <- loadJuicyPNG "img/text/loss.png" Just imgTable <- loadJuicyPNG "img/table.png" Just imgSeatBold <- loadJuicyPNG "img/seatbold.png" Just imgSeatBoldActive <- loadJuicyPNG "img/seatbold active.png" @@ -32,6 +34,8 @@ loadedTableImages = do imgsChips <- loadChipLayout return TableImages { background = imgBackground + , win = imgWin + , loss = imgLoss , table = imgTable , seatBold = imgSeatBold , seatBoldActive = imgSeatBoldActive diff --git a/src/Poker/Interface/Offsets.hs b/src/Poker/Interface/Offsets.hs index 78ca519..982e62c 100644 --- a/src/Poker/Interface/Offsets.hs +++ b/src/Poker/Interface/Offsets.hs @@ -125,3 +125,7 @@ betWindowOffset = (buttonOffset * 1.5 - 33, -250) -- | Offset for test in bet window. betWindowTextOffset :: (Float, Float) betWindowTextOffset = (-20, -6) + +-- | Vertical offset for result message +resultMessageOffset :: Float +resultMessageOffset = 70 diff --git a/src/Poker/Interface/Renderer.hs b/src/Poker/Interface/Renderer.hs index b20867c..352a5b8 100644 --- a/src/Poker/Interface/Renderer.hs +++ b/src/Poker/Interface/Renderer.hs @@ -21,10 +21,12 @@ drawTableScreen screen | state screen == Dealing_Hand = pictures ([tableWithDealerChip] ++ map (\p -> playerOnSeatBold p) (players screen)) | state screen == Waiting_User_Input || - state screen == Show_Click = pictures [tableWithDealerChip, potWithBoard, playersHands, playersBets, + state screen == Show_Click = pictures [tableWithDealerChip, potWithBoard, playersHands, playersWihtBets, drawButtons possibleActions (button $ images screen, buttonClicked $ images screen) (buttonTexts $ images screen) (pressed activePlayer), sliderImage, smallButtons, betWindowImage] - | otherwise = pictures [tableWithDealerChip, potWithBoard, playersHands, playersBets] + | state screen == Finish_Game = pictures [background $ images screen, table $ images screen, + playersWihtBets, resultMessage] + | otherwise = pictures [tableWithDealerChip, potWithBoard, playersHands, playersWihtBets] where chipImages = (chipLayout $ images screen) playerOnSeatBold p = pictures [drawPlayerSeatBold p (case active p of @@ -39,7 +41,7 @@ drawTableScreen screen Bankrupted -> blank Folded -> blank _ -> pictures [drawPlayerHand p (deckLayout $ images screen)]) (players screen)) - playersBets = pictures (map (\p -> pictures [playerOnSeatBold p, drawPlayerBet p chipImages]) (players screen)) + playersWihtBets = pictures (map (\p -> pictures [playerOnSeatBold p, drawPlayerBet p chipImages]) (players screen)) activePlayer = getActivePlayer $ players screen maxBet = countMaxBet $ players screen possibleActions = getPossibleActions activePlayer maxBet @@ -53,6 +55,9 @@ drawTableScreen screen betWindowImage = case fst possibleActions /= All_In of True -> drawBetWindow (currentValue $ sliderData screen) (betWindow $ images screen) False -> blank + resultMessage = case checkWin (players screen) (hero screen) of + True -> translate 0 resultMessageOffset (win $ images screen) + False -> translate 0 resultMessageOffset (loss $ images screen) -- | Draw player seatbold. drawPlayerSeatBold :: Player -> Picture -> Picture diff --git a/src/Poker/Interface/Types.hs b/src/Poker/Interface/Types.hs index 5aefea7..63767ed 100644 --- a/src/Poker/Interface/Types.hs +++ b/src/Poker/Interface/Types.hs @@ -30,6 +30,8 @@ data TableScreen = TableScreen -- | Contain all images relative to table game screen. data TableImages = TableImages { background :: Picture + , win :: Picture + , loss :: Picture , table :: Picture , seatBold :: Picture , seatBoldActive :: Picture diff --git a/src/Poker/Logic/Trading.hs b/src/Poker/Logic/Trading.hs index bc39d3c..2b8721a 100644 --- a/src/Poker/Logic/Trading.hs +++ b/src/Poker/Logic/Trading.hs @@ -97,6 +97,11 @@ checkGameEnd players = sum (map (\player -> then 0 else 1) players) == 1 +-- | Return if player with given name won the game. +checkWin :: [Player] -> String -> Bool +checkWin players playerName = any (\player -> + name player == playerName && balance player /= 0) players + -- | Return default move to proposed bet size when human didn't made any input. autoHumanMove :: Player -> Int -> Move autoHumanMove player bet From 749d0fb2307456acd93910bd972e68cfeb5160ac Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 17:39:22 +0300 Subject: [PATCH 6/7] Fixed managing skip for player in all-in situations --- src/Client.hs | 9 +++++---- src/Poker/Logic/Dealer.hs | 2 +- src/Poker/Logic/Trading.hs | 35 +++++++++++++++++++++++------------ 3 files changed, 29 insertions(+), 17 deletions(-) diff --git a/src/Client.hs b/src/Client.hs index 6c9a539..fc0fd7a 100644 --- a/src/Client.hs +++ b/src/Client.hs @@ -104,7 +104,8 @@ updateGame timePassed screen , deck = snd $ snd boardDealResult } | state screen == Bet_Round = - if (checkSkipForActivePlayer $ players screen) + if (checkSkipForActivePlayer activePlayer maxBet $ + countCanMovePlayers (players screen)) then screen { state = Next_Move } else screen { state = case activePlayerType of @@ -154,9 +155,9 @@ updateGame timePassed screen , street = succ $ street screen } else screen - { state = Bet_Round - , players = toggleNewActivePlayer (players screen) nextPosition - } + { state = Bet_Round + , players = toggleNewActivePlayer (players screen) nextPosition + } | state screen == Finish_Hand = if (timer screen < showdownTime) then screen { timer = timer screen + timePassed } diff --git a/src/Poker/Logic/Dealer.hs b/src/Poker/Logic/Dealer.hs index 1313ac0..1ec76b8 100644 --- a/src/Poker/Logic/Dealer.hs +++ b/src/Poker/Logic/Dealer.hs @@ -67,7 +67,7 @@ takeBlind player blind | balance player <= blind = player { move = Move All_In_ed (balance player) } | otherwise = player - { move = Move Raised blind } + { move = Move Waiting blind } -- | Take blinds from players and mark bankrupted players. takeBlinds :: [Player] -> Int -> [Player] diff --git a/src/Poker/Logic/Trading.hs b/src/Poker/Logic/Trading.hs index 2b8721a..c5c948d 100644 --- a/src/Poker/Logic/Trading.hs +++ b/src/Poker/Logic/Trading.hs @@ -3,7 +3,7 @@ module Poker.Logic.Trading where import Poker.Logic.Calculations import Poker.Logic.Types - +import Debug.Trace ------------------------------------------------------------------------------- -- * Operations with positions ------------------------------------------------------------------------------- @@ -53,16 +53,16 @@ getSeatOfPosition pos players -- * Computations with player(-s) ------------------------------------------------------------------------------- --- | Check if active player is skippable. -checkSkipForActivePlayer :: [Player] -> Bool -checkSkipForActivePlayer [] = False -checkSkipForActivePlayer players - | active $ head players = case action . move $ head players of +-- | Check if active player is skippable depending on max bet and amount of +-- players in hand that aren't all-in. +checkSkipForActivePlayer :: Player -> Int -> Int -> Bool +checkSkipForActivePlayer player maxBet livePlayers = + case action $ move player of Bankrupted -> True Folded -> True All_In_ed -> True - _ -> False - | otherwise = checkSkipForActivePlayer $ tail players + Waiting -> (betSize $ move player) == maxBet && livePlayers == 1 + _ -> (betSize $ move player) == maxBet -- | Return amount of players left in hand. countInHandPlayers :: [Player] -> Int @@ -73,6 +73,16 @@ countInHandPlayers players = foldl1 (+) (map _ -> 1) players) +-- | Return amount of players in hand that can require move. +countCanMovePlayers :: [Player] -> Int +countCanMovePlayers players = foldl1 (+) (map + (\player -> case action $ move player of + Bankrupted -> 0 + Folded -> 0 + All_In_ed -> 0 + _ -> 1) + players) + -- | Return maximal bet that occured. countMaxBet :: [Player] -> Int countMaxBet players = maximum (map @@ -81,11 +91,12 @@ countMaxBet players = maximum (map -- | Return if repeating of trade is needed. checkReTrade :: [Player] -> Int -> Bool -checkReTrade players bet = or (map +checkReTrade players bet = any (\player -> - mv player /= Waiting && mv player /= Folded && - mv player /= All_In_ed && bt player /= bet) - players) + (mv player == Called || mv player == Raised || + mv player == Checked) && + bt player /= bet) + players where mv p = action $ move p bt p = betSize $ move p From 404530be0e23fcceeb4c9d2fa2477c71d60f4869 Mon Sep 17 00:00:00 2001 From: Artem Bondar Date: Sun, 13 May 2018 17:48:59 +0300 Subject: [PATCH 7/7] Updated readme to 0.5 build --- README.md | 15 ++++++++++----- lambdem-poker.cabal | 2 +- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 921b4d9..e08a9f4 100644 --- a/README.md +++ b/README.md @@ -19,10 +19,13 @@ List of implemented features: - time delayed actions - fade on button click - bottom & up seatbolds +- detecting end of game - automove on timebank end - hightlighting of active player - calculation of possible actions +- autoskip when no action is required - handling bet rounds until showdown +- detecting winner(-s) and awarding them - detecting & comparing of poker combinations - *another not really cool stuff* @@ -31,13 +34,13 @@ List of implemented features: ## Status One phrase review: \ -*Almost done ... base version* +*Base version seemed to be done* -Nothing really complete here yet, -but you can watch the flop, do some moves and play to -your heart content with a slider. +Release candidate for base version, +you can play to your heart content versus yourself, +although some bugs are sneaking nearby, probably. -Developing ... +Developing AI ... ![serious coding](/docs/images/serious%20coding.gif) @@ -62,3 +65,5 @@ to verify results. For launching tests: `stack test` + +*Don't even try to run if you don't know what you're exactly doing!* diff --git a/lambdem-poker.cabal b/lambdem-poker.cabal index fe9dd0c..692eb1b 100644 --- a/lambdem-poker.cabal +++ b/lambdem-poker.cabal @@ -1,5 +1,5 @@ name: lambdem-poker -version: 0.4 +version: 0.5 synopsis: Poker client -- description: homepage: https://github.com/cmc-haskell-2018/lambdem-poker