2018-03-15 22:32:24 +01:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module Hanafuda.KoiKoi.Game (
|
|
|
|
Game(..)
|
|
|
|
, Mode(..)
|
|
|
|
, Move(..)
|
|
|
|
, On(..)
|
|
|
|
, Over(..)
|
|
|
|
, Step(..)
|
|
|
|
, end
|
|
|
|
, raise
|
|
|
|
, setPlayer
|
|
|
|
, stop
|
|
|
|
) where
|
|
|
|
|
|
|
|
import Hanafuda (Card, Flower, Pack)
|
2018-07-24 22:19:04 +02:00
|
|
|
import Hanafuda.Player (Players, Player, Scores, set)
|
2018-03-15 22:32:24 +01:00
|
|
|
import Hanafuda.KoiKoi.Yaku (Score)
|
|
|
|
|
|
|
|
data Mode = FirstAt Int | WholeYear deriving (Show)
|
|
|
|
data Move = Play Card | Capture (Card, Card) | Choose Card | KoiKoi Bool
|
|
|
|
data Step = ToPlay | Turned Card | Scored deriving (Show)
|
|
|
|
|
2018-07-24 22:19:04 +02:00
|
|
|
data On player = On_ {
|
2018-03-15 22:32:24 +01:00
|
|
|
mode :: Mode
|
2018-07-24 22:19:04 +02:00
|
|
|
, scores :: Scores player
|
2018-03-15 22:32:24 +01:00
|
|
|
, month :: Flower
|
2018-07-24 22:19:04 +02:00
|
|
|
, players :: Players player Score
|
|
|
|
, playing :: player
|
|
|
|
, winning :: player
|
|
|
|
, oyake :: player
|
|
|
|
, deck :: [Card]
|
2018-03-15 22:32:24 +01:00
|
|
|
, river :: Pack
|
|
|
|
, step :: Step
|
|
|
|
, trick :: [Card]
|
|
|
|
} deriving (Show)
|
2018-07-24 22:19:04 +02:00
|
|
|
data Over player = Over_ {
|
|
|
|
finalScores :: Scores player
|
2018-03-15 22:32:24 +01:00
|
|
|
} deriving (Show)
|
|
|
|
|
2018-07-24 22:19:04 +02:00
|
|
|
data Game player = Error String | Over (Over player) | On (On player) deriving (Show)
|
2018-03-15 22:32:24 +01:00
|
|
|
|
2018-07-24 22:19:04 +02:00
|
|
|
setPlayer :: Ord player => On player -> Player player Score -> On player
|
|
|
|
setPlayer on@(On_ {players, playing}) player = on {players = set playing player players}
|
2018-03-15 22:32:24 +01:00
|
|
|
|
2018-07-24 22:19:04 +02:00
|
|
|
end :: Ord player => On player -> IO (Game player)
|
2018-03-15 22:32:24 +01:00
|
|
|
end (On_ {scores}) = return . Over $ Over_ {finalScores = scores}
|
|
|
|
|
2018-07-24 22:19:04 +02:00
|
|
|
stop :: Ord player => On player -> IO (Game player)
|
2018-03-15 22:32:24 +01:00
|
|
|
stop = return . On
|
|
|
|
|
2018-07-24 22:19:04 +02:00
|
|
|
raise :: String -> IO (Game player)
|
2018-03-15 22:32:24 +01:00
|
|
|
raise = return . Error
|