Take player turns out of the Player data structure

This commit is contained in:
Tissevert 2019-10-22 17:42:23 +02:00
parent d2918c5256
commit e12f8e1f0d
5 changed files with 25 additions and 30 deletions

View file

@ -10,6 +10,7 @@ module Hanafuda.KoiKoi (
, Move(..) , Move(..)
, Player , Player
, PlayerID , PlayerID
, PlayerTurn
, Players , Players
, Score , Score
, Scores , Scores
@ -20,12 +21,13 @@ module Hanafuda.KoiKoi (
, play , play
) where ) where
import qualified Data.Map as Map (fromList)
import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove) import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
import qualified Hanafuda.Player as Player (players, random, scores) import qualified Hanafuda.Player as Player (players, random, scores)
import Hanafuda.KoiKoi.Yaku (Yaku(..), Score) import Hanafuda.KoiKoi.Yaku (Yaku(..), Score)
import Hanafuda.KoiKoi.Game ( import Hanafuda.KoiKoi.Game (
Action(..), Environment, Game(..), GameID, Mode(..), Move(..), Player 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.Round as Round (deal, next)
import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, 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] , scores = Player.scores players [0, 0]
, month = Pine , month = Pine
, players , players
, nextPlayer
, playing , playing
, winning = playing , winning = playing
, oyake = playing , oyake = playing
@ -70,3 +73,4 @@ new (playerA, playerB) mode = do
} }
where where
players = Player.players [playerA, playerB] players = Player.players [playerA, playerB]
nextPlayer = Map.fromList $ [(playerA, playerB), (playerB, playerA)]

View file

@ -11,6 +11,7 @@ module Hanafuda.KoiKoi.Game (
, Move(..) , Move(..)
, Player , Player
, PlayerID , PlayerID
, PlayerTurn
, Players , Players
, Scores , Scores
, Source(..) , Source(..)
@ -22,6 +23,7 @@ module Hanafuda.KoiKoi.Game (
import Control.Monad.Except (MonadError) import Control.Monad.Except (MonadError)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Writer (MonadWriter) import Control.Monad.Writer (MonadWriter)
import Data.Map (Map)
import Hanafuda (Card, Flower, Pack) import Hanafuda (Card, Flower, Pack)
import Hanafuda.ID (ID) import Hanafuda.ID (ID)
import qualified Hanafuda.KoiKoi.Yaku as KoiKoi (Score) 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 Players = Player.Players KoiKoi.Score
type Scores = Player.Scores KoiKoi.Score type Scores = Player.Scores KoiKoi.Score
type GameID = ID Game type GameID = ID Game
type PlayerTurn = Map PlayerID PlayerID
data Game = Game { data Game = Game {
mode :: Mode mode :: Mode
, scores :: Scores , scores :: Scores
, month :: Flower , month :: Flower
, nextPlayer :: PlayerTurn
, players :: Players , players :: Players
, playing :: PlayerID , playing :: PlayerID
, winning :: PlayerID , winning :: PlayerID

View file

@ -7,7 +7,7 @@ module Hanafuda.KoiKoi.Round (
import Hanafuda (Flower(Paulownia), cards, shuffle, packOfCards) import Hanafuda (Flower(Paulownia), cards, shuffle, packOfCards)
import Hanafuda.KoiKoi.Yaku (sumYakus) import Hanafuda.KoiKoi.Yaku (sumYakus)
import Hanafuda.KoiKoi.Game (Game(..), Mode(..), Step(..), end) 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 Data.Map ((!), insert)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State (runState, state) import Control.Monad.State (runState, state)
@ -25,14 +25,14 @@ deal game@(Game {players}) = do
getTriple = (,,) <$> take8 <*> take8 <*> take8 getTriple = (,,) <$> take8 <*> take8 <*> take8
next :: MonadIO m => Game -> m Game 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 case mode of
FirstAt n | n <= newScore -> end scored FirstAt n | n <= newScore -> end scored
FirstAt _ -> continue FirstAt _ -> continue
WholeYear | month == Paulownia -> end scored WholeYear | month == Paulownia -> end scored
WholeYear -> continue WholeYear -> continue
where where
playing = Player.next players oyake playing = nextPlayer ! oyake
winner = Player.get winning players winner = Player.get winning players
newScore = (scores ! winning) + Player.score sumYakus winner newScore = (scores ! winning) + Player.score sumYakus winner
scored = game {scores = insert winning newScore scores, rounds = (winning, Player.yakus winner): rounds} scored = game {scores = insert winning newScore scores, rounds = (winning, Player.yakus winner): rounds}

View file

@ -7,9 +7,10 @@ module Hanafuda.KoiKoi.Turn (
, popNextCard , popNextCard
) where ) where
import Data.Map ((!))
import Hanafuda (Card, Pack, empty, match) import Hanafuda (Card, Pack, empty, match)
import Hanafuda.Player (Player(..), plays) 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.Yaku (meldInto)
import Hanafuda.KoiKoi.Game (Action(..), Environment, Game(..), Source(..), Step(..), setPlayer) import Hanafuda.KoiKoi.Game (Action(..), Environment, Game(..), Source(..), Step(..), setPlayer)
import qualified Hanafuda.KoiKoi.Round as Round (next) 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)} updatedPlayer = player {meld = newMeld, yakus = scored `mappend` (yakus player)}
next :: MonadIO m => Game -> m Game next :: MonadIO m => Game -> m Game
next game@(Game {players, playing}) = next game@(Game {players, nextPlayer, playing}) =
let newPlaying = Player.next players playing in let newPlaying = nextPlayer ! playing in
if hand (Player.get newPlaying players) == empty if hand (Player.get newPlaying players) == empty
then Round.next $ game then Round.next $ game
else return $ game {playing = newPlaying, step = ToPlay} else return $ game {playing = newPlaying, step = ToPlay}

View file

@ -4,8 +4,8 @@ module Hanafuda.Player where
import Hanafuda (Card, Pack, contains, packOfCards, remove) import Hanafuda (Card, Pack, contains, packOfCards, remove)
import qualified Hanafuda.ID as Hanafuda (ID) import qualified Hanafuda.ID as Hanafuda (ID)
import Data.Map ((!), Map, adjust, elemAt, empty, findMin, fromList, insert, keys, singleton, size) import Data.Map ((!), Map, elemAt, insert, keys, size)
import qualified Data.Map as Map (filter) import qualified Data.Map as Map (fromList, toList)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Except (MonadError(..)) import Control.Monad.Except (MonadError(..))
import System.Random (Random(..)) import System.Random (Random(..))
@ -14,31 +14,19 @@ type ID yakus = Hanafuda.ID (Player yakus)
data Player yakus = Player { data Player yakus = Player {
hand :: Pack hand :: Pack
, meld :: Pack , meld :: Pack
, nextPlayer :: ID yakus
, yakus :: yakus , yakus :: yakus
} deriving (Show) } deriving (Show)
newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show) newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show)
new :: Monoid yakus => (ID yakus) -> Player yakus new :: Monoid yakus => Player yakus
new nextPlayer = Player { new = Player {
hand = packOfCards [] hand = packOfCards []
, meld = packOfCards [] , meld = packOfCards []
, nextPlayer
, yakus = mempty , yakus = mempty
} }
players :: Monoid yakus => [ID yakus] -> Players yakus players :: Monoid yakus => [ID yakus] -> Players yakus
players [] = Players empty players = Players . Map.fromList . fmap (\playerID -> (playerID, new))
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 !)
random :: MonadIO m => Players yakus -> m (ID yakus) random :: MonadIO m => Players yakus -> m (ID yakus)
random (Players playersByID) = 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 :: Monoid yakus => Players yakus -> [[Card]] -> Players yakus
deal (Players playersByID) hands = deal (Players playersByID) hands =
Players $ snd $ foldl dealTo (fst $ findMin playersByID, playersByID) hands Players . Map.fromList . zipWith setHand hands $ Map.toList playersByID
where where
setHand cards (Player {nextPlayer}) = setHand cards (playerID, player) =
(new nextPlayer) {hand = packOfCards cards} (playerID, player {hand = packOfCards cards})
dealTo (playerID, m) hand =
(nextPlayer $ m ! playerID, adjust (setHand hand) playerID m)
plays :: MonadError String m => Player yakus -> Card -> m (Player yakus) plays :: MonadError String m => Player yakus -> Card -> m (Player yakus)
plays player@(Player {hand}) card = plays player@(Player {hand}) card =
@ -74,4 +60,4 @@ score :: (yakus -> Points) -> Player yakus -> Points
score rater = rater . yakus score rater = rater . yakus
scores :: Players yakus -> [Points] -> Scores yakus scores :: Players yakus -> [Points] -> Scores yakus
scores (Players playersByKey) = fromList . zip (keys playersByKey) scores (Players playersByKey) = Map.fromList . zip (keys playersByKey)