48 lines
1.1 KiB
Haskell
48 lines
1.1 KiB
Haskell
|
{-# LANGUAGE NamedFieldPuns #-}
|
||
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||
|
|
module Hanafuda.Player where
|
||
|
|
|
||
|
|
import Data.Map (Map, empty, fromList)
|
||
|
|
import Hanafuda (Card, Pack, contains, packOfCards, remove)
|
||
|
|
|
||
|
|
data Player =
|
||
|
|
Player1
|
||
|
|
| Player2
|
||
|
|
deriving (Eq, Ord, Show)
|
||
|
|
|
||
|
|
next :: Player -> Player
|
||
|
|
next Player1 = Player2
|
||
|
|
next _ = Player1
|
||
|
|
|
||
|
|
data State a = State {
|
||
|
|
hand :: Pack
|
||
|
|
, meld :: Pack
|
||
|
|
, yakus :: a
|
||
|
|
} deriving (Show)
|
||
|
|
type Players a = Map Player (State a)
|
||
|
|
|
||
|
|
deal :: [a] -> Map Player a
|
||
|
|
deal = fromList . zip [Player1, Player2]
|
||
|
|
|
||
|
|
new :: Monoid a => [Card] -> State a
|
||
|
|
new cards = State {
|
||
|
|
hand = packOfCards cards
|
||
|
|
, meld = packOfCards []
|
||
|
|
, yakus = mempty
|
||
|
|
}
|
||
|
|
|
||
|
|
plays :: State a -> Card -> Either String (State a)
|
||
|
|
plays player@(State {hand}) card =
|
||
|
|
if hand `contains` card
|
||
|
|
then Right $ player {hand = remove hand card}
|
||
|
|
else Left "You don't have this card"
|
||
|
|
|
||
|
|
data Move = Play Card | Capture (Card, Card) | Choose Card | KoiKoi Bool
|
||
|
|
|
||
|
|
type Points = Int
|
||
|
|
|
||
|
|
score :: (a -> Points) -> State a -> Int
|
||
|
|
score rater = rater . yakus
|
||
|
|
|
||
|
|
type Scores = Map Player Points
|