From e12f8e1f0d8e2b2127932660524d182bedbb891c Mon Sep 17 00:00:00 2001 From: Tissevert Date: Tue, 22 Oct 2019 17:42:23 +0200 Subject: [PATCH] Take player turns out of the Player data structure --- src/Hanafuda/KoiKoi.hs | 6 +++++- src/Hanafuda/KoiKoi/Game.hs | 4 ++++ src/Hanafuda/KoiKoi/Round.hs | 6 +++--- src/Hanafuda/KoiKoi/Turn.hs | 7 ++++--- src/Hanafuda/Player.hs | 32 +++++++++----------------------- 5 files changed, 25 insertions(+), 30 deletions(-) diff --git a/src/Hanafuda/KoiKoi.hs b/src/Hanafuda/KoiKoi.hs index c852085..eda2d82 100644 --- a/src/Hanafuda/KoiKoi.hs +++ b/src/Hanafuda/KoiKoi.hs @@ -10,6 +10,7 @@ module Hanafuda.KoiKoi ( , Move(..) , Player , PlayerID + , PlayerTurn , Players , Score , Scores @@ -20,12 +21,13 @@ module Hanafuda.KoiKoi ( , play ) where +import qualified Data.Map as Map (fromList) import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove) import qualified Hanafuda.Player as Player (players, random, scores) import Hanafuda.KoiKoi.Yaku (Yaku(..), Score) import Hanafuda.KoiKoi.Game ( Action(..), Environment, Game(..), GameID, Mode(..), Move(..), Player - , PlayerID, Players, Scores, Source(..), Step(..) + , PlayerID, PlayerTurn, Players, Scores, Source(..), Step(..) ) import qualified Hanafuda.KoiKoi.Round as Round (deal, next) import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next) @@ -59,6 +61,7 @@ new (playerA, playerB) mode = do , scores = Player.scores players [0, 0] , month = Pine , players + , nextPlayer , playing , winning = playing , oyake = playing @@ -70,3 +73,4 @@ new (playerA, playerB) mode = do } where players = Player.players [playerA, playerB] + nextPlayer = Map.fromList $ [(playerA, playerB), (playerB, playerA)] diff --git a/src/Hanafuda/KoiKoi/Game.hs b/src/Hanafuda/KoiKoi/Game.hs index f429859..7b0b77b 100644 --- a/src/Hanafuda/KoiKoi/Game.hs +++ b/src/Hanafuda/KoiKoi/Game.hs @@ -11,6 +11,7 @@ module Hanafuda.KoiKoi.Game ( , Move(..) , Player , PlayerID + , PlayerTurn , Players , Scores , Source(..) @@ -22,6 +23,7 @@ module Hanafuda.KoiKoi.Game ( import Control.Monad.Except (MonadError) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Writer (MonadWriter) +import Data.Map (Map) import Hanafuda (Card, Flower, Pack) import Hanafuda.ID (ID) import qualified Hanafuda.KoiKoi.Yaku as KoiKoi (Score) @@ -43,11 +45,13 @@ type PlayerID = Player.ID KoiKoi.Score type Players = Player.Players KoiKoi.Score type Scores = Player.Scores KoiKoi.Score type GameID = ID Game +type PlayerTurn = Map PlayerID PlayerID data Game = Game { mode :: Mode , scores :: Scores , month :: Flower + , nextPlayer :: PlayerTurn , players :: Players , playing :: PlayerID , winning :: PlayerID diff --git a/src/Hanafuda/KoiKoi/Round.hs b/src/Hanafuda/KoiKoi/Round.hs index b898987..26f15bc 100644 --- a/src/Hanafuda/KoiKoi/Round.hs +++ b/src/Hanafuda/KoiKoi/Round.hs @@ -7,7 +7,7 @@ module Hanafuda.KoiKoi.Round ( import Hanafuda (Flower(Paulownia), cards, shuffle, packOfCards) import Hanafuda.KoiKoi.Yaku (sumYakus) import Hanafuda.KoiKoi.Game (Game(..), Mode(..), Step(..), end) -import qualified Hanafuda.Player as Player (deal, get, next, score, yakus) +import qualified Hanafuda.Player as Player (deal, get, score, yakus) import Data.Map ((!), insert) import Control.Monad.IO.Class (MonadIO) import Control.Monad.State (runState, state) @@ -25,14 +25,14 @@ deal game@(Game {players}) = do getTriple = (,,) <$> take8 <*> take8 <*> take8 next :: MonadIO m => Game -> m Game -next game@(Game {mode, scores, month, players, oyake, winning, rounds}) = +next game@(Game {mode, scores, month, players, nextPlayer, oyake, winning, rounds}) = case mode of FirstAt n | n <= newScore -> end scored FirstAt _ -> continue WholeYear | month == Paulownia -> end scored WholeYear -> continue where - playing = Player.next players oyake + playing = nextPlayer ! oyake winner = Player.get winning players newScore = (scores ! winning) + Player.score sumYakus winner scored = game {scores = insert winning newScore scores, rounds = (winning, Player.yakus winner): rounds} diff --git a/src/Hanafuda/KoiKoi/Turn.hs b/src/Hanafuda/KoiKoi/Turn.hs index 7192bc7..6b01058 100644 --- a/src/Hanafuda/KoiKoi/Turn.hs +++ b/src/Hanafuda/KoiKoi/Turn.hs @@ -7,9 +7,10 @@ module Hanafuda.KoiKoi.Turn ( , popNextCard ) where +import Data.Map ((!)) import Hanafuda (Card, Pack, empty, match) import Hanafuda.Player (Player(..), plays) -import qualified Hanafuda.Player as Player (get, next) +import qualified Hanafuda.Player as Player (get) import Hanafuda.KoiKoi.Yaku (meldInto) import Hanafuda.KoiKoi.Game (Action(..), Environment, Game(..), Source(..), Step(..), setPlayer) import qualified Hanafuda.KoiKoi.Round as Round (next) @@ -56,8 +57,8 @@ end game@(Game {month, trick, playing, players}) card (river, newCaptured) = do updatedPlayer = player {meld = newMeld, yakus = scored `mappend` (yakus player)} next :: MonadIO m => Game -> m Game -next game@(Game {players, playing}) = - let newPlaying = Player.next players playing in +next game@(Game {players, nextPlayer, playing}) = + let newPlaying = nextPlayer ! playing in if hand (Player.get newPlaying players) == empty then Round.next $ game else return $ game {playing = newPlaying, step = ToPlay} diff --git a/src/Hanafuda/Player.hs b/src/Hanafuda/Player.hs index 779f05f..d3eda2e 100644 --- a/src/Hanafuda/Player.hs +++ b/src/Hanafuda/Player.hs @@ -4,8 +4,8 @@ module Hanafuda.Player where import Hanafuda (Card, Pack, contains, packOfCards, remove) import qualified Hanafuda.ID as Hanafuda (ID) -import Data.Map ((!), Map, adjust, elemAt, empty, findMin, fromList, insert, keys, singleton, size) -import qualified Data.Map as Map (filter) +import Data.Map ((!), Map, elemAt, insert, keys, size) +import qualified Data.Map as Map (fromList, toList) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Except (MonadError(..)) import System.Random (Random(..)) @@ -14,31 +14,19 @@ type ID yakus = Hanafuda.ID (Player yakus) data Player yakus = Player { hand :: Pack , meld :: Pack - , nextPlayer :: ID yakus , yakus :: yakus } deriving (Show) newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show) -new :: Monoid yakus => (ID yakus) -> Player yakus -new nextPlayer = Player { +new :: Monoid yakus => Player yakus +new = Player { hand = packOfCards [] , meld = packOfCards [] - , nextPlayer , yakus = mempty } players :: Monoid yakus => [ID yakus] -> Players yakus -players [] = Players empty -players [player] = Players $ singleton player $ new player -players (alice:others@(bob:_)) = - let Players playersByID = players others in - let (before, _) = findMin $ Map.filter ((== bob) . nextPlayer) playersByID in - Players $ insert alice (new bob) $ adjust (setNextPlayer alice) before playersByID - where - setNextPlayer nextPlayer player = player {nextPlayer} - -next :: Players yakus -> (ID yakus) -> (ID yakus) -next (Players playersByID) = nextPlayer . (playersByID !) +players = Players . Map.fromList . fmap (\playerID -> (playerID, new)) random :: MonadIO m => Players yakus -> m (ID yakus) random (Players playersByID) = @@ -54,12 +42,10 @@ set playerID player (Players playersByID) = Players $ insert playerID player pla deal :: Monoid yakus => Players yakus -> [[Card]] -> Players yakus deal (Players playersByID) hands = - Players $ snd $ foldl dealTo (fst $ findMin playersByID, playersByID) hands + Players . Map.fromList . zipWith setHand hands $ Map.toList playersByID where - setHand cards (Player {nextPlayer}) = - (new nextPlayer) {hand = packOfCards cards} - dealTo (playerID, m) hand = - (nextPlayer $ m ! playerID, adjust (setHand hand) playerID m) + setHand cards (playerID, player) = + (playerID, player {hand = packOfCards cards}) plays :: MonadError String m => Player yakus -> Card -> m (Player yakus) plays player@(Player {hand}) card = @@ -74,4 +60,4 @@ score :: (yakus -> Points) -> Player yakus -> Points score rater = rater . yakus scores :: Players yakus -> [Points] -> Scores yakus -scores (Players playersByKey) = fromList . zip (keys playersByKey) +scores (Players playersByKey) = Map.fromList . zip (keys playersByKey)