64 lines
1.8 KiB
Haskell
64 lines
1.8 KiB
Haskell
|
{-# LANGUAGE NamedFieldPuns #-}
|
||
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||
|
|
{-# LANGUAGE FlexibleInstances #-}
|
||
|
|
module Hanafuda.KoiKoi (
|
||
|
|
new
|
||
|
|
, play
|
||
|
|
, Card(..)
|
||
|
|
, Mode(..)
|
||
|
|
, Move(..)
|
||
|
|
, On
|
||
|
|
, Over(..)
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Prelude hiding (round)
|
||
|
|
import Hanafuda (Flower(Paulownia), Card(..))
|
||
|
|
import Hanafuda.KoiKoi.Round (Round(..), flower, next, score, winner)
|
||
|
|
import qualified Hanafuda.KoiKoi.Round as Round (On(..), Over(..), new, play)
|
||
|
|
import Hanafuda.Player (Move(..), Player(Player1), Scores, deal)
|
||
|
|
import Data.Map (insert, (!))
|
||
|
|
import System.Random (StdGen)
|
||
|
|
|
||
|
|
data Mode = FirstAt Int | WholeYear deriving (Show)
|
||
|
|
|
||
|
|
data On = On {
|
||
|
|
mode :: Mode
|
||
|
|
, round :: Round.On
|
||
|
|
, scores :: Scores
|
||
|
|
} deriving (Show)
|
||
|
|
data Over = Over {
|
||
|
|
finalScores :: Scores
|
||
|
|
} deriving (Show)
|
||
|
|
|
||
|
|
newtype Game = Game (Either Over On) deriving (Show)
|
||
|
|
|
||
|
|
go :: On -> IO Game
|
||
|
|
go = return . Game . Right
|
||
|
|
|
||
|
|
new :: Mode -> IO On
|
||
|
|
new mode = do
|
||
|
|
round <- Round.new Player1
|
||
|
|
return $ On {mode , round , scores = deal [0, 0]}
|
||
|
|
|
||
|
|
consolidate :: On -> Player -> Int -> IO Game
|
||
|
|
consolidate on@(On {mode, round, scores}) winner score =
|
||
|
|
case mode of
|
||
|
|
FirstAt n | n <= newScore -> stop
|
||
|
|
FirstAt n -> continue
|
||
|
|
WholeYear | flower round == Paulownia -> stop
|
||
|
|
WholeYear -> continue
|
||
|
|
where
|
||
|
|
newScore = scores ! winner + score
|
||
|
|
newScores = insert winner newScore scores
|
||
|
|
stop = return . Game . Left $ Over {finalScores = newScores}
|
||
|
|
continue = do
|
||
|
|
nextMonth <- next round
|
||
|
|
go $ on {scores = newScores, round = nextMonth}
|
||
|
|
|
||
|
|
play :: On -> Move -> IO (Either String Game)
|
||
|
|
play on@(On {mode, round}) move =
|
||
|
|
either (return . Left) (fmap Right) . fmap after $ Round.play round move
|
||
|
|
where
|
||
|
|
after (Round (Left (Round.Over {winner, score}))) = consolidate on winner score
|
||
|
|
after (Round (Right newMonth)) = go $ on {round = newMonth}
|